;; group.jl - Make window groups ;; ;; Author : Yann Hodique ;; ;; Modified by Scott Scriven ;; (mostly hook updates) (define-structure sigma.group (export group-window release-window offset same-group-p raise-left-window raise-right-window map-other-grouped-windows delete-window-from-group delete-window-from-groups put-window-in-group position dimensions window-list siggroup-position siggroup-dimensions siggroup-window-list window-group-index find-window rank refresh-group released-window-hook grouped-window-hook groups move-resize-to) (open rep rep.system rep.data.records rep.data.tables sawfish.wm sawfish.wm.windows sawfish.wm.stacking sawfish.wm.state.shading sigma.refs) ;; siggroup record is composed of a position, dimensions and a list of windows (define-record-type :siggroup (siggroup pos dim wlist) siggroup-p (pos siggroup-position set-siggroup-position) (dim siggroup-dimensions set-siggroup-dimensions) (wlist siggroup-window-list set-siggroup-window-list)) ;; siggroup printer (define-record-discloser :siggroup (lambda (x) `(group ,(siggroup-position x) ,(siggroup-dimensions x) ,(siggroup-window-list x)))) ;; Table containing the existing groups (define groups (make-sigtable)) ;; Some lock variables (define refresh-lock t) (define move-lock t) ;;;;;;;;;;; ;; Hooks : ;; (define released-window-hook nil) (define grouped-window-hook nil) ;;;;;;;;;;;;;;; ;; Functions : ;; (define (position index) (siggroup-position (sigtable-ref index))) (define (dimensions index) (siggroup-dimensions (sigtable-ref index))) (define (window-list index) (siggroup-window-list (sigtable-ref index))) ;; Move and resize according to *frame* dimensions (define (move-resize-frame-window-to win x y w h) (let* ((dim1 (window-dimensions win)) (dim2 (window-frame-dimensions win)) (dw (- (car dim2) (car dim1))) (dh (- (cdr dim2) (cdr dim1)))) (move-resize-window-to win x y (- w dw) (- h dh))) ) (define (move-resize-to index x y w h) (let ((win (car (siggroup-window-list (sigtable-ref groups index))))) (move-resize-frame-window-to win x y w h))) ;; Return the index of a new group containing only win (define (make-new-group win) (let* ((pos (window-position win)) (dim (window-frame-dimensions win)) (group (siggroup pos dim (list win))) (index (sigtable-set groups group))) (window-put win 'siggroup index) index)) ;; Return a group containing win (define (find-window win) (sigtable-ref groups (window-group-index win))) ;; Return the index of the group containing win (define (window-group-index win) (let ((index (window-get win 'siggroup))) (if index index (make-new-group win)))) ;; Rank of an element in a list (define (rank elem list) (if (eq elem (car list)) 0 (+ 1 (rank elem (cdr list))))) ;; Remove a window from a group at given index (define (delete-window-from-group win index) (let* ((old (sigtable-ref groups index)) (l (remove win (siggroup-window-list old)))) (if (null l) (sigtable-unset groups index) (sigtable-set groups (siggroup (siggroup-position old) (siggroup-dimensions old) l) index) (refresh-group (car l) 'frame) ))) ;; Find window's group and remove it (define (delete-window-from-groups w) (delete-window-from-group w (window-group-index w))) ;; Put window in group at given index (define (put-window-in-group win index) (let* ((group (sigtable-ref groups index)) (dim (siggroup-dimensions group)) (pos (siggroup-position group))) (sigtable-set groups (siggroup (siggroup-position group) (siggroup-dimensions group) (append (siggroup-window-list group) (list win))) index) (window-put win 'siggroup index) (move-resize-frame-window-to win (car pos) (cdr pos) (car dim) (cdr dim)) (rebuild-frame win) )) ;; Refresh the entire group containing win according to prop. prop can be one of the symbols : frame, move, resize, sticky, shade, unshade (define (refresh-group win prop) (if refresh-lock (progn (setq refresh-lock nil) (let* ((index (window-group-index win)) (wins (siggroup-window-list (sigtable-ref groups index)))) (cond ((eq prop 'frame) (mapcar (lambda (w) (rebuild-frame w)) wins) ) ((or (eq prop 'move) (eq prop 'resize)) (let ((dim (window-frame-dimensions win)) (pos (window-position win))) (mapcar (lambda (w) (move-resize-frame-window-to w (car pos) (cdr pos) (car dim) (cdr dim)) (rebuild-frame w)) wins) (sigtable-set groups (siggroup pos dim wins) index))) ((eq prop 'sticky) (mapcar (lambda (w) (toggle-window-sticky w)) wins) ) ((eq prop 'shade) (mapcar (lambda (w) (shade-window w) (rebuild-frame w)) wins) ) ((eq prop 'unshade) (mapcar (lambda (w) (unshade-window w) (rebuild-frame w)) wins) ) )) (setq refresh-lock t) ))) ;; Put active window in pointer-selected group (define (group-window w win) (interactive) (let* ((index (window-group-index win)) (index2 (window-group-index w))) (refresh-group win 'move) ;ugly hack, don't know why it's needed, but new groups are listed with pos (0,0) (put-window-in-group w index) (delete-window-from-group w index2) (refresh-group w 'move) (call-window-hook 'grouped-window-hook w) )) ;; Release active window from its group (define (release-window w #!optional inhibit-hook) (interactive "%W") (delete-window-from-groups w) (if (not inhibit-hook) (call-window-hook 'released-window-hook w)) (prog1 (make-new-group w) (refresh-group w 'frame)) ) ;; Return the window at position (pos+n) in window's group (define (offset win n) (let* ((gr (siggroup-window-list (find-window win))) (size (length gr)) (r (rank win gr))) (nth (modulo (+ r n) size) gr))) ;; Predicate : true <=> w1 and w2 are grouped together (define (same-group-p w1 w2) (let ((id1 (window-get w1 'siggroup)) (id2 (window-get w2 'siggroup))) (and (equal id1 id2) (not (null id1))))) ;; Raise left window in current group (define (raise-left-window w) (interactive "%W") (let ((win (offset w -1))) (raise-window win) (set-input-focus win)) ) ;; Raise right window in current group (define (raise-right-window w) (interactive "%W") (let ((win (offset w 1))) (raise-window win) (set-input-focus win)) ) ;; Map a function over the other windows in win's group (define (map-other-grouped-windows win func) (mapcar func (delete-if (lambda (w) (eq w win)) (siggroup-window-list (find-window win))))) ;;;;;;;;;;;;;;;;;;; ;; Hooking stuff : ;; (add-hook 'window-state-change-hook (lambda (win args) (if (eq 'sticky args) (refresh-group win 'sticky)))) (add-hook 'while-moving-hook (lambda (win) (refresh-group win 'move))) (add-hook 'while-resizing-hook (lambda (win) (refresh-group win 'resize))) (add-hook 'window-maximized-hook (lambda (win args) (refresh-group win 'resize))) (add-hook 'window-unmaximized-hook (lambda (win args) (refresh-group win 'resize))) (add-hook 'after-move-hook (lambda (win args) (refresh-group win 'move))) (add-hook 'after-resize-hook (lambda (win args) (refresh-group win 'resize))) (add-hook 'shade-window-hook (lambda (win) (refresh-group win 'shade))) (add-hook 'unshade-window-hook (lambda (win) (refresh-group win 'unshade))) (add-hook 'destroy-notify-hook delete-window-from-groups) ;; (add-hook 'add-to-workspace-hook (lambda (win lws) ;; (if sigma-group-move-lock ;; (progn ;; (setq sigma-group-move-lock nil) ;; (mapcar (lambda (w) (copy-window-to-workspace w lws)) ;; (delete-if ;; (lambda (w) (eq w win)) ;; (siggroup-window-list (sigma-group-find-window win)))) ;; (setq sigma-group-move-lock t) ;; )))) ;; (add-hook 'remove-from-workspace-hook (lambda (win lws) ;; (if sigma-group-move-lock ;; (progn ;; (setq sigma-group-move-lock nil) ;; (mapcar (lambda (w) (window-remove-from-workspace w lws)) ;; (delete-if ;; (lambda (w) (eq w win)) ;; (siggroup-window-list (sigma-group-find-window win)))) ;; (setq sigma-group-move-lock t) ;; )))) )