Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 160 lines (138 sloc) 5.87 kB
d449f45 @sabetts move head related functions from screen.lisp to head.lisp
sabetts authored
1 ;; Copyright (C) 2003-2008 Shawn Betts
2 ;;
3 ;; This file is part of stumpwm.
4 ;;
5 ;; stumpwm is free software; you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation; either version 2, or (at your option)
8 ;; any later version.
9
10 ;; stumpwm is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;; GNU General Public License for more details.
14
15 ;; You should have received a copy of the GNU General Public License
d8f75d5 Update FSF address
Wesley Dawson authored
16 ;; along with this software; see the file COPYING. If not, see
17 ;; <http://www.gnu.org/licenses/>.
d449f45 @sabetts move head related functions from screen.lisp to head.lisp
sabetts authored
18
19 ;; Commentary:
20 ;;
21 ;; Head functionality
22 ;;
23 ;; Code:
24
25 (in-package #:stumpwm)
26
27 (export '(current-head))
28
29 (defun head-by-number (screen n)
30 (find n (screen-heads screen) :key 'head-number))
31
32 (defun parse-xinerama-head (line)
33 (ppcre:register-groups-bind (('parse-integer number width height x y))
34 ("^ +head #([0-9]+): ([0-9]+)x([0-9]+) @ ([0-9]+),([0-9]+)" line :sharedp t)
35 (handler-case
36 (make-head :number number
37 :x x :y y
38 :width width
39 :height height)
40 (parse-error ()
41 nil))))
42
43 (defun make-screen-heads (screen root)
44 "or use xdpyinfo to query the xinerama extension, if it's enabled."
45 (or (and (xlib:query-extension *display* "XINERAMA")
46 (with-current-screen screen
47 ;; Ignore 'clone' heads.
48 (loop
49 for i = 0 then (1+ i)
50 for h in
51 (delete-duplicates
52 (loop for i in (split-string (run-shell-command "xdpyinfo -ext XINERAMA" t))
53 for head = (parse-xinerama-head i)
54 when head
55 collect head)
56 :test #'frames-overlap-p)
57 do (setf (head-number h) i)
58 collect h)))
59 (list (make-head :number 0
60 :x 0 :y 0
61 :width (xlib:drawable-width root)
62 :height (xlib:drawable-height root)
63 :window nil))))
64
65 (defun copy-heads (screen)
66 "Return a copy of screen's heads."
67 (mapcar 'copy-frame (screen-heads screen)))
68
69
70 ;; Determining a frame's head based on position probably won't
71 ;; work with overlapping heads. Would it be better to walk
72 ;; up the frame tree?
73 (defun frame-head (group frame)
7092bea @vtl Modify frame-head to work based on the center of the frame.
vtl authored
74 (let ((center-x (+ (frame-x frame) (ash (frame-width frame) -1)))
75 (center-y (+ (frame-y frame) (ash (frame-height frame) -1))))
76 (dolist (head (screen-heads (group-screen group)))
77 (when (and
78 (>= center-x (frame-x head))
79 (>= center-y (frame-y head))
80 (<= center-x
81 (+ (frame-x head) (frame-width head)))
82 (<= center-y
83 (+ (frame-y head) (frame-height head))))
84 (return head)))))
d449f45 @sabetts move head related functions from screen.lisp to head.lisp
sabetts authored
85
86 (defun group-heads (group)
87 (screen-heads (group-screen group)))
88
0feb156 @vtl Add resize-head function.
vtl authored
89 (defun resize-head (number x y width height)
90 "Resize head number `number' to given dimension."
91 (let* ((screen (current-screen))
92 (oh (find number (screen-heads screen) :key 'head-number))
93 (nh (make-head :number number
94 :x x :y y
95 :width width
96 :height height
97 :window nil)))
98 (scale-head screen oh nh)
5f81f05 @dangerousben Move tile group specific code out of head.lisp and into group methods.
dangerousben authored
99 (dolist (group (screen-groups screen)) (group-sync-head group oh))
0feb156 @vtl Add resize-head function.
vtl authored
100 (update-mode-lines screen)))
101
d449f45 @sabetts move head related functions from screen.lisp to head.lisp
sabetts authored
102 (defun current-head (&optional (group (current-group)))
103 (group-current-head group))
104
105 (defun head-windows (group head)
106 "Returns a list of windows on HEAD of GROUP"
107 (remove-if-not
108 (lambda (w)
109 (eq head (window-head w)))
110 (group-windows group)))
111
112 (defun frame-is-head (group frame)
113 (< (frame-number frame) (length (group-heads group))))
114
115 (defun add-head (screen head)
116 (dformat 1 "Adding head #~D~%" (head-number head))
117 (setf (screen-heads screen) (sort (push head (screen-heads screen)) #'< :key 'head-number))
118 (dolist (group (screen-groups screen))
5f81f05 @dangerousben Move tile group specific code out of head.lisp and into group methods.
dangerousben authored
119 (group-add-head group head)))
d449f45 @sabetts move head related functions from screen.lisp to head.lisp
sabetts authored
120
121 (defun remove-head (screen head)
122 (dformat 1 "Removing head #~D~%" (head-number head))
123 (when (head-mode-line head)
124 (toggle-mode-line screen head))
125 (dolist (group (screen-groups screen))
5f81f05 @dangerousben Move tile group specific code out of head.lisp and into group methods.
dangerousben authored
126 (group-remove-head group head))
d449f45 @sabetts move head related functions from screen.lisp to head.lisp
sabetts authored
127 ;; Remove it from SCREEN's head list.
128 (setf (screen-heads screen) (delete head (screen-heads screen))))
129
130 (defun scale-head (screen oh nh)
131 "Scales head OH to match the dimensions of NH."
132 (dolist (group (screen-groups screen))
5f81f05 @dangerousben Move tile group specific code out of head.lisp and into group methods.
dangerousben authored
133 (group-resize-head group oh nh))
d449f45 @sabetts move head related functions from screen.lisp to head.lisp
sabetts authored
134 (setf (head-x oh) (head-x nh)
135 (head-y oh) (head-y nh)
136 (head-width oh) (head-width nh)
137 (head-height oh) (head-height nh)))
138
139 (defun scale-screen (screen heads)
140 "Scale all frames of all groups of SCREEN to match the dimensions
141 of HEADS."
142 (when (< (length heads) (length (screen-heads screen)))
143 ;; Some heads were removed (or cloned), try to guess which.
144 (dolist (oh (screen-heads screen))
145 (dolist (nh heads)
146 (when (and (= (head-x nh) (head-x oh))
147 (= (head-y nh) (head-y oh)))
148 ;; Same screen position; probably the same head.
149 (setf (head-number nh) (head-number oh)))))
150 ;; Actually remove the missing heads.
151 (dolist (head (set-difference (screen-heads screen) heads :key 'head-number))
152 (remove-head screen head)))
153 (loop
154 for nh in heads
155 as oh = (find (head-number nh) (screen-heads screen) :key 'head-number)
156 do (if oh
157 (scale-head screen oh nh)
158 (add-head screen nh))))
159
Something went wrong with that request. Please try again.