/[eclipse]/extensions/commands.lisp
ViewVC logotype

Contents of /extensions/commands.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (show annotations)
Sun Sep 18 17:48:14 2005 UTC (8 years, 7 months ago) by ihatchondo
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +24 -24 lines
Documentation fix
1 ;;; -*- Mode: Lisp; Package: ECLIPSE-EXTENSIONS -*-
2 ;;; $Id: commands.lisp,v 1.5 2005/09/18 17:48:14 ihatchondo Exp $
3 ;;;
4 ;;; ECLIPSE. The Common Lisp Window Manager.
5 ;;; Copyright (C) 2004 Iban HATCHONDO
6 ;;; contact : hatchond@yahoo.fr
7 ;;;
8 ;;; This program is free software; you can redistribute it and/or
9 ;;; modify it under the terms of the GNU General Public License
10 ;;; as published by the Free Software Foundation.
11 ;;;
12 ;;; This program is distributed in the hope that it will be useful,
13 ;;; but 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 this program; if not, write to the Free Software
19 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
20
21 ;;;
22 ;;; Implementation notes:
23
24 ;;; This is a collection of the most wanted strokes callback. You'll find the
25 ;;; callbacks in the part named Public. The rest is some macros and functions
26 ;;; that helps in the callbacks definition. At the end of this file you'll
27 ;;; also find some keystroke definition examples.
28 ;;; The simplest way to use this is to add at the beginning of your eclipse
29 ;;; configuration file a load form like the following:
30 ;;; (load "<path where you put it>/command.lisp")
31 ;;; or to the compiled file if you prefer. But do not forget to compile it in
32 ;;; environment in which eclipse is defined.
33 ;;; Then define all the strokes you want with as callbacks those functions.
34
35 ;;; The callbacks are divide in three parts:
36 ;;; - callbacks that do not apply on a particular widget such as show-desktop.
37 ;;;
38 ;;; - callbacks that applies on pointered widget. What means that the widget
39 ;;; that will be used is the one under the pointer. Usually those callbacks
40 ;;; will be used by people who use sloppy focus style (:none in Eclipse).
41 ;;;
42 ;;; - callbacks that applies on focused widget. What means that the widget
43 ;;; that will be used is the one that is currently focused when keystroke is
44 ;;; pressed. Usually those callbacks will be used by people who use on click
45 ;;; focus style (:on-click in Eclipse).
46
47 ;;; key-combo definitions examples.
48
49 ;;; (define-key-combo :send-focusded-widget-to-next-workspace
50 ;;; :keys '(:RIGHT)
51 ;;; :modifiers '(:and :CONTROL-LEFT :SHIFT-LEFT)
52 ;;; :default-modifiers-p t
53 ;;; :fun (action
54 ;;; (:press (eclipse-ext:send-focused-widget-to-next-workspace)) ()))
55
56 ;;; (define-key-combo :send-focused-widget-to-prev-workspace
57 ;;; :keys '(:LEFT)
58 ;;; :modifiers '(:and :CONTROL-LEFT :SHIFT-LEFT)
59 ;;; :default-modifiers-p t
60 ;;; :fun (action
61 ;;; (:press (eclipse-ext:send-focused-widget-to-prev-workspace)) ()))
62
63 ;;; mouse combo example.
64
65 ;;; (define-mouse-combo :close-pointered-widget
66 ;;; ;; pointered is not necessarily the window with the focus in :on-click
67 ;;; ;; mode. If you want the focused window use close-focused-widget instead.
68 ;;; ;; It is not kill. E.G: a window may not respond to the message.
69 ;;; :button 1
70 ;;; :modifiers '(:and :ALT-LEFT :CONTROL-LEFT)
71 ;;; :default-modifiers-p t
72 ;;; :fun (action ()
73 ;;; (:press
74 ;;; ;; We can not grab the button release event
75 ;;; ;; so a mouse action will take place on click.
76 ;;; (eclipse-ext:close-pointered-widget))))
77
78 (in-package :eclipse-extensions)
79
80 (export '(show-desktop
81 send-pointered-widget-to-next-workspace
82 send-pointered-widget-to-prev-workspace
83 maximize-pointered-widget iconify-pointered-widget
84 close-pointered-widget kill-pointered-widget
85 send-focused-widget-to-next-workspace
86 send-focused-widget-to-prev-workspace
87 maximize-focused-widget iconify-focused-widget
88 close-focused-widget kill-focused-widget
89 with-pointered-widget with-focused-widget))
90
91 ;;;; Public macros.
92
93 (defmacro with-pointered-widget ((widget) &body forms)
94 "Executes the body in a lexical environment where the given symbol
95 is binded to the widget located under the mouse pointer."
96 (with-gensym (x y ssp child)
97 `(multiple-value-bind (,x ,y ,ssp ,child)
98 (xlib:query-pointer *root-window*)
99 (declare (ignorable ,x ,y ,ssp))
100 (let ((,widget (lookup-widget ,child)))
101 ,@forms))))
102
103 (defmacro with-focused-widget ((widget) &body forms)
104 "Executes the body in a lexical environment where the given symbol
105 is binded to the widget that has the focus."
106 (let ((window (gensym)))
107 `(let* ((,window (netwm:net-active-window *root-window* :window-list t))
108 (,widget (lookup-widget ,window)))
109 ,@forms)))
110
111 ;;;; Private routines.
112
113 (defun send-net-wm-desktop-message (widget workspace-dest)
114 (event-process
115 (make-event
116 :client-message
117 :type :_net_wm_desktop
118 :data (make-array 1 :element-type '(unsigned-byte 32)
119 :initial-element workspace-dest))
120 widget))
121
122 (defun migrate-pointered (direction &key (change-workspace t))
123 (setf direction (ecase direction (:next #'1+) (:prev #'1-)))
124 (with-pointered-widget (widget)
125 (let* ((n (number-of-virtual-screens *root-window*))
126 (workspace-dest (mod (funcall direction (current-desk)) n)))
127 (typecase widget
128 (decoration (setf widget (get-child widget :application)))
129 (application nil)
130 (t (return-from migrate-pointered nil)))
131 (send-net-wm-desktop-message widget workspace-dest)
132 (when change-workspace
133 (change-vscreen *root* :n workspace-dest)))))
134
135 (defun migrate-focused (direction &key (change-workspace t))
136 (setf direction (ecase direction (:next #'1+) (:prev #'1-)))
137 (with-focused-widget (widget)
138 (let* ((n (number-of-virtual-screens *root-window*))
139 (workspace-dest (mod (funcall direction (current-desk)) n)))
140 (typecase widget
141 (decoration (setf widget (get-child widget :application)))
142 (application nil)
143 (t (return-from migrate-focused nil)))
144 (when change-workspace
145 (change-vscreen *root* :n workspace-dest)
146 (when (eq *focus-type* :on-click) (put-on-top widget)))
147 (send-net-wm-desktop-message widget workspace-dest))))
148
149 (defun maximize-command (widget &key (direction :both))
150 "Maximize a widget in the given direction.
151 :DIRECTION (member :both :vertical :horizontal) : indicates the direction
152 in which the widget should be maximized."
153 (declare (type (member :both :vertical :horizontal) direction))
154 (let ((mode (position direction '#(:both :vertical :horizontal))))
155 (typecase widget
156 (decoration (maximize widget (1+ mode)))
157 (application (maximize widget (1+ mode))))))
158
159 (defun iconify-command (widget)
160 (typecase widget
161 (application nil)
162 (decoration (setf widget (get-child widget :application)))
163 (t (return-from iconify-command nil))))
164
165 (defun kill-widget-command (widget)
166 (typecase widget
167 (decoration (kill-client-window (get-child widget :application :window t)))
168 (application (kill-client-window (widget-window widget)))))
169
170 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
171 ;;;; ;;;;
172 ;;;; Public. ;;;;
173 ;;;; Callbacks for "most wanted" strokes. ;;;;
174 ;;;; ;;;;
175 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
176
177 (defun show-desktop ()
178 "Iconifies all applications on the current virtual screen."
179 (mapc (lambda (w) (iconify (lookup-widget w)))
180 (screen-content (current-desk) :skip-taskbar nil)))
181
182 ;; pointered.
183
184 (defun send-pointered-widget-to-next-workspace (&key (change-workspace t))
185 "Sends the pointered window in the next workspace.
186 If :change-workspace is NIL then eclipse will not change the current
187 workspace to the one the window just migrate. (default value is T)."
188 (migrate-pointered :next :change-workspace change-workspace))
189
190 (defun send-pointered-widget-to-prev-workspace (&key (change-workspace t))
191 "Sends the pointered window in the previous workspace.
192 If :change-workspace is NIL then eclipse will not change the current
193 workspace to the one the window just migrate. (default value is T)."
194 (migrate-pointered :prev :change-workspace change-workspace))
195
196 (defun maximize-pointered-widget (&key (direction :both))
197 "Maximize the widget located under the mouse pointer in the given direction.
198 :DIRECTION (member :both :vertical :horizontal) : indicates the direction
199 in which the widget should be maximized."
200 (declare (type (member :both :vertical :horizontal) direction))
201 (with-pointered-widget (widget)
202 (maximize-command widget :direction direction)))
203
204 (defun iconify-pointered-widget ()
205 "Iconifies the application located under the mouse pointer."
206 (with-focused-widget (widget)
207 (iconify-command widget)))
208
209 (defun close-pointered-widget ()
210 "Closes the application located under the mouse pointer."
211 (with-pointered-widget (widget)
212 (close-widget widget)))
213
214 (defun kill-pointered-widget ()
215 "Kills the X resources of the application located under the mouse pointer."
216 (with-pointered-widget (widget)
217 (kill-widget-command widget)))
218
219 ;; focused.
220
221 (defun send-focused-widget-to-next-workspace (&key (change-workspace t))
222 "Sends the focused window in the next workspace.
223 If :change-workspace is NIL then eclipse will not change the current
224 workspace to the one the window just migrate. (default value is T)."
225 (migrate-focused :next :change-workspace change-workspace))
226
227 (defun send-focused-widget-to-prev-workspace (&key (change-workspace t))
228 "Sends the focused window in the previous workspace.
229 If :change-workspace is NIL then eclipse will not change the current
230 workspace to the one the window just migrate. (default value is T)."
231 (migrate-focused :prev :change-workspace change-workspace))
232
233 (defun maximize-focused-widget (&key (direction :both))
234 "Maximize the widget that has the focus in the given direction.
235 :DIRECTION (member :both :vertical :horizontal) : indicates the direction
236 in which the widget should be maximized."
237 (declare (type (member :both :vertical :horizontal) direction))
238 (with-focused-widget (widget)
239 (maximize-command widget :direction direction)))
240
241 (defun iconify-focused-widget ()
242 "Iconifies the application that has the focus."
243 (with-focused-widget (widget)
244 (iconify-command widget)))
245
246 (defun close-focused-widget ()
247 "Closes the application that has the focus."
248 (with-focused-widget (widget)
249 (close-widget widget)))
250
251 (defun kill-focused-widget ()
252 "Kills the X resources of the application that has the focus."
253 (with-focused-widget (widget)
254 (kill-widget-command widget)))

  ViewVC Help
Powered by ViewVC 1.1.5