/[eclipse]/eclipse/virtual-screen.lisp
ViewVC logotype

Contents of /eclipse/virtual-screen.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.24 - (show annotations)
Mon Jan 17 22:53:39 2005 UTC (9 years, 3 months ago) by ihatchondo
Branch: MAIN
CVS Tags: HEAD
Changes since 1.23: +35 -11 lines
Documentation update and minor clean up.
1 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
2 ;;; $Id: virtual-screen.lisp,v 1.24 2005/01/17 22:53:39 ihatchondo Exp $
3 ;;;
4 ;;; Copyright (C) 2002 Iban HATCHONDO
5 ;;; contact : hatchond@yahoo.fr
6 ;;;
7 ;;; This program is free software; you can redistribute it and/or
8 ;;; modify it under the terms of the GNU General Public License
9 ;;; as published by the Free Software Foundation.
10 ;;;
11 ;;; This program is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
15 ;;;
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with this program; if not, write to the Free Software
18 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19
20 ;;;; Virtual screen
21
22 (in-package :ECLIPSE-INTERNALS)
23
24 ;;;; Private
25
26 (defun window-belongs-to-vscreen-p
27 (win scr-num iconify-p skip-taskbar skip-desktop skip-dock)
28 (when (lookup-widget win)
29 (let ((n (or (window-desktop-num win) -1))
30 (wm-state (car (wm-state win)))
31 (netwm-type (netwm:net-wm-window-type win))
32 (netwm-state (netwm:net-wm-state win)))
33 (and (or (= n scr-num) (= n +any-desktop+))
34 (or (eq wm-state 1) (and iconify-p (eq wm-state 3)))
35 (not (and skip-taskbar
36 (member :_net_wm_state_skip_taskbar netwm-state)))
37 (not (and skip-taskbar
38 (member :win_hints_skip_taskbar (gnome:win-hints win))))
39 (not (and skip-desktop
40 (member :_net_wm_window_type_desktop netwm-type)))
41 (not (and skip-dock
42 (member :_net_wm_window_type_dock netwm-type)))))))
43
44 (defun map-or-unmap-vscreen (fun scr-num)
45 (declare (optimize (speed 3) (safety 0)))
46 (declare (type function fun))
47 (loop for widget being each hash-value in *widget-table*
48 when (application-p widget) do
49 (with-slots (window master) widget
50 (when (and (eq (window-desktop-num window) scr-num)
51 (eq (car (wm-state window)) 1))
52 (let ((mwindow (when master (widget-window master))))
53 (funcall fun (or mwindow window))
54 (when (and mwindow (not (shaded-p widget)))
55 (with-event-mask (mwindow)
56 (funcall fun window))))))))
57
58 ;;;; Public
59
60 (defun current-vscreen (win)
61 "Returns the current virtual screen index. The window parameter must be
62 the window that owns the win_workspace or _net_current_desktop property."
63 (or (netwm:net-current-desktop win) (gnome:win-workspace win) 0))
64
65 (defun number-of-virtual-screens (win)
66 "Returns the number of virtual screens. The window parameter must be the
67 window that owns the win_workspace_count or _net_number_of_desktops
68 property."
69 (or (gnome:win-workspace-count win) (netwm:net-number-of-desktops win) 1))
70
71 (defsetf number-of-virtual-screens () (n)
72 "Sets the number of virtual screens (desktops). If the given value is less
73 than the actual number of virtual screens, then all applications that
74 belongs to the virtual screens that will be removed will be re-attached
75 to the last one (new-value - 1)."
76 `(with-slots (window) *root*
77 (let ((nb-vscreens (number-of-virtual-screens window))
78 (cur (current-vscreen window)))
79 (unless (or (zerop ,n) (= ,n nb-vscreens))
80 (when (< ,n nb-vscreens)
81 (loop for widget being each hash-value in *widget-table*
82 when (application-p widget) do
83 (with-slots ((win window)) widget
84 (let ((i (or (ignore-errors (window-desktop-num win)) -1)))
85 (when (and (>= i ,n) (/= i +any-desktop+))
86 (setf (window-desktop-num win) (1- ,n)))))))
87 (cond ((> cur (1- ,n)) (change-vscreen *root* :n (1- ,n)))
88 ((= cur (1- ,n)) (map-or-unmap-vscreen #'xlib:map-window cur)))
89 (setf (netwm:net-desktop-viewport window) (make-viewport-property ,n)
90 (gnome:win-workspace-count window) ,n
91 (netwm:net-number-of-desktops window) ,n)
92 (initialize-eclipse-desktop-pointer-positions *root*)
93 (update-workarea-property *root*)))))
94
95 (defun input-focus (display)
96 "Finds and returns the application that is currently focused if anyone is."
97 (loop with w = (xlib:input-focus display)
98 until (or (not (xlib:window-p w)) (application-p (lookup-widget w)))
99 do (multiple-value-bind (children parent) (xlib:query-tree w)
100 (declare (ignore children))
101 (setf w parent))
102 finally (return w)))
103
104 (defmethod change-vscreen ((root root) &key direction (n 1))
105 "Change the current visible virtual screen.
106 :direction (or null function): a designator for a function that must take
107 two integer arguments and that returns an integer. The arguments will be
108 the current virtual screen index and the value of :n (1 by default).
109 :n (integer): If :direction is given then it will be used to compute the new
110 virtual screen index with the direction function. If :direction isn't given
111 then it will be used as the new virtual screen index."
112 (declare (type (or null function) direction))
113 (with-slots ((rw window)) root
114 (let* ((nb-vscreens (number-of-virtual-screens rw))
115 (cur (netwm:net-current-desktop rw))
116 (new (mod (if direction (funcall direction cur n) n) nb-vscreens)))
117 (unless (integerp new)
118 (error "No destination given to change-vscreen~%"))
119 (when (and (< -1 new nb-vscreens) (/= cur new))
120 (with-event-mask (rw)
121 ;; If focus policy is on click: save the latest focused application.
122 (when (eq *focus-type* :on-click)
123 (let ((widget (lookup-widget (input-focus *display*))))
124 (when (application-p widget)
125 (setf (application-wants-focus-p widget) t))))
126 (xlib:set-input-focus *display* :pointer-root :pointer-root)
127 (xlib:with-server-grabbed (*display*)
128 (with-pointer-grabbed (rw (xlib:make-event-mask))
129 (map-or-unmap-vscreen #'xlib:unmap-window cur)
130 (map-or-unmap-vscreen #'xlib:map-window new))))
131 (setf (gnome:win-workspace rw) new
132 (netwm:net-current-desktop rw) new)
133 (when *save-and-restore-pointer-position-during-workspace-switch*
134 (setf (eclipse-desktop-pointer-positions rw cur)
135 (xlib:query-pointer rw))
136 (multiple-value-call #'xlib:warp-pointer
137 rw (eclipse-desktop-pointer-positions rw new)))
138 (when (eq *focus-type* :on-click)
139 (give-focus-to-next-widget-in-desktop))
140 (when *change-desktop-message-active-p*
141 (timed-message-box rw (or (nth new (workspace-names rw))
142 (format nil "WORKSPACE ~D" new))))))))
143
144 (defun screen-content (scr-num
145 &key (predicate #'window-belongs-to-vscreen-p) iconify-p
146 (skip-taskbar t) (skip-desktop t) (skip-dock t))
147 "Returns the list of application's windows that represent the contents
148 of the given virtual screen.
149 :iconify-p to include or not iconfied windows (default nil).
150 :skip-taskbar to include window with skip-taskbar hint (default t).
151 :skip-desktop to include window with desktop window type (default t).
152 :skip-dock to include window with dock window type (default t).
153 :predicate a designator for a function of six arguments:
154 window screen-number iconify-p skip-taskbar-p skip-desktop-p skip-dock-p."
155 (declare (type function predicate))
156 (loop with i = (if (eql scr-num +any-desktop+) (current-desk) scr-num)
157 for w in (query-application-tree *root-window*)
158 if (funcall predicate w i iconify-p skip-taskbar skip-desktop skip-dock)
159 collect w))
160
161 (defun give-focus-to-next-widget-in-desktop ()
162 "Gives the focus to the window that is on top of the stacking order."
163 (loop with focus-dest = nil
164 for window in (reverse (screen-content (current-desk)))
165 when (eq :viewable (xlib:window-map-state window))
166 do (with-slots (input-model wants-focus-p) (lookup-widget window)
167 (unless (eq input-model :no-input)
168 (when wants-focus-p
169 (setf focus-dest (lookup-widget window))
170 (loop-finish))
171 (unless focus-dest (setf focus-dest window))))
172 finally
173 (typecase focus-dest
174 (application (put-on-top focus-dest))
175 (xlib:window (focus-widget (lookup-widget focus-dest) nil))
176 (t (focus-widget *root* nil)))))
177
178 (defmethod circulate-window
179 ((root root) &key direction (nth 0) icon-p windows (desk (current-desk)))
180 "Lowers the nth highest mapped child of the specified virtual screen
181 (indicated by the :desk key argument) if direction is :below. If direction
182 is :above then it raises the nth lowest mapped child of the specified
183 virtual screen.
184 :direction (or null :above :below): the restack order (default to :below).
185 :nth (unsigned-byte *): the nth application to restack (default to 0).
186 :icon-p (boolean): if T then the circulation will includes iconified
187 applications that belongs to the specified virtual screen.
188 :windows (list): the list of window into which the restack must be computed.
189 If not given then (screen-content desk :iconify-p icon-p) will be used.
190 :desk (unsigned-byte *): the index of the virtual screen on which the
191 restacking s taking place. (default to (current-desk))."
192 (unless windows
193 (setf windows (reverse (screen-content desk :iconify-p icon-p))))
194 (or windows (return-from circulate-window nil))
195 (let ((length (length windows)))
196 (setf nth (mod nth length))
197 (let ((above-p (eq direction :above))
198 (focus-dest (nth nth windows))
199 (first (lookup-widget (car windows))))
200 ;; Grab the pointer to avoid enter notify events race concurrence
201 ;; between the window hierarchy change and the warp-pointer call.
202 (with-pointer-grabbed ((widget-window root) (xlib:make-event-mask))
203 (when (and (/= length 1) icon-p (application-wants-iconic-p first))
204 (iconify first))
205 (flet ((set-window-priority (window sibling priority)
206 (with-slots (master) (lookup-widget window)
207 (when master (setf window (widget-window master))))
208 (when (lookup-widget sibling)
209 (with-slots (master) (lookup-widget sibling)
210 (when master (setf sibling (widget-window master)))))
211 (setf (window-priority window sibling) priority)))
212 (cond ((= length 1) (set-window-priority focus-dest nil :above))
213 ((= nth 0)
214 (let ((sibling (if above-p (last windows) (cdr windows))))
215 (set-window-priority (car windows) (car sibling) :below)
216 (setf focus-dest (second windows))))
217 ((or (and (= nth (1- length)) (not above-p))
218 (and (= nth 1) above-p))
219 (set-window-priority focus-dest nil :above))
220 (t (unless above-p
221 (setf focus-dest (nth (incf nth) windows)))
222 (set-window-priority (car windows) focus-dest :below)
223 (set-window-priority focus-dest nil :above))))
224 (with-slots (master) (setf focus-dest (lookup-widget focus-dest))
225 (when (and icon-p (application-iconic-p focus-dest))
226 (uniconify (application-icon focus-dest))
227 (setf (application-wants-iconic-p focus-dest) t))
228 (when master (setf focus-dest master)))
229 (when *warp-pointer-when-cycle*
230 (xlib:warp-pointer (widget-window focus-dest) 8 5)))
231 (when *focus-when-window-cycle*
232 (focus-widget focus-dest 0))
233 focus-dest)))

  ViewVC Help
Powered by ViewVC 1.1.5