Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 189 lines (174 sloc) 8.566 kb
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
1 ;;; Window placement routines
2
3 (in-package :stumpwm)
4
5 (defun xwin-to-window (xwin)
6 "Build a window for XWIN"
7 (make-instance 'window
8 :xwin xwin
9 :width (xlib:drawable-width xwin) :height (xlib:drawable-height xwin)
10 :x (xlib:drawable-x xwin) :y (xlib:drawable-y xwin)
11 :title (xwin-name xwin)
12 :class (xwin-class xwin)
13 :res (xwin-res-name xwin)
14 :role (xwin-role xwin)
15 :type (xwin-type xwin)
1650598f »
2008-10-21 Merge branch 'master' into test
16 :normal-hints (get-normalized-normal-hints xwin)
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
17 :state +iconic-state+
18 :plist (make-hash-table)
19 :unmap-ignores 0))
20
4f0900b5 »
2008-11-06 Use PPCRE for rules matching instead of the "..." syntax.
21 (defvar *rule-scanners-cache* (make-hash-table :test 'equal)
22 "A cache for the ppcre scanners")
23
24 (defun get-or-create-rule-scanner (regex)
25 (or (gethash regex *rule-scanners-cache*)
26 (setf (gethash regex *rule-scanners-cache*)
27 (ppcre:create-scanner regex))))
28
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
29 (defun string-match (string pat)
4f0900b5 »
2008-11-06 Use PPCRE for rules matching instead of the "..." syntax.
30 (ppcre:scan (get-or-create-rule-scanner pat) string))
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
31
32 (defun window-matches-properties-p (window &key class instance type role title)
33 "Returns T if window matches all the given properties"
34 (and
4f0900b5 »
2008-11-06 Use PPCRE for rules matching instead of the "..." syntax.
35 (if class (string-match (window-class window) class) t)
36 (if instance (string-match (window-res window) instance) t)
37 (if type (string-match (window-type window) type) t)
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
38 (if role (string-match (window-role window) role) t)
39 (if title (string-match (window-title window) title) t) t))
40
bdbf07cf »
2008-08-09 Added support for automatic group creation and/or restoration.
41
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
42 (defun window-matches-rule-p (w rule)
43 "Returns T if window matches rule"
bdbf07cf »
2008-08-09 Added support for automatic group creation and/or restoration.
44 (destructuring-bind (group-name frame raise lock
45 &key create restore class instance type role title) rule
46 (declare (ignore frame raise create restore))
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
47 (if (or lock
242112aa »
2008-08-05 in window-matches-rule-p, check if the group slot is bound before usi…
48 (equal group-name (group-name (or (when (slot-boundp w 'group)
49 (window-group w))
50 (current-group)))))
bdbf07cf »
2008-08-09 Added support for automatic group creation and/or restoration.
51 (window-matches-properties-p w :class class
52 :instance instance
53 :type type
54 :role role
55 :title title))))
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
56
57 (defun rule-matching-window (window)
58 (dolist (rule *window-placement-rules*)
59 (when (window-matches-rule-p window rule) (return rule))))
60
61 (defun get-window-placement (screen window)
62 "Returns the ideal group and frame that WINDOW should belong to and whether
63 the window should be raised."
64 (let ((match (rule-matching-window window)))
65 (if match
bdbf07cf »
2008-08-09 Added support for automatic group creation and/or restoration.
66 (destructuring-bind (group-name frame raise lock
67 &key create restore class instance type role title) match
68 (declare (ignore lock class instance type role title))
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
69 (let ((group (find-group screen group-name)))
bdbf07cf »
2008-08-09 Added support for automatic group creation and/or restoration.
70 (cond (group
71 (when (and restore (stringp restore))
72 (let ((restore-file (data-dir-file restore)))
73 (if (probe-file restore-file)
74 (restore-group group
75 (read-dump-from-file restore-file))
76 (message "^B^1*Can't restore group \"^b~a^B\" with \"^b~a^B\"."
77 group-name restore-file))))
78 (values group (frame-by-number group frame) raise))
79 (create
80 (let ((new-group (add-group (current-screen) group-name))
81 (restore-file (if (stringp create)
82 (data-dir-file create)
83 (data-dir-file group-name))))
84 (if (and new-group
85 (probe-file restore-file))
86 (restore-group new-group
87 (read-dump-from-file restore-file))
88 (when (stringp create)
89 (message "^B^1*Can't restore group \"^b~a^B\" with \"^b~a^B\"."
90 group-name restore-file)))
91 (values new-group (frame-by-number new-group frame) raise)))
92 (t (message "^B^1*Error placing window, group \"^b~a^B\" does not exist." group-name)
93 (values)))))
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
94 (values))))
95
96 (defun sync-window-placement ()
97 "Re-arrange existing windows according to placement rules"
98 (dolist (screen *screen-list*)
99 (dolist (window (screen-windows screen))
bdbf07cf »
2008-08-09 Added support for automatic group creation and/or restoration.
100 (multiple-value-bind (to-group frame raise)
101 (with-current-screen screen
102 (get-window-placement screen window))
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
103 (declare (ignore raise))
104 (when to-group
105 (unless (eq (window-group window) to-group)
106 (move-window-to-group window to-group))
107 (unless (eq (window-frame window) frame)
108 (pull-window window frame)))))))
109
110 (defun assign-window (window group &optional (where :tail))
4366132e »
2008-08-03 fix up the window placement to properly put window in their frames on…
111 "Assign the window to the specified group and perform the necessary
112 housekeeping."
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
113 (setf (window-group window) group
114 (window-number window) (find-free-window-number group))
115 (if (eq where :head)
116 (push window (group-windows group))
4366132e »
2008-08-03 fix up the window placement to properly put window in their frames on…
117 (setf (group-windows group) (append (group-windows group) (list window))))
118 (setf (xwin-state (window-xwin window)) +iconic-state+)
119 (netwm-set-group window))
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
120
121 (defun place-window (screen window)
4366132e »
2008-08-03 fix up the window placement to properly put window in their frames on…
122 "Pick a group WINDOW and return the group-specific placement hints, if any."
123 (let* ((netwm-group (netwm-group window screen))
124 (placement (multiple-value-list (get-window-placement screen window)))
125 (placement-group (first placement))
126 (group (or (when *processing-existing-windows*
127 netwm-group)
128 placement-group
129 netwm-group
130 (screen-current-group screen))))
131 (assign-window window group (if *processing-existing-windows* :head :tail))
132 ;; if we're using the placement group, then return the extra data.
133 (when (eq group placement-group)
134 (list :frame (second placement)
135 :raise (third placement)))))
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
136
137 (defun pick-preferred-frame (window)
138 (let* ((group (window-group window))
139 (frames (group-frames group))
140 (default (tile-group-current-frame group))
141 (preferred-frame (or *new-window-preferred-frame* default)))
142 (when (or (functionp *new-window-preferred-frame*)
143 (and (symbolp *new-window-preferred-frame*)
144 (fboundp *new-window-preferred-frame*)))
145 (setq preferred-frame
146 (handler-case
147 (funcall *new-window-preferred-frame* window)
1650598f »
2008-10-21 Merge branch 'master' into test
148 (t (c)
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
149 (message "^1*^BError while calling ^b^3**new-window-preferred-frame*^1*^B: ^n~a" c)
150 default))))
151 (cond
152 ;; If we already have a frame use it.
153 ((frame-p preferred-frame)
154 preferred-frame)
155 ;; If `preferred-frame' is a list of keyword use it to determine the
156 ;; frame. The sanity check doesn't cover not recognized keywords. We
157 ;; simply fall back to the default then.
158 ((and (listp preferred-frame)
159 (every #'keywordp preferred-frame))
f839c796 »
2011-01-03 Fix issue with pick-preferred-frame not finding anything.
160 (or
161 (loop for i in preferred-frame
162 thereis (case i
163 (:last
164 ;; last-frame can be stale
165 (and (> (length frames) 1)
166 (tile-group-last-frame group)))
167 (:unfocused
168 (find-if (lambda (f)
169 (not (eq f (tile-group-current-frame group))))
170 frames))
171 (:empty
172 (find-if (lambda (f)
173 (null (frame-window f)))
174 frames))
175 (:choice
176 ;; Transient windows sometimes specify a location
177 ;; relative to the TRANSIENT_FOR window. Just ignore
178 ;; these hints.
179 (unless (find (window-type window) '(:transient :dialog))
180 (let ((hints (window-normal-hints window)))
181 (when (and hints (xlib:wm-size-hints-user-specified-position-p hints))
182 (find-frame group (window-x window) (window-y window))))))))
183 default))
3ba1e2d8 »
2008-07-31 add a group API and isolate all tile-group related code within the api
184 ;; Not well formed `*new-window-preferred-frame*'. Message an error and
185 ;; return the default.
186 (t (message "^1*^BInvalid ^b^3**new-window-preferred-frame*^1*^B: ^n~a"
187 preferred-frame)
188 default))))
Something went wrong with that request. Please try again.