1;; window-order.jl -- keep track of recently accessed windows
2
3;; Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>
4
5;; This file is part of sawfish.
6
7;; sawfish is free software; you can redistribute it and/or modify it
8;; under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; sawfish is distributed in the hope that it will be useful, but
13;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with sawfish; see the file COPYING.  If not, write to
19;; the Free Software Foundation, 51 Franklin Street, Fifth Floor,
20;; Boston, MA 02110-1301 USA.
21
22(define-structure sawfish.wm.util.window-order
23
24    (export window-order
25	    window-order-push
26	    window-order-pop
27	    window-order-most-recent
28	    window-order-focus-most-recent)
29
30    (open rep
31	  rep.system
32	  sawfish.wm.windows
33	  sawfish.wm.session.init
34	  sawfish.wm.workspace
35	  sawfish.wm.viewport)
36
37  (define-structure-alias window-order sawfish.wm.util.window-order)
38
39  ;; window order high-water-mark
40  (define window-order-highest 1)
41
42  ;; return windows in MRU order
43  (define (window-order #!optional workspace allow-iconified all-viewports)
44    (let ((windows (managed-windows)))
45      (setq windows (delete-if (lambda (w)
46				 (or (not (window-mapped-p w))
47				     (window-get w 'ignored)
48				     (and (not allow-iconified)
49					  (window-get w 'iconified))
50				     (and workspace
51					  (not (window-appears-in-workspace-p
52						w workspace)))))
53			       windows))
54      (unless all-viewports
55	(setq windows (delete-if window-outside-viewport-p windows)))
56      (sort windows (lambda (x y)
57		      (setq x (window-get x 'order))
58		      (setq y (window-get y 'order))
59		      (cond ((and x y)
60			     (> x y))
61			    (x t)
62			    (t nil))))))
63
64  ;; push window W onto the top of the cycle stack
65  (define (window-order-push w)
66    (window-put w 'order window-order-highest)
67    (setq window-order-highest (1+ window-order-highest))
68    (when (> window-order-highest 1000000)		;arbitrary big number
69      (window-order-compress)))
70
71  ;; remove window W from the order stack
72  (define (window-order-pop w)
73    (window-put w 'order nil))
74
75  ;; compress the order stack
76  (define (window-order-compress)
77    (let ((order (nreverse (window-order nil t t)))	;all windows
78	  (i 1))
79      (map-windows (lambda (w)
80		     (window-put w 'order nil)))
81      (mapc (lambda (w)
82	      (window-put w 'order i)
83	      (setq i (1+ i))) order)
84      (setq window-order-highest i)))
85
86  (define (window-order-most-recent #!key (windows 0))
87    "Return the most-recently focused window in the current workspace. If the
88WINDOWS argument is given it should be a list of windows, in this case the
89function will restrict its search to the elements of this list."
90    (let loop ((rest (window-order current-workspace nil)))
91      (cond ((null rest) nil)
92	    ((or (window-get (car rest) 'never-focus)
93		 (dock-window-p (car rest));; panel/pager workspace switcher
94		 (and (listp windows) (not (memq (car rest) windows))))
95	     (loop (cdr rest)))
96	    (t (car rest)))))
97
98  (define (window-order-focus-most-recent)
99    (set-input-focus (window-order-most-recent)))
100
101  (define (on-viewport-change)
102    ;; The problem is that any sticky windows that have been focused once
103    ;; will _always_ rise to the top of the order when switching viewports
104    ;; (since the topmost window is _always_ focused when entering a new
105    ;; workspace). The hacky solution is to remove the order of any sticky
106    ;; windows
107    (let ((order (window-order current-workspace)))
108      (mapc (lambda (w)
109	      (when (window-get w 'sticky-viewport)
110		(window-put w 'order nil))) order))
111    (unless (eq focus-mode 'enter-exit)
112      (window-order-focus-most-recent)))
113
114  (sm-add-saved-properties 'order)
115  (add-swapped-properties 'order)
116
117  (add-hook 'sm-after-restore-hook window-order-compress)
118  (add-hook 'iconify-window-hook window-order-pop)
119  (add-hook 'viewport-moved-hook on-viewport-change))
120