Re: [Sawfish] single-window-mode approach

[Christopher Roy Bratusek <nano@xxxxxxxxxxxxx>]

OK. Almost finished.

Changes since last Mail:
- split/more helper funcs and better code
- user-option whether to maximize-fullscreen a single-window-mode-window
- per-workspace single-window-mode
- single-window window-matcher
- handle case where a single-window on workspace already exists and user 
toggles a different one on the same workspace
- use unmap hook rather than destroy-notify


Known Bugs:
- doesn't work with windows whichs class contains "-" (if such a window is 
going to be single-window'd nothing happens atm).

Code is attached, feel free to test and comment.
Chris

;; SWM (single-window-mode)

(defvar single-window-mode-window-fullscreen nil)
(defvar single-window-mode-list ())

(define (single-window-mode-list-append ws class)
  "Add a single-window to the list."
  (setq single-window-mode-list
    (append single-window-mode-list `((,ws . ,class)))))

(define (single-window-mode-list-remove ws class)
  "Remove a single-window from the list."
  ;; not working for classes with "-"?
  (setq single-window-mode-list
    (remove `(,ws . ,class) single-window-mode-list)))

(define (single-window-on-workspace-p ws)
  "Whether there's a single-window on workspace `ws'."
  (if (assoc ws single-window-mode-list) t nil))

(define (single-window-mode-get-window-for-workspace ws)
  "Return single-window for workspace `ws' or nil, if none."
  (let ((class (cdr (assoc ws single-window-mode-list))))
    (if class (get-window-by-class class) nil)))

(define (single-window-mode-get-workspace-for-window class)
  "Return workspace for single-window `win' or nil, if none."
  (car (rassoc class single-window-mode-list)))

(define (toggle-single-window-mode #!optional w)
  "Toggle single-window-mode for window `w'."
  (let ((win (if w w (input-focus)))
	(window-ws))
    (setq window-ws (if (window-on-current-workspace-p win)
 		        current-workspace
		      ;; XXX 'sticky winodws?
		      (car (window-workspaces win))))
    ;; not yet working
    (unless (string-match "-" (window-class win))
      (if (eq (window-class win) (cdr (assoc window-ws single-window-mode-list)))
	  (single-window-mode-stop win) 
	(if (single-window-on-workspace-p window-ws)
	    (progn
	      (single-window-mode-stop (single-window-mode-get-window-for-workspace window-ws))
	      (single-window-mode-start win))
	(single-window-mode-start win))))))

(define-command 'toggle-single-window-mode toggle-single-window-mode)

(define (single-window-mode-core start w)
  (let ((iconify-group-mode 'none)
	(raise-windows-on-uniconify nil)
	(default-window-animator 'none))
    (if start
	(map-other-window-groups
	  (lambda (x)
	    (when (windows-share-workspace-p w x)
	      (if (or (window-get x 'ignore)
		      (window-get x 'avoid))
		  (lower-window x)
		(iconify-window x)))) w)
      (map-other-window-groups
	  (lambda (x)
	    (when (windows-share-workspace-p w x)
	      (if (or (window-get x 'ignore)
		      (window-get x 'avoid))
		  (raise-window x)
		(uniconify-window x)))) w))))

(define (single-window-mode-start w)
  "Start single-window-mode for window `w'."
  
  (when single-window-mode-window-fullscreen
    (maximize-window-fullscreen w))

  (single-window-mode-list-append (if (window-on-current-workspace-p w)
				      current-workspace
				    (car (window-workspaces w)))
                                  (window-class w))

  (single-window-mode-core t w))

(define (single-window-mode-stop w)
  "Stop single-window-mode for window `w'."
  
  (when single-window-mode-window-fullscreen
    (unmaximize-window w))

  (single-window-mode-list-remove (if (window-on-current-workspace-p w)
				      current-workspace
				    (car (window-workspaces w)))
                                  (window-class w))

  (single-window-mode-core nil w))

(define (single-window-mode-after-add-window w)
  (when (and (window-get w 'single-window)
	     ;; not yet working
	     (not (string-match "-" (window-class w))))
    (toggle-single-window-mode w)))

(define (single-window-mode-unmap-notify w)
  (let ((ws (single-window-mode-get-workspace-for-window (window-class w)))
        (class (window-class w)))
    (message (format nil "class %s <> ws %s" class ws))
    (when (and ws class)
      (single-window-mode-list-remove ws class)
      (map-windows (lambda (x)
        (if (or (window-get x 'ignored)
                (window-get x 'avoid))
            (raise-window x)
          (uniconify-window x)))
        (workspace-windows ws))))) 

(add-hook 'after-add-window-hook single-window-mode-after-add-window t)
(add-hook 'unmap-notify-hook single-window-mode-unmap-notify t)