|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: hui-window.el
|
|
|
4 ;; SUMMARY: Smart Mouse Key window and modeline depress/release actions.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library, Load only when mouse is available.
|
|
|
6 ;; KEYWORDS: hypermedia, mouse
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
|
9 ;; ORG: Motorola, Inc., PWDG
|
|
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 21-Sep-92
|
|
|
12 ;; LAST-MOD: 6-Oct-95 at 12:56:48 by Bob Weiner
|
|
|
13 ;;
|
|
|
14 ;; This file is part of Hyperbole.
|
|
|
15 ;; Available for use and distribution under the same terms as GNU Emacs.
|
|
|
16 ;;
|
|
|
17 ;; Copyright (C) 1992-1995, Free Software Foundation, Inc.
|
|
|
18 ;; Developed with support from Motorola Inc.
|
|
|
19 ;;
|
|
|
20 ;; DESCRIPTION:
|
|
|
21 ;;
|
|
|
22 ;; Must be loaded AFTER hmouse-alist has been defined in
|
|
|
23 ;; "hui-mouse.el".
|
|
|
24 ;;
|
|
|
25 ;; Handles drags in same window or across windows and modeline depresses.
|
|
|
26 ;;
|
|
|
27 ;; What drags and modeline presses do.
|
|
|
28 ;; ==============================================================================
|
|
|
29 ;; Smart Keys
|
|
|
30 ;; Context Action Key Assist Key
|
|
|
31 ;; ==============================================================================
|
|
|
32 ;; Drag horizontally within window
|
|
|
33 ;; Left to right Scroll to buffer end Split window across
|
|
|
34 ;; Right to left Scroll to buffer begin Delete window
|
|
|
35 ;; Click in modeline
|
|
|
36 ;; Left window edge Bury buffer Unbury bottom buffer
|
|
|
37 ;; Right window edge Info Smart Key Summary
|
|
|
38 ;; Otherwise Action Key Hook Assist Key Hook
|
|
|
39 ;; Modeline depress & wind release Resize window height <- same
|
|
|
40 ;; Drag from shared window side Resize window's width <- same
|
|
|
41 ;; Drag from one window to another Create/modify a link but Swap buffers
|
|
|
42 ;; Drag vertically within window Split window sideways <- same
|
|
|
43 ;; Drag diagonally within window Save ring frame-config Restore ring config
|
|
|
44 ;;
|
|
|
45 ;; DESCRIP-END.
|
|
|
46
|
|
|
47 ;;; ************************************************************************
|
|
|
48 ;;; Public variables
|
|
|
49 ;;; ************************************************************************
|
|
|
50
|
|
|
51 (defvar action-key-modeline-hook 'hmouse-context-menu
|
|
|
52 "A list of functions to call when the Action Mouse Key is clicked in the center portion of a modeline.")
|
|
|
53
|
|
|
54 (defvar assist-key-modeline-hook nil
|
|
|
55 "A list of functions to call when the Assist Mouse Key is clicked in the center portion of a modeline.")
|
|
|
56
|
|
|
57 (defvar hmouse-edge-sensitivity 3
|
|
|
58 "*Number of characters from window edges within which a click is considered at an edge.")
|
|
|
59
|
|
|
60 (defvar hmouse-side-sensitivity (if hyperb:emacs19-p 2 1)
|
|
|
61 "*Characters in either direction from window side within which a click is considered on the side.")
|
|
|
62
|
|
|
63 (defvar hmouse-x-drag-sensitivity 5
|
|
|
64 "*Number of chars mouse must move horizontally between depress/release to register a horizontal drag.")
|
|
|
65
|
|
|
66 (defvar hmouse-y-drag-sensitivity 3
|
|
|
67 "*Number of lines mouse must move vertically between depress/release to register a vertical drag.")
|
|
|
68
|
|
|
69 (defvar hmouse-x-diagonal-sensitivity 4
|
|
|
70 "*Number of chars mouse must move horizontally between depress/release to register a diagonal drag.")
|
|
|
71 (defvar hmouse-y-diagonal-sensitivity 3
|
|
|
72 "*Number of lines mouse must move vertically between depress/release to register a diagonal drag.")
|
|
|
73
|
|
|
74 ;;;
|
|
|
75 ;;; Add mode line handling to hmouse-alist dispatch table.
|
|
|
76 ;;;
|
|
|
77 (if (not (boundp 'hmouse-alist))
|
|
|
78 (error
|
|
|
79 "\"hui-modeln.el\": hmouse-alist must be defined before loading this.")
|
|
|
80 (or (memq 'hmouse-drag-window-side
|
|
|
81 (mapcar (function (lambda (elt) (let ((pred (car elt)))
|
|
|
82 (if (listp pred) (car pred)))))
|
|
|
83 hmouse-alist))
|
|
|
84 (setq hmouse-alist
|
|
|
85 (append
|
|
|
86 '(
|
|
|
87 ((hmouse-drag-window-side) .
|
|
|
88 ((hmouse-resize-window-side) .
|
|
|
89 (hmouse-resize-window-side 'assist)))
|
|
|
90 ((setq hkey-value
|
|
|
91 (and (not (hmouse-drag-between-windows))
|
|
|
92 (hmouse-drag-horizontally))) .
|
|
|
93 ((hmouse-horizontal) . (hmouse-horizontal-assist)))
|
|
|
94 ((hmouse-modeline-depress) .
|
|
|
95 ((action-key-modeline) . (assist-key-modeline)))
|
|
|
96 ((hmouse-drag-between-windows) .
|
|
|
97 ((hui:link-directly) . (hmouse-swap-buffers 'assist)))
|
|
|
98 ((hmouse-drag-vertically) .
|
|
|
99 ((sm-split-window-horizontally) .
|
|
|
100 (sm-split-window-horizontally)))
|
|
|
101 ((setq hkey-value (hmouse-drag-diagonally)) .
|
|
|
102 ((wconfig-ring-save) .
|
|
|
103 (wconfig-yank-pop
|
|
|
104 (prefix-numeric-value current-prefix-arg))))
|
|
|
105 )
|
|
|
106 hmouse-alist))))
|
|
|
107
|
|
|
108
|
|
|
109 ;;; ************************************************************************
|
|
|
110 ;;; Public functions
|
|
|
111 ;;; ************************************************************************
|
|
|
112
|
|
|
113 (defun hmouse-drag-between-windows ()
|
|
|
114 "Returns non-nil if last Action Key depress and release were in different windows.
|
|
|
115 If free variable 'assist-flag' is non-nil, uses Assist Key."
|
|
|
116 (if assist-flag
|
|
|
117 (and assist-key-depress-window assist-key-release-window
|
|
|
118 (not (eq assist-key-depress-window
|
|
|
119 assist-key-release-window)))
|
|
|
120 (and action-key-depress-window action-key-release-window
|
|
|
121 (not (eq action-key-depress-window action-key-release-window)))))
|
|
|
122
|
|
|
123 (defun hmouse-drag-diagonally ()
|
|
|
124 "Returns non-nil iff last Action Key use was a diagonal drag within a single window.
|
|
|
125 If free variable 'assist-flag' is non-nil, uses Assist Key.
|
|
|
126 Value returned is nil if not a diagonal drag, or one of the following symbols
|
|
|
127 depending on the direction of the drag: southeast, southwest, northwest, northeast."
|
|
|
128 (let ((last-depress-x) (last-release-x)
|
|
|
129 (last-depress-y) (last-release-y))
|
|
|
130 (if assist-flag
|
|
|
131 (setq last-depress-x (hmouse-x-coord assist-key-depress-args)
|
|
|
132 last-release-x (hmouse-x-coord assist-key-release-args)
|
|
|
133 last-depress-y (hmouse-y-coord assist-key-depress-args)
|
|
|
134 last-release-y (hmouse-y-coord assist-key-release-args))
|
|
|
135 (setq last-depress-x (hmouse-x-coord action-key-depress-args)
|
|
|
136 last-release-x (hmouse-x-coord action-key-release-args)
|
|
|
137 last-depress-y (hmouse-y-coord action-key-depress-args)
|
|
|
138 last-release-y (hmouse-y-coord action-key-release-args)))
|
|
|
139 (and last-depress-x last-release-x last-depress-y last-release-y
|
|
|
140 (>= (- (max last-depress-x last-release-x)
|
|
|
141 (min last-depress-x last-release-x))
|
|
|
142 hmouse-x-diagonal-sensitivity)
|
|
|
143 (>= (- (max last-depress-y last-release-y)
|
|
|
144 (min last-depress-y last-release-y))
|
|
|
145 hmouse-y-diagonal-sensitivity)
|
|
|
146 (cond
|
|
|
147 ((< last-depress-x last-release-x)
|
|
|
148 (if (< last-depress-y last-release-y)
|
|
|
149 'southeast 'northeast))
|
|
|
150 (t (if (< last-depress-y last-release-y)
|
|
|
151 'southwest 'northwest))))))
|
|
|
152
|
|
|
153 (defun hmouse-drag-horizontally ()
|
|
|
154 "Returns non-nil iff last Action Key use was a horizontal drag within a single window.
|
|
|
155 If free variable 'assist-flag' is non-nil, uses Assist Key.
|
|
|
156 Value returned is nil if not a horizontal drag, 'left if drag moved left or
|
|
|
157 'right otherwise."
|
|
|
158 (let ((last-depress-x) (last-release-x)
|
|
|
159 (last-depress-y) (last-release-y))
|
|
|
160 (if assist-flag
|
|
|
161 (setq last-depress-x (hmouse-x-coord assist-key-depress-args)
|
|
|
162 last-release-x (hmouse-x-coord assist-key-release-args)
|
|
|
163 last-depress-y (hmouse-y-coord assist-key-depress-args)
|
|
|
164 last-release-y (hmouse-y-coord assist-key-release-args))
|
|
|
165 (setq last-depress-x (hmouse-x-coord action-key-depress-args)
|
|
|
166 last-release-x (hmouse-x-coord action-key-release-args)
|
|
|
167 last-depress-y (hmouse-y-coord action-key-depress-args)
|
|
|
168 last-release-y (hmouse-y-coord action-key-release-args)))
|
|
|
169 (and last-depress-x last-release-x last-depress-y last-release-y
|
|
|
170 (>= (- (max last-depress-x last-release-x)
|
|
|
171 (min last-depress-x last-release-x))
|
|
|
172 hmouse-x-drag-sensitivity)
|
|
|
173 ;; Don't want to register vertical drags here, so ensure any
|
|
|
174 ;; vertical movement was less than the vertical drag sensitivity.
|
|
|
175 (< (- (max last-depress-y last-release-y)
|
|
|
176 (min last-depress-y last-release-y))
|
|
|
177 hmouse-y-drag-sensitivity)
|
|
|
178 (if (< last-depress-x last-release-x) 'right 'left))))
|
|
|
179
|
|
|
180 (defun hmouse-drag-vertically ()
|
|
|
181 "Returns non-nil iff last Action Key use was a vertical drag within a single window.
|
|
|
182 If free variable 'assist-flag' is non-nil, uses Assist Key.
|
|
|
183 Value returned is nil if not a vertical line drag, 'up if drag moved up or
|
|
|
184 'down otherwise."
|
|
|
185 (let ((last-depress-x) (last-release-x)
|
|
|
186 (last-depress-y) (last-release-y))
|
|
|
187 (if assist-flag
|
|
|
188 (setq last-depress-x (hmouse-x-coord assist-key-depress-args)
|
|
|
189 last-release-x (hmouse-x-coord assist-key-release-args)
|
|
|
190 last-depress-y (hmouse-y-coord assist-key-depress-args)
|
|
|
191 last-release-y (hmouse-y-coord assist-key-release-args))
|
|
|
192 (setq last-depress-x (hmouse-x-coord action-key-depress-args)
|
|
|
193 last-release-x (hmouse-x-coord action-key-release-args)
|
|
|
194 last-depress-y (hmouse-y-coord action-key-depress-args)
|
|
|
195 last-release-y (hmouse-y-coord action-key-release-args)))
|
|
|
196 (and last-depress-x last-release-x last-depress-y last-release-y
|
|
|
197 (>= (- (max last-depress-y last-release-y)
|
|
|
198 (min last-depress-y last-release-y))
|
|
|
199 hmouse-y-drag-sensitivity)
|
|
|
200 ;; Don't want to register horizontal drags here, so ensure any
|
|
|
201 ;; horizontal movement was less than or equal to the horizontal drag
|
|
|
202 ;; sensitivity.
|
|
|
203 (<= (- (max last-depress-x last-release-x)
|
|
|
204 (min last-depress-x last-release-x))
|
|
|
205 hmouse-x-drag-sensitivity)
|
|
|
206 (if (< last-depress-y last-release-y) 'down 'up))))
|
|
|
207
|
|
|
208 (or (fboundp 'abs)
|
|
|
209 (defun abs (number)
|
|
|
210 "Return the absolute value of NUMBER."
|
|
|
211 (cond
|
|
|
212 ((< number 0)
|
|
|
213 (- 0 number))
|
|
|
214 (t number))))
|
|
|
215
|
|
|
216 (defun hmouse-drag-window-side ()
|
|
|
217 "Returns non-nil if Action Key was dragged from a window side divider.
|
|
|
218 If free variable 'assist-flag' is non-nil, uses Assist Key."
|
|
|
219 (cond (hyperb:xemacs-p
|
|
|
220 ;; Depress events in scrollbars or in non-text area of buffer are
|
|
|
221 ;; not visible or identifiable at the Lisp-level, so always return
|
|
|
222 ;; nil.
|
|
|
223 nil)
|
|
|
224 (hyperb:window-system
|
|
|
225 (let* ((depress-args (if assist-flag assist-key-depress-args
|
|
|
226 action-key-depress-args))
|
|
|
227 (release-args (if assist-flag assist-key-release-args
|
|
|
228 action-key-release-args))
|
|
|
229 (w (smart-window-of-coords depress-args))
|
|
|
230 (side-ln (and w (1- (nth 2 (window-edges w)))))
|
|
|
231 (last-press-x (hmouse-x-coord depress-args))
|
|
|
232 (last-release-x (hmouse-x-coord release-args)))
|
|
|
233 (and last-press-x last-release-x side-ln
|
|
|
234 (/= last-press-x last-release-x)
|
|
|
235 (/= (1+ side-ln) (frame-width))
|
|
|
236 (<= (max (- last-press-x side-ln) (- side-ln last-press-x))
|
|
|
237 hmouse-side-sensitivity))))))
|
|
|
238
|
|
|
239 (defun sm-split-window-horizontally ()
|
|
|
240 "Splits current window in two evenly, side by side.
|
|
|
241 Beeps and prints message if can't split window further."
|
|
|
242 (interactive)
|
|
|
243 (let ((window-min-width 5))
|
|
|
244 (condition-case ()
|
|
|
245 (split-window-horizontally nil)
|
|
|
246 (error (progn (beep)
|
|
|
247 (message
|
|
|
248 "(sm-split-window-horizontally): Can't split window further."))))))
|
|
|
249
|
|
|
250 (defun sm-split-window-vertically ()
|
|
|
251 "Splits current window in two evenly, one above the other.
|
|
|
252 Beeps and prints message if can't split window further."
|
|
|
253 (interactive)
|
|
|
254 (let ((window-min-height 2))
|
|
|
255 (condition-case ()
|
|
|
256 (if (fboundp 'split-window-quietly)
|
|
|
257 (split-window-quietly nil)
|
|
|
258 (split-window-vertically nil))
|
|
|
259 (error
|
|
|
260 (progn
|
|
|
261 (beep)
|
|
|
262 (message
|
|
|
263 "(sm-split-window-vertically): Can't split window further."))))))
|
|
|
264
|
|
|
265 (defun smart-coords-in-window-p (coords window)
|
|
|
266 "Tests if COORDS are in WINDOW. Returns WINDOW if they are, nil otherwise."
|
|
|
267 (cond ((and hyperb:emacs19-p (eventp coords))
|
|
|
268 (eq (posn-window (event-start coords)) window))
|
|
|
269 ((if hyperb:xemacs-p
|
|
|
270 (if (eventp coords)
|
|
|
271 (eq (event-window coords) window)
|
|
|
272 (eq (car coords) window))))
|
|
|
273 ((fboundp 'window-edges)
|
|
|
274 (let* ((edges (window-edges window))
|
|
|
275 (w-xmin (nth 0 edges))
|
|
|
276 (w-ymin (nth 1 edges))
|
|
|
277 (w-xmax (nth 2 edges))
|
|
|
278 (w-ymax (nth 3 edges))
|
|
|
279 (x (hmouse-x-coord coords))
|
|
|
280 (y (hmouse-y-coord coords)))
|
|
|
281 (and (<= w-xmin x) (<= x w-xmax)
|
|
|
282 (<= w-ymin y) (<= y w-ymax)
|
|
|
283 window)))))
|
|
|
284
|
|
|
285 (defun smart-window-of-coords (coords)
|
|
|
286 "Returns window in which COORDS fall or nil if none.
|
|
|
287 Ignores minibuffer window."
|
|
|
288 (cond ((and hyperb:emacs19-p (eventp coords))
|
|
|
289 (posn-window (event-start coords)))
|
|
|
290 ((if hyperb:xemacs-p
|
|
|
291 (if (eventp coords)
|
|
|
292 (event-window coords)
|
|
|
293 (car coords))))
|
|
|
294 (t (let ((window-list (hypb:window-list 'no-minibuf))
|
|
|
295 (window)
|
|
|
296 (w))
|
|
|
297 (while (and (not window) window-list)
|
|
|
298 (setq w (car window-list)
|
|
|
299 window-list (cdr window-list)
|
|
|
300 window (smart-coords-in-window-p coords w)))
|
|
|
301 window))))
|
|
|
302
|
|
|
303 ;;; ************************************************************************
|
|
|
304 ;;; Private functions
|
|
|
305 ;;; ************************************************************************
|
|
|
306
|
|
|
307 (defun hmouse-context-menu ()
|
|
|
308 "If running under a window system, display or hide the buffer menu.
|
|
|
309 If not running under a window system and Smart Menus are loaded, display the
|
|
|
310 appropriate Smart Menu for the context at point."
|
|
|
311 (if (and (fboundp 'smart-menu)
|
|
|
312 (or (null window-system)
|
|
|
313 (not (or hyperb:lemacs-p hyperb:emacs19-p))))
|
|
|
314 (smart-menu)
|
|
|
315 (let ((wind (get-buffer-window "*Buffer List*"))
|
|
|
316 owind)
|
|
|
317 (if wind
|
|
|
318 (unwind-protect
|
|
|
319 (progn (setq owind (selected-window))
|
|
|
320 (select-window wind)
|
|
|
321 (bury-buffer nil))
|
|
|
322 (select-window owind))
|
|
|
323 (buffer-menu nil)))))
|
|
|
324
|
|
|
325 (defun hmouse-horizontal ()
|
|
|
326 "Goes to buffer end if drag was to the right, otherwise goes to beginning."
|
|
|
327 (if (eq hkey-value 'right)
|
|
|
328 (end-of-buffer)
|
|
|
329 (beginning-of-buffer)))
|
|
|
330
|
|
|
331 (defun hmouse-horizontal-assist ()
|
|
|
332 "Splits window vertically if drag was to the right, otherwise deletes window."
|
|
|
333 (if (eq hkey-value 'right)
|
|
|
334 (sm-split-window-vertically)
|
|
|
335 (delete-window)))
|
|
|
336
|
|
|
337 (defun action-key-modeline ()
|
|
|
338 "Handles Action Key depresses on a window mode line.
|
|
|
339 If key is:
|
|
|
340 (1) clicked on left edge of a window's modeline,
|
|
|
341 window's buffer is buried (placed at bottom of buffer list);
|
|
|
342 (2) clicked on right edge of a window's modeline,
|
|
|
343 the Info buffer is displayed, or if already displayed and the
|
|
|
344 modeline clicked belongs to a window displaying Info, the Info
|
|
|
345 buffer is hidden;
|
|
|
346 (3) clicked anywhere in the middle of a window's modeline,
|
|
|
347 the functions listed in 'action-key-modeline-hook' are called;
|
|
|
348 (4) dragged vertically from modeline to within a window,
|
|
|
349 the modeline is moved to point of key release, thereby resizing
|
|
|
350 its window and potentially its vertical neighbors."
|
|
|
351 (let ((w (smart-window-of-coords action-key-depress-args)))
|
|
|
352 (if w (select-window w))
|
|
|
353 (cond ((hmouse-modeline-click)
|
|
|
354 (cond ((hmouse-release-left-edge) (bury-buffer))
|
|
|
355 ((hmouse-release-right-edge)
|
|
|
356 (if (eq major-mode 'Info-mode)
|
|
|
357 (Info-exit)
|
|
|
358 (info)))
|
|
|
359 (t (run-hooks 'action-key-modeline-hook))))
|
|
|
360 (t (hmouse-modeline-resize-window)))))
|
|
|
361
|
|
|
362 (defun assist-key-modeline ()
|
|
|
363 "Handles Assist Key depresses on a window mode line.
|
|
|
364 If secondary key is:
|
|
|
365 (1) clicked on left edge of a window's modeline,
|
|
|
366 bottom buffer in buffer list is unburied and placed in window;
|
|
|
367 (2) clicked on right edge of a window's modeline,
|
|
|
368 the summary of Smart Key behavior is displayed, or if already
|
|
|
369 displayed and the modeline clicked belongs to a window displaying
|
|
|
370 the summary, the summary buffer is hidden;
|
|
|
371 (3) clicked anywhere in the middle of a window's modeline,
|
|
|
372 the functions listed in 'assist-key-modeline-hook' are called;
|
|
|
373 (4) dragged vertically from modeline to within a window,
|
|
|
374 the modeline is moved to point of key release, thereby resizing
|
|
|
375 its window and potentially its vertical neighbors."
|
|
|
376 (let ((buffers)
|
|
|
377 (w (smart-window-of-coords assist-key-depress-args)))
|
|
|
378 (if w (select-window w))
|
|
|
379 (cond ((hmouse-modeline-click 'assist)
|
|
|
380 (cond ((hmouse-release-left-edge 'assist)
|
|
|
381 (if (fboundp 'last)
|
|
|
382 (switch-to-buffer (car (last (buffer-list))))
|
|
|
383 (setq buffers (buffer-list))
|
|
|
384 (switch-to-buffer (nth (1- (length buffers)) buffers))))
|
|
|
385 ((hmouse-release-right-edge 'assist)
|
|
|
386 (if (equal (buffer-name) (hypb:help-buf-name "Smart"))
|
|
|
387 (hkey-help-hide)
|
|
|
388 (hkey-summarize 'current-window)))
|
|
|
389 (t (run-hooks 'assist-key-modeline-hook))))
|
|
|
390 (t (hmouse-modeline-resize-window 'assist)))))
|
|
|
391
|
|
|
392 (defun hmouse-modeline-click (&optional assist-flag)
|
|
|
393 "Returns non-nil if last Action Key depress and release was at same point in a modeline.
|
|
|
394 Optional ASSIST-FLAG non-nil means test for Assist Key click instead."
|
|
|
395 ;; Assume depress was in modeline and that any drag has already been handled.
|
|
|
396 ;; So just check that release was in modeline.
|
|
|
397 (hmouse-modeline-release assist-flag))
|
|
|
398
|
|
|
399 (defun hmouse-modeline-depress ()
|
|
|
400 "Returns non-nil if Action Key was depressed on a window mode line.
|
|
|
401 If free variable 'assist-flag' is non-nil, uses Assist Key."
|
|
|
402 (let ((args (if assist-flag assist-key-depress-args
|
|
|
403 action-key-depress-args)))
|
|
|
404 (if (and hyperb:window-system args)
|
|
|
405 (if (fboundp 'event-over-modeline-p)
|
|
|
406 (event-over-modeline-p args)
|
|
|
407 (let* ((w (smart-window-of-coords args))
|
|
|
408 (mode-ln (if w (nth 3 (window-edges w))))
|
|
|
409 (last-press-y (hmouse-y-coord args)))
|
|
|
410 ;; Mode-line is always 1 less than the bottom of the window, unless it
|
|
|
411 ;; is a minibuffer window which does not have a modeline.
|
|
|
412 (if (not (eq w (minibuffer-window))) (setq mode-ln (1- mode-ln)))
|
|
|
413 (and last-press-y mode-ln (= last-press-y mode-ln)))))))
|
|
|
414
|
|
|
415 (defun hmouse-modeline-release (&optional assist-flag)
|
|
|
416 "Returns non-nil if Action Key was released on a window mode line.
|
|
|
417 Optional non-nil ASSIST-FLAG means test release of Assist Key instead."
|
|
|
418 (let ((args (if assist-flag assist-key-release-args
|
|
|
419 action-key-release-args)))
|
|
|
420 (if (and hyperb:window-system args)
|
|
|
421 (if (fboundp 'event-over-modeline-p)
|
|
|
422 (event-over-modeline-p args)
|
|
|
423 (let* ((w (smart-window-of-coords args))
|
|
|
424 (mode-ln (and w (1- (nth 3 (window-edges w)))))
|
|
|
425 (last-press-y (hmouse-y-coord args)))
|
|
|
426 (and last-press-y mode-ln (= last-press-y mode-ln)))))))
|
|
|
427
|
|
|
428 (defun hmouse-modeline-resize-window (&optional assist-flag)
|
|
|
429 "Resizes window whose mode line was depressed upon by the Action Key.
|
|
|
430 Resize amount depends upon the vertical difference between press and release
|
|
|
431 of the Action Key. Optional arg ASSIST-FLAG non-nil means use values from
|
|
|
432 Assist Key instead."
|
|
|
433 (cond ((not hyperb:window-system) nil)
|
|
|
434 ((and hyperb:xemacs-p (not (fboundp 'window-edges)))
|
|
|
435 (error "Drag from a mode-line with button1 to resize windows."))
|
|
|
436 (t (let* ((owind (selected-window))
|
|
|
437 (window (smart-window-of-coords
|
|
|
438 (if assist-flag assist-key-depress-args
|
|
|
439 action-key-depress-args)))
|
|
|
440 (mode-ln (and window (1- (nth 3 (window-edges window)))))
|
|
|
441 (last-release-y
|
|
|
442 (hmouse-y-coord
|
|
|
443 (if assist-flag assist-key-release-args
|
|
|
444 action-key-release-args)))
|
|
|
445 (shrink-amount (- mode-ln last-release-y)))
|
|
|
446 ;; Restore position of point prior to Action Key release.
|
|
|
447 (if action-key-release-prev-point
|
|
|
448 (let ((obuf (current-buffer)))
|
|
|
449 (unwind-protect
|
|
|
450 (progn
|
|
|
451 (set-buffer
|
|
|
452 (marker-buffer action-key-release-prev-point))
|
|
|
453 (goto-char
|
|
|
454 (marker-position action-key-release-prev-point)))
|
|
|
455 (set-buffer obuf))))
|
|
|
456 (cond
|
|
|
457 ((>= (+ mode-ln 2) (frame-height))
|
|
|
458 (error
|
|
|
459 "(hmouse-modeline-resize-window): Can't move bottom window in frame."))
|
|
|
460 ((< (length (hypb:window-list 'no-minibuf)) 2)
|
|
|
461 (error
|
|
|
462 "(hmouse-modeline-resize-window): Can't resize sole window in frame."))
|
|
|
463 (t (unwind-protect
|
|
|
464 (progn
|
|
|
465 (select-window window)
|
|
|
466 (shrink-window shrink-amount)
|
|
|
467 ;; Keep redisplay from scrolling other window.
|
|
|
468 (select-window (next-window nil 'no-mini))
|
|
|
469 (condition-case ()
|
|
|
470 (scroll-down shrink-amount)
|
|
|
471 (error nil)))
|
|
|
472 (select-window owind))))))))
|
|
|
473
|
|
|
474 (defun hmouse-release-left-edge (&optional assist-flag)
|
|
|
475 "Returns non-nil if last Action Key release was at left window edge.
|
|
|
476 'hmouse-edge-sensitivity' value determines how near to actual edge the
|
|
|
477 release must be."
|
|
|
478 (let ((args (if assist-flag assist-key-release-args
|
|
|
479 action-key-release-args))
|
|
|
480 window-left last-release-x)
|
|
|
481 (if (fboundp 'window-lowest-p) ;; XEmacs >= 19.12
|
|
|
482 (setq last-release-x (and args (eq (event-window args)
|
|
|
483 (selected-window))
|
|
|
484 (hmouse-x-coord args))
|
|
|
485 window-left 0)
|
|
|
486 (setq window-left (car (window-edges))
|
|
|
487 last-release-x (and args (hmouse-x-coord args))))
|
|
|
488 (and last-release-x (< (- last-release-x window-left)
|
|
|
489 hmouse-edge-sensitivity)
|
|
|
490 (>= (- last-release-x window-left) 0))))
|
|
|
491
|
|
|
492 (defun hmouse-release-right-edge (&optional assist-flag)
|
|
|
493 "Returns non-nil if last Action Key release was at right window edge.
|
|
|
494 'hmouse-edge-sensitivity' value determines how near to actual edge the
|
|
|
495 release must be."
|
|
|
496 (let ((args (if assist-flag assist-key-release-args
|
|
|
497 action-key-release-args))
|
|
|
498 window-right last-release-x)
|
|
|
499 (if (fboundp 'window-lowest-p) ;; XEmacs >= 19.12
|
|
|
500 (setq last-release-x (and args (eq (event-window args)
|
|
|
501 (selected-window))
|
|
|
502 (hmouse-x-coord args))
|
|
|
503 window-right (window-width))
|
|
|
504 (setq window-right (nth 2 (window-edges))
|
|
|
505 last-release-x (and args (hmouse-x-coord args))))
|
|
|
506 (and last-release-x (>= (+ last-release-x hmouse-edge-sensitivity)
|
|
|
507 window-right)
|
|
|
508 (>= (- window-right last-release-x) 0))))
|
|
|
509
|
|
|
510 (defun hmouse-resize-window-side (&optional assist-flag)
|
|
|
511 "Resizes window whose side was depressed upon by the Action Key.
|
|
|
512 Resize amount depends upon the horizontal difference between press and release
|
|
|
513 of the Action Key. Optional arg ASSIST-FLAG non-nil means use values from
|
|
|
514 Assist Key instead."
|
|
|
515 (cond (hyperb:xemacs-p
|
|
|
516 ;; Depress events in scrollbars or in non-text area of buffer are
|
|
|
517 ;; not visible or identifiable at the Lisp-level, so always return
|
|
|
518 ;; nil.
|
|
|
519 nil)
|
|
|
520 (hyperb:window-system
|
|
|
521 (let* ((owind (selected-window))
|
|
|
522 (window (smart-window-of-coords
|
|
|
523 (if assist-flag assist-key-depress-args
|
|
|
524 action-key-depress-args)))
|
|
|
525 (side-ln (and window (1- (nth 2 (window-edges window)))))
|
|
|
526 (last-release-x
|
|
|
527 (hmouse-x-coord
|
|
|
528 (if assist-flag assist-key-release-args
|
|
|
529 action-key-release-args)))
|
|
|
530 (shrink-amount (- side-ln last-release-x))
|
|
|
531 )
|
|
|
532 ;; Restore position of point prior to Action Key release.
|
|
|
533 (if action-key-release-prev-point
|
|
|
534 (let ((obuf (current-buffer)))
|
|
|
535 (unwind-protect
|
|
|
536 (progn
|
|
|
537 (set-buffer (marker-buffer action-key-release-prev-point))
|
|
|
538 (goto-char (marker-position action-key-release-prev-point)))
|
|
|
539 (set-buffer obuf))))
|
|
|
540 (cond
|
|
|
541 ((>= (+ side-ln 2) (frame-width))
|
|
|
542 (error
|
|
|
543 "(hmouse-resize-window-side): Can't change width of full frame width window."))
|
|
|
544 ((< (length (hypb:window-list 'no-minibuf)) 2)
|
|
|
545 (error
|
|
|
546 "(hmouse-resize-window-side): Can't resize sole window in frame."))
|
|
|
547 (t (unwind-protect
|
|
|
548 (progn
|
|
|
549 (select-window window)
|
|
|
550 (shrink-window-horizontally shrink-amount))
|
|
|
551 (select-window owind))))))))
|
|
|
552
|
|
|
553 (defun hmouse-swap-buffers (&optional assist-flag)
|
|
|
554 "Swaps buffers in windows selected with last Action Key depress and release.
|
|
|
555 If optional arg ASSIST-FLAG is non-nil, uses Assist Key."
|
|
|
556 (let* ((w1 (if assist-flag assist-key-depress-window
|
|
|
557 action-key-depress-window))
|
|
|
558 (w2 (if assist-flag assist-key-release-window
|
|
|
559 action-key-release-window))
|
|
|
560 (w1-buf (and w1 (window-buffer w1)))
|
|
|
561 (w2-buf (and w2 (window-buffer w2)))
|
|
|
562 )
|
|
|
563 (or (and w1 w2)
|
|
|
564 (error "(hmouse-swap-buffers): Last depress or release not within a window."))
|
|
|
565 ;; Swap window buffers.
|
|
|
566 (set-window-buffer w1 w2-buf)
|
|
|
567 (set-window-buffer w2 w1-buf)))
|
|
|
568
|
|
|
569 (defun hmouse-swap-windows (&optional assist-flag)
|
|
|
570 "Swaps windows selected with last Action Key depress and release.
|
|
|
571 If optional arg ASSIST-FLAG is non-nil, uses Assist Key."
|
|
|
572 (let* ((w1 (if assist-flag assist-key-depress-window
|
|
|
573 action-key-depress-window))
|
|
|
574 (w2 (if assist-flag assist-key-release-window
|
|
|
575 action-key-release-window))
|
|
|
576 (w1-width (and w1 (window-width w1)))
|
|
|
577 (w1-height (and w1 (window-height w1)))
|
|
|
578 (w2-width (and w2 (window-width w2)))
|
|
|
579 (w2-height (and w2 (window-height w2)))
|
|
|
580 )
|
|
|
581 (or (and w1 w2)
|
|
|
582 (error "(hmouse-swap-windows): Last depress or release not within a window."))
|
|
|
583 (unwind-protect
|
|
|
584 (progn
|
|
|
585 (select-window w1)
|
|
|
586 (if (not (= w1-height (frame-height)))
|
|
|
587 (shrink-window (- w1-height w2-height)))
|
|
|
588 (if (not (= w1-width (frame-width)))
|
|
|
589 (shrink-window-horizontally (- w1-width w2-width)))
|
|
|
590 (select-window w2)
|
|
|
591 (setq w2-width (window-width w2)
|
|
|
592 w2-height (window-height w2))
|
|
|
593 (if (not (= w2-height (frame-height)))
|
|
|
594 (shrink-window (- w2-height w1-height)))
|
|
|
595 (if (not (= w2-width (frame-width)))
|
|
|
596 (shrink-window-horizontally (- w2-width w1-width)))
|
|
|
597 )
|
|
|
598 (select-window w2)
|
|
|
599 )))
|
|
|
600
|
|
|
601 (defun hmouse-x-coord (args)
|
|
|
602 "Returns x coordinate in chars from window system dependent ARGS."
|
|
|
603 (let ((x (eval (cdr (assoc hyperb:window-system
|
|
|
604 '(("emacs19" . (if (eventp args)
|
|
|
605 (+ (car (posn-col-row
|
|
|
606 (event-start args)))
|
|
|
607 (nth 0 (window-edges
|
|
|
608 (car
|
|
|
609 (car (cdr args))
|
|
|
610 ))))
|
|
|
611 (car args)))
|
|
|
612 ("lemacs" . (if (eventp args)
|
|
|
613 (event-x args)
|
|
|
614 (car args)))
|
|
|
615 ("xterm" . (car args))
|
|
|
616 ("epoch" . (nth 0 args)) ;; Epoch V4
|
|
|
617 ("sun" . (nth 1 args))
|
|
|
618 ("next" . (nth 1 args))
|
|
|
619 ("apollo" . (car args))
|
|
|
620 ))))))
|
|
|
621 (if (integerp x) x (error "(hmouse-x-coord): invalid X coord: %s" x))))
|
|
|
622
|
|
|
623 (defun hmouse-y-coord (args)
|
|
|
624 "Returns y coordinate in frame lines from window system dependent ARGS."
|
|
|
625 (let ((y (eval (cdr (assoc hyperb:window-system
|
|
|
626 '(("emacs19" . (if (eventp args)
|
|
|
627 (+ (cdr (posn-col-row
|
|
|
628 (event-start args)))
|
|
|
629 (nth 1 (window-edges
|
|
|
630 (car
|
|
|
631 (car (cdr args))
|
|
|
632 ))))
|
|
|
633 (cdr args)))
|
|
|
634 ("lemacs" . (if (eventp args)
|
|
|
635 (event-y args)
|
|
|
636 (cdr args)))
|
|
|
637 ("xterm" . (nth 1 args))
|
|
|
638 ("epoch" . (nth 1 args)) ;; Epoch V4
|
|
|
639 ("sun" . (nth 2 args))
|
|
|
640 ("next" . (nth 2 args))
|
|
|
641 ("apollo" . (nth 1 args))
|
|
|
642 ))))))
|
|
|
643 (if (integerp y) y (error "(hmouse-y-coord): invalid Y coord: %s" y))))
|
|
|
644
|
|
|
645
|
|
|
646 ;;; ************************************************************************
|
|
|
647 ;;; Private variables
|
|
|
648 ;;; ************************************************************************
|
|
|
649
|
|
|
650
|
|
|
651 (provide 'hui-window)
|
