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)
