Emacs script to interact with the Sawfish window manager. See http://sawfish.wikia.com/wiki/Sawinlist for more infos.

sawinlist.el

;;; sawinlist.el --- functions for listing and manipulating x-windows managed by sawfish

;; Copyright (C) 2011 , 2012 by the author: John Lumby [email protected]

;; This file may be used in conjunction with GNU Emacs.

;; Both this file and GNU Emacs are free software; you may redistribute them and/or modify
;; them under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; Both this file and GNU Emacs are distributed in the hope that they will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

(provide 'sawinlist)

(defun sawinlist-raise (this-point)
 "raise the sawfish window whose name is the string at or near point;
a Ctl-g<windowid> sequence,  if present for disambiguation,
may be removed prior to selecting the line,  to cause selection of most recent with that name"
  (let
    (
      tempoint nextpoint temp len curchar index nextindx window-name
       cur-is-ctl-g prev-was-ctl-g
       escape-type ; values "[" <=> octal sequence,  "<" <=> window-id
;;     (coding-system-for-read 'no-conversion)
;;     (coding-system-for-write 'no-conversion)
      (coding-system-for-read 'undecided)
      (coding-system-for-write 'iso-latin-1)
      (cur-line-num 0) ; line number of current line counted backwards from the last as 0
      windownum        ; window-id of window on this line according to sawinlist-window-ids
      override-window-id ;  window-id (printable) from override in line in buffer
    )
;;   count lines backwards from last to current point
   (goto-char (point-max))
   (backward-char)
   (beginning-of-line)
   (while (> (point) this-point)
     (setq cur-line-num (1+ cur-line-num))
     (forward-line -1)
   )
   (goto-char this-point)
   (setq tempoint (progn (beginning-of-line) (point)))
   (setq nextpoint (progn (end-of-line) (point)))
;  window-name is from start of line to end,  minus any appended window-id
   (setq temp (buffer-substring-no-properties tempoint nextpoint))
;  quote backslash and double-quote, and convert the \C-G sequences back to control chars
   (setq index 0)
   (setq len (length temp))
   (setq window-name "")
   (setq override-window-id nil)
   (setq prev-was-ctl-g nil)
   (setq escape-type nil)
;   crawl through characters
       (while (< index len)
	 (setq nextindx (1+ index))
	 (setq curchar (substring temp index nextindx))
	 (setq cur-is-ctl-g (string= curchar ""))
	 (cond
	  (cur-is-ctl-g                            ; start of a \C-G sequence - merely remember
	   (setq prev-was-ctl-g t)
	   (setq escape-type nil))                 ; next char determines escape-type
	  ((and prev-was-ctl-g (not cur-is-ctl-g) (not escape-type)) ; continuation of a \C-G sequence - identify escape type
	    (if (or
	          (string= curchar "[")               ; octal sequence
                  (string= curchar "<"))              ; window-id of non-unique window name
               (setq escape-type curchar) )
            (setq prev-was-ctl-g nil)
	  )
	  (escape-type ; prev char was the escape type,  current is start of sequence
           (cond
	     ( (string= escape-type "[")               ; octal sequence
               (setq nextindx (+ index 3))
               (setq window-name (concat window-name (car (read-from-string (concat "\"\\" (substring temp index nextindx) "\"")))))
               (setq nextindx (1+ nextindx))           ; for the terminating "]"
	     )
             ( (string= escape-type "<")               ; window-id of non-unique window name
;;     in this case, set override-window-id to force selection by window-id
	       (if (string-match "\\([0-9]+\\)>" temp index)
		   (setq override-window-id (match-string-no-properties 1 temp)))
               (setq nextindx len)                     ; and exclude this from the true window-name
             )
           )
	   (setq escape-type nil)
         )
	 (t
;;   not a \C-G sequence - take the character as is or quoted
	   (setq prev-was-ctl-g nil)
           (if (or (string= curchar "\\")
                   (string= curchar "\"")
               )
;   quote the character
             (setq window-name (concat window-name "\\")))
           (setq window-name (concat window-name curchar))
	 ))
	 (setq index nextindx)
       )
       (setq windownum (aref sawinlist-window-ids cur-line-num)) ;  save this before refresh
;;     always refresh - and highlight current window if requested
       (sawinlist-build (if (and (boundp 'sawinlist-low-high-light) (vectorp sawinlist-low-high-light)) windownum))
;;     (message window-name)
;;     if an override window-id of non-unique window name was found,  then get window using that window id.
;;     otherwise,  the following or clause first tries to find the window by name, and then if that fails, by window id.
;;     reason why not to use window id first is that, when there are multiple windows with same name,
;;     (and assuming that the user deleted the Ctl-g<windowid> sequence at the end of the name so that this function does not see it),
;;     empirically, sawfish always finds the one we want (most recent) whereas use of window id would not.
;;     however, where an app continually changes its name, such as Lotus Notes, mozilla, etc,
;;     we want to locate that window based on id
;;     be careful with formatting of the windownum  -   we want an integer but it may be stored as a float with .0 as fractional part
;; (message (concat "(let ((chosen-window " (cond (override-window-id (concat "(get-window-by-id " override-window-id ")")) (t (concat "(or (get-window-by-name \"" window-name "\") (get-window-by-id " (format "%.0f" windownum) "))"))) ")) (if (window-iconified-p chosen-window) (uniconify-window chosen-window)) (activate-window chosen-window))"))
   (call-process "sawfish-client" nil nil nil "-e" (concat "(let ((chosen-window " (cond (override-window-id (concat "(get-window-by-id " override-window-id ")")) (t (concat "(or (get-window-by-name \"" window-name "\") (get-window-by-id " (format "%.0f" windownum) "))"))) ")) (if (window-iconified-p chosen-window) (uniconify-window chosen-window)) (activate-window chosen-window))"))
))

(defun sawinlist-raise-from-kbd (this-point)
 "raise the sawfish window whose name is the string at or near point"
 (interactive "d")
  (save-excursion
  (sawinlist-raise this-point)
))

(defun sawinlist-raise-from-mouse (eventp)
  "raise the sawfish window whose name is the string at or near mouse position"
  (interactive "e")
  (mouse-set-point eventp)
  (save-excursion
    (let ( (this-point (point)) )
;; as a convenience, treat right-click at end of buffer as request to refresh it
      (if (= this-point (point-max))
	  (sawinlist-build)
;;     else
	  (sawinlist-raise this-point)
      )
)))

(defun sawinlist-build (&optional highlight-window-id)
 "build list of sawfish windows in *SAWINLIST* buffer
for manipulation by user - e.g. to raise and lower windows
if highlight-window-id is specified,  highlight the line referring to this window
and lowlight the previously-highlighted line if still present"
;;  the following returns the window list
;;  bash -c 'sawfish-client -e "(let ((winlist (managed-windows)) tcar tcdr (repout \"\`\") temp) (setq tcdr winlist) (while (setq tcar (car tcdr)) (setq tcdr (cdr tcdr)) (setq temp (prin1-to-string (window-name tcar))) (setq repout (concat repout (substring temp 1 (1- (length temp))) \"\`\"))) (princ repout))" | tr "\`" "\n"'
;; and the following raises a named window
;; sawfish-client -e '(activate-window (get-window-by-name "labvm"))'
;; and the following renames a named window
;; sawfish-client -e "(set-x-property (get-window-by-name \"lumby@lumbyrnt:~\") 'WM_NAME \"redpine-screen\" 'STRING 8)"
;; and the following deletes a named window
;; sawfish-client -e '(delete-window (get-window-by-name "Smile!"))'
;;
;; quoting is tricky:   there are up to three levels of nesting of quoting:
;;     level      where                                                       what quoted
;; .     1    inside a lisp string                                                  \ "
;; .      2   inside the shell command (string attached to -c)                      \ " ` $
;; .       3  inside a lisp string inside sawfish-client parmstring                 \ "
;;
;; transparency schemes:
;; two transparency schemes are used:
;;   .  sawfish ==>> this program           :    printable-ascii char whose value is in symbol transp-char
;;   .  this program ==>> *SAWINLIST* buffer  :    non-printable control char Ctl-G
;; details of each are given where deployed.    the rationale for these choices and why they are different is :
;;   .  sawfish ==>> this program
;;       we *must* use a printable-ascii since non-printable chars are translated into quoted octal sequences before we receive them;
;;       note that this character is internal to this program and its use for control sequences is not visible to the user.
;;   .  this program ==>> *SAWINLIST* buffer
;;       we *prefer* to use a non-printable-ascii since the chosen character is visible to the user
;;       and non-printable is less likely to appear as itself in a name,   i.e. results in less confusion when displayed.
;;
 (interactive)
  (save-excursion
  (let
    (
     (transp-char "`") ; printable-ascii char used to delimit control sequences in data sawfish ==>> this program - see above and below
     (cbuf (current-buffer))
     (sawbuf (get-buffer-create "*SAWINLIST*"))
     sawfish-string ;  the string passed to sawfish -e
     temp ix replacement tempoint windowid windownum (winid-list (list))
;    (coding-system-for-read 'no-conversion)
;    (coding-system-for-write 'no-conversion)
     (coding-system-for-read 'undecided)
     (coding-system-for-write 'iso-latin-1)
     window-name prev-name
     start-of-windowid-section end-of-windowid-section predecessor-windowid
     current-repeated-name ; indicates whether this window name is a repetition of its predecessor
     prev-repeated-name    ; prev value of current-repeated-name : indicates whether the previous window name was a repetition of its predecessor (cur - 2)
     highlight-linenum ;   line number to be highlighted
     lowlight-linenum  ;   line number to be lowlighted  (previous highlighted line)
     current-linenum  ovrly
    )
;; (call-process "bash" nil "*SAWINLIST*" nil "-c" "sawfish-client -e \"(let ((junk \\\"junkword\\\") temp) (princ junk))\"")
   (switch-to-buffer sawbuf)
;; ... the following debug reveals that overlays are never truly destroyed - the lisp objects persist - so ...
;; for debugging   (message (concat "before delete - overlays at : " (prin1-to-string (overlays-in (point-min) (point-max)))))
   (cond
    ((setq temp (overlays-in (point-min) (point-max)))
     (delete-overlay (car temp))
     (while (setq temp (cdr temp))
        (delete-overlay (car temp)))
   ))
;; for debugging   (message (concat "after delete - overlays at : " (prin1-to-string (overlays-in (point-min) (point-max)))))
   (erase-buffer) ; empirically,  erase-buffer deletes any overlays in effect,  which is what we want  ...
;; for debugging   (message (concat "after erase - overlays at : " (prin1-to-string (overlays-in (point-min) (point-max)))))
;; in the following:
;; the sawfish lambda builds the list of names using a transparent control char,  default back-tick :
;;    single transp-char in name is replaced by two transp-chars
;;    names are separated by sequence forward-slash transp-char forward-slash, which is replaced by newline in the bash one-line-command
;;    any name ending in "- [- a-zA-Z0-9_.:]+" will have this suffix prepended as prefix, on assumption that it is a constant,
;;               separated by sequence blank transp-char blank
;;    window-id integer is appended to each name separated by asterisk transp-char asterisk
;; none of these sequences is a part of any other sequence regardless of neighbouring characters
;; 
;; the purpose of the if not string= test is to exclude the name of the current window since we are already in it
;;
;;

(setq sawfish-string (concat "(let ((winlist (managed-windows)) tcar tcdr (repout \"/" transp-char "/\")
     temp index previndx nextindx curchar len dashpos transtr)
  (setq tcdr winlist)
  (while (setq tcar (car tcdr))
   (setq tcdr (cdr tcdr))
   (setq temp (prin1-to-string (window-name tcar) t))
   (setq temp (substring temp 1 (1- (length temp))))
;        (princ temp)
   (cond
;        ignore current window
     ((string= temp \"" (or (cdr (assoc 'title (frame-parameters (selected-frame)))) (cdr (assoc 'name (frame-parameters (selected-frame))))) "\"))
     (t
       (setq index 0)
       (setq dashpos nil)
       (setq transtr \"\")
       (setq len (length temp))
;   crawl through characters
       (while (< index len)
;        (princ index)
	 (setq nextindx (1+ index))
	 (setq curchar (substring temp index nextindx))
	 (setq transtr (concat transtr curchar))
	 (cond
	   ((string= curchar \"-\")
	      (if (and (> index 1) (< index (- len 4))
		       (string= (substring temp previndx index) \" \")
		       (string= (substring temp nextindx (1+ nextindx)) \" \")
		  )
;   found candidate dash
		  (setq dashpos index)))
;   check if valid suffix character ...
	   ((string-match \"[ a-zA-Z0-9_.:]\" curchar))
;   ... if not ...
	   (t
	       (setq dashpos nil)
	       (if (string= curchar \"" transp-char "\")
;   repeat the transp-char
		   (setq transtr (concat transtr curchar)))
	   )
	 )
	 (setq previndx index)
	 (setq index nextindx)
       )
       (if (and dashpos (< (- len dashpos) 44))
;   prepend the dash suffix
	   (setq transtr (concat (substring temp (+ dashpos 2)) \" " transp-char " \" transtr)))
;   append the window-id as well
       (setq repout (concat repout transtr \"*" transp-char "*\" (prin1-to-string (window-id tcar) t) \"/" transp-char "/\"))))
  )
  repout
)"))

;; (call-process "echo" nil "*SAWINLIST*" nil sawfish-string) ; to debug
(call-process "sawfish-client" nil "*SAWINLIST*" nil "-e" sawfish-string)
;;
;; post-processing
;;
;; any non-printable characters in original window names appear as a doubly-quoted octal-read-syntax
;; these are unambiguously distinguished from a clear sequence of such characters (e.g. \\253)
;; because, fortunately, original backslashes appear as a sequence of four backslashes (don't know why ...)
;; so the non-printables are distinguishable by leading with a pair of backslashes NOT preceded by backslash;
;; also note we don't want any clear linefeeds to be translated back to clear linefeeds since our name parsing and sorting relies on one name per line;
;; replace each octal-read-syntax character by :
;;  . if in range 000-037 ( the control chars , including \C-G)  \C-g[octal-sequence] (control-G followed by octal-read-syntax in square-brackets)
;;       (note - the above range includes linefeed - 012 )
;;  . otherwise    the single character
;; 
;; note - for reason given below, this works inside emacs started with no .emacs profile but not in my heavily customized emacs -
;;        although the resulting translation is made, sawfish does not find the window -
;;        it seems that in the customized emacs, the special characters are translated once more
;;        with some kind of special leading character
;;        at some point before being sent to sawfish in sawinlist-raise.
;;        explanation found - relating to coding system used for writing to / reading from subprocesses:
;;        although both emacs's had enable-multibyte-characters t nonascii-insert-offset 0
;;        .   customized emacs - had default-process-coding-system (mule-utf-8 . mule-utf-8)
;;        . uncustomized emacs - had default-process-coding-system (undecided . iso-latin-1)
;;        I don't know why these defaults were different, but
;;        setting both coding-system-for-read and coding-system-for-write as for uncustomized emacs makes it work!
;;        I also am NOT sure that this will correctly handle all character sets appearing in window titles ...
;;
   (goto-char (point-min))
   (while (re-search-forward "\\(^\\|[^\\]\\)\\(\\\\\\\\[0-7][0-7][0-7]\\)" nil t)
;;   (match-string-no-properties 2) is the octal sequence including two leading backslashes
     (setq temp (substring (match-string-no-properties 2) 1)) ; octal sequence including one leading backslash
     (setq ix (car (read-from-string (concat "?" temp)))) ; numeric value
     (cond
      ((< ix 32)
       (setq replacement (concat "[" (substring temp 1) "]")))
      (t
       (setq replacement (car (read-from-string (concat "\"" temp "\""))))) ; character value as a string - default replacement
     )
     (replace-match replacement t t nil 2)
;; back up behind last replacement char in case another sequence follows immediately
;; (note the matching regexp includes one character or line-start preceding the octal sequence)
     (backward-char)
   )
;;
;; replace each transparent linefeed sequence by a single linefeed
   (goto-char (point-min))
   (while (search-forward (concat "/" transp-char "/") nil t)
     (replace-match "\n" t t nil)
   )
;; delete each line containing only single double-quote
   (goto-char (point-min))
   (while (re-search-forward "^\"$" nil t)
     (delete-region (1- (point)) (1+ (point)))
   )
;; sort the buffer
;; note that the window-ids are still present but at the end of lines so we may use sort-lines
   (goto-char (point-min))
   (sort-lines nil (point-min) (point-max))
;; save window ids in our persistent defvar - format is a vector of window-ids in linenumber sequence
;; if window name key is unique, remove window id
;; otherwise, for any sequence of repeated lines (identical window name key,  i.e. non-unique window names) :
;;      IF   that name is valid (there is still a window of that name)
;;      THEN leave the window-id in place
;;           (changing the transp-char sequence into the sequence Ctl-G<windowid>
;;            to make it disambiguable by sawinlist-raise)
   (goto-char (point-min))
   (setq prev-name "") ; note  -  we must use some name that could never be returned from sawfish
   (setq prev-repeated-name nil)
   (setq highlight-linenum nil)
   (setq lowlight-linenum nil)
   (setq current-linenum 0)
   (while (re-search-forward (concat "\\(\\*" transp-char "\\*\\)\\([0-9]+\\)") nil t)
     (setq current-linenum (1+ current-linenum))
     (setq windowid (match-string-no-properties 2))
     (setq windownum (string-to-number windowid))
     (setq start-of-windowid-section (match-beginning 0))
     (setq end-of-windowid-section (match-end 0))
;;   note highlight-window if in effect
     (cond
      ((and highlight-window-id (= highlight-window-id windownum))
       (setq highlight-linenum current-linenum)
     ))
;;   note lowlight-window if in effect
     (cond
      ((and (boundp 'sawinlist-lowlight-window-id) (numberp sawinlist-lowlight-window-id) (= sawinlist-lowlight-window-id windownum))
       (setq lowlight-linenum current-linenum)
     ))
;;   always delete the windowid section  -
;;   the corresponding ctl-G sequence will be inserted on next loop if needed
     (delete-region start-of-windowid-section end-of-windowid-section)
     (setq tempoint (point)) ; end of current window-name
     (beginning-of-line)
     (setq window-name (buffer-substring (point) start-of-windowid-section))
     (cond
      ((string= window-name prev-name)
       (setq current-repeated-name t)
      )
      (t  ; else different
       (setq current-repeated-name nil)
       (setq prev-name window-name)
      )
     )
;;   save its windowid
     (setq winid-list (cons windownum winid-list))
;;   insert window-id sequence at end of predecessor unless its name was distinct from its predecessor and ours
     (cond
       ( (or prev-repeated-name current-repeated-name)
         (forward-line -1)
         (end-of-line)
         (insert (concat "<" (format "%d" predecessor-windowid) ">"))
         (forward-line 1)
         (end-of-line)
       )
     )
     (setq prev-repeated-name current-repeated-name)
     (setq predecessor-windowid windownum)
   )
   (cond
     ( prev-repeated-name
       (end-of-line)
       (insert (concat "<" (format "%.0f" predecessor-windowid) ">"))
     )
   )
   (makunbound 'sawinlist-window-ids)
   (defvar sawinlist-window-ids (vconcat winid-list) "vector of sawinlist window ids")
;;
;; replace each sequence of three backslashes followed by double-quote by a single double-quote
   (goto-char (point-min))
   (while (search-forward "\\\\\\\"" nil t)
     (replace-match "\"" t t nil)
   )
;; replace each sequence of four backslashes by a single backslash
   (goto-char (point-min))
   (while (search-forward "\\\\\\\\" nil t)
     (replace-match "\\" t t nil)
   )
;;
;; chop off the prepended dash-suffices
   (goto-char (point-min))
   (while (re-search-forward (concat "^.* " transp-char " ") nil t)
     (replace-match "" t t nil)
   )
;; replace each sequence of two transp-chars by a single transp-char
   (goto-char (point-min))
   (while (search-forward (concat transp-char transp-char) nil t)
     (replace-match transp-char t t nil)
   )
;;  apply lowlighting if there was a highlighted line on previous build
;;  minor note  -  logically we should not apply a lowlight if there is a highlight to be applied to the same line.
;;                 however, this happens rarely (when re-selecting same window as we were already on)
;;                 and adding the check slows down all refreshes,  and is unnecessary since the following
;;                 application of highlighting places a new overlay on top.
   (cond
     (lowlight-linenum
       (goto-line lowlight-linenum)
          (cond
	    ((setq ovrly (make-overlay (progn (beginning-of-line) (point)) (progn (end-of-line) (point))))
	      (overlay-put ovrly 'face (list (cons 'background-color (aref sawinlist-low-high-light 0)) (cons 'foreground-color (aref sawinlist-low-high-light 1))))
	  ))
   ))
;;  apply highlighting if requested
   (makunbound 'sawinlist-lowlight-window-id)
   (cond
     (highlight-linenum
       (goto-line highlight-linenum)
          (cond
	    ((setq ovrly (make-overlay (progn (beginning-of-line) (point)) (progn (end-of-line) (point))))
	      (overlay-put ovrly 'face (list (cons 'background-color (aref sawinlist-low-high-light 2)) (cons 'foreground-color (aref sawinlist-low-high-light 3))))
	      (defvar sawinlist-lowlight-window-id highlight-window-id) ; for low-lighting
	  ))
   ))
)))