Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hui-window.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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)