annotate lisp/mldrag.el @ 7694:92a4522c37fc

Make previous change limited to HPUX.
author Richard M. Stallman <rms@gnu.org>
date Thu, 26 May 1994 22:15:23 +0000
parents b71375c9b1b3
children 84acc3adcd63
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
7267
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1 ;;; mldrag.el -- Mode line and vertical line dragging to resize windows.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2 ;;; Copyright (C) 1994 Free Software Foundation, Inc.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4 ;; Author: Kyle E. Jones <kyle@wonderworks.com>
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Keywords: mouse
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; This file is part of GNU Emacs.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10 ;; it under the terms of the GNU General Public License as published by
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; any later version.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; GNU Emacs is distributed in the hope that it will be useful,
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; GNU General Public License for more details.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23 ;;; Commentary:
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 ;; This package lets you drag the modeline, vertical bar and
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26 ;; scrollbar to resize windows. Suggested bindings are:
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27 ;;
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;; (global-set-key [mode-line down-mouse-1] 'mldrag-drag-mode-line)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29 ;; (global-set-key [vertical-line down-mouse-1] 'mldrag-drag-vertical-line)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 ;; (global-set-key [vertical-scroll-bar S-down-mouse-1]
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 ;; 'mldrag-drag-vertical-line)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32 ;;
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 ;; Put the bindings and (require 'mldrag) in your .emacs file.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 ;;; Code:
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 (provide 'mldrag)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 (defun mldrag-drag-mode-line (start-event)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 "Change the height of the current window with the mouse.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 This command should be bound to a down-mouse- event, and is most
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 usefully bound with the `mode-line' prefix. Holding down a mouse
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 button and moving the mouse up and down will make the clicked-on
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 window taller or shorter."
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 (interactive "e")
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 (let ((done nil)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 (echo-keystrokes 0)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 (start-event-frame (window-frame (car (car (cdr start-event)))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49 (start-event-window (car (car (cdr start-event))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50 (start-nwindows (count-windows t))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 (old-selected-window (selected-window))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 should-enlarge-minibuffer
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 event mouse minibuffer y top bot edges wconfig params growth)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 (setq params (frame-parameters))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 (if (and (not (setq minibuffer (cdr (assq 'minibuffer params))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 (one-window-p t))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 (error "Attempt to resize sole window"))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 (unwind-protect
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 (track-mouse
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 (progn
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 ;; enlarge-window only works on the selected window, so
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 ;; we must select the window where the start event originated.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63 ;; unwind-protect will restore the old selected window later.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 (select-window start-event-window)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 ;; if this is the bottommost ordinary window, then to
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 ;; move its modeline the minibuffer must be enlarged.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 (setq should-enlarge-minibuffer
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 (and minibuffer
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 (not (one-window-p t))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 (= (nth 1 (window-edges minibuffer))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 (nth 3 (window-edges)))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 ;; loop reading events and sampling the position of
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 ;; the mouse.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 (while (not done)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 (setq event (read-event)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 mouse (mouse-position))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 ;; do nothing if
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 ;; - there is a switch-frame event.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 ;; - the mouse isn't in the frame that we started in
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 ;; - the mouse isn't in any Emacs frame
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 ;; drag if
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 ;; - there is a mouse-movement event
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 ;; - there is a scroll-bar-movement event
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 ;; (same as mouse movement for our purposes)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 ;; quit if
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86 ;; - there is a keyboard event or some other unknown event
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87 ;; unknown event.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 (cond ((integerp event)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 (setq done t))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 ((eq (car event) 'switch-frame)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 nil)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92 ((not (memq (car event)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 '(mouse-movement scroll-bar-movement)))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94 (setq done t))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 ((not (eq (car mouse) start-event-frame))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 nil)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 ((null (car (cdr mouse)))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 nil)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 (t
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 (setq y (cdr (cdr mouse))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101 edges (window-edges)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 top (nth 1 edges)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 bot (nth 3 edges))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 ;; scale back a move that would make the
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 ;; window too short.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 (cond ((< (- y top -1) window-min-height)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 (setq y (+ top window-min-height -1))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108 ;; compute size change needed
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 (setq growth (- y bot -1)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110 wconfig (current-window-configuration))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 ;; grow/shrink minibuffer?
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112 (if should-enlarge-minibuffer
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113 (progn
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 ;; yes. briefly select minibuffer so
7290
b71375c9b1b3 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 7267
diff changeset
115 ;; enlarge-window will affect the
7267
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116 ;; correct window.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
117 (select-window minibuffer)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 ;; scale back shrinkage if it would
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 ;; make the minibuffer less than 1
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 ;; line tall.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121 (if (and (> growth 0)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122 (< (- (window-height minibuffer)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
123 growth)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124 1))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 (setq growth (1- (window-height minibuffer))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126 (enlarge-window (- growth))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127 (select-window start-event-window))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128 ;; no. grow/shrink the selected window
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129 (enlarge-window growth))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 ;; if this window's growth caused another
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 ;; window to be deleted because it was too
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
132 ;; short, rescind the change.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 ;;
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134 ;; if size change caused space to be stolen
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135 ;; from a window above this one, rescind the
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136 ;; change, but only if we didn't grow/srhink
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137 ;; the minibuffer. minibuffer size changes
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138 ;; can cause all windows to shrink... no way
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139 ;; around it.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140 (if (or (/= start-nwindows (count-windows t))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 (and (not should-enlarge-minibuffer)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142 (/= top (nth 1 (window-edges)))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143 (set-window-configuration wconfig)))))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 ;; restore the old selected window
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145 (select-window old-selected-window))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 (defun mldrag-drag-vertical-line (start-event)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 "Change the width of the current window with the mouse.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
149 This command should be bound to a down-mouse- event, and is most
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 usefully bound with the `vertical-line' or the `vertical-scroll-bar'
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 prefix. Holding down a mouse button and moving the mouse left and
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152 right will make the clicked-on window thinner or wider."
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
153 (interactive "e")
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
154 (let ((done nil)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
155 (echo-keystrokes 0)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 (start-event-frame (window-frame (car (car (cdr start-event)))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157 (start-event-window (car (car (cdr start-event))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158 (start-nwindows (count-windows t))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
159 (old-selected-window (selected-window))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160 event mouse x left right edges wconfig growth)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
161 (if (one-window-p t)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
162 (error "Attempt to resize sole ordinary window"))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
163 (if (= (nth 2 (window-edges start-event-window))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
164 (frame-width start-event-frame))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 (error "Attempt to drag rightmost scrollbar"))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166 (unwind-protect
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
167 (track-mouse
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168 (progn
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
169 ;; enlarge-window only works on the selected window, so
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
170 ;; we must select the window where the start event originated.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171 ;; unwind-protect will restore the old selected window later.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172 (select-window start-event-window)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 ;; loop reading events and sampling the position of
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174 ;; the mouse.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175 (while (not done)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 (setq event (read-event)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177 mouse (mouse-position))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178 ;; do nothing if
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
179 ;; - there is a switch-frame event.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180 ;; - the mouse isn't in the frame that we started in
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 ;; - the mouse isn't in any Emacs frame
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 ;; drag if
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183 ;; - there is a mouse-movement event
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
184 ;; - there is a scroll-bar-movement event
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 ;; (same as mouse movement for our purposes)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186 ;; quit if
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187 ;; - there is a keyboard event or some other unknown event
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188 ;; unknown event.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189 (cond ((integerp event)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 (setq done t))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191 ((eq (car event) 'switch-frame)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192 nil)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193 ((not (memq (car event)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194 '(mouse-movement scroll-bar-movement)))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195 (setq done t))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196 ((not (eq (car mouse) start-event-frame))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197 nil)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 ((null (car (cdr mouse)))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
199 nil)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200 (t
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201 (setq x (car (cdr mouse))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202 edges (window-edges)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
203 left (nth 0 edges)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204 right (nth 2 edges))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
205 ;; scale back a move that would make the
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206 ;; window too thin.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207 (cond ((< (- x left -1) window-min-width)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208 (setq x (+ left window-min-width -1))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 ;; compute size change needed
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210 (setq growth (- x right -1)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211 wconfig (current-window-configuration))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
212 (enlarge-window growth t)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
213 ;; if this window's growth caused another
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
214 ;; window to be deleted because it was too
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
215 ;; thin, rescind the change.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
216 ;;
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
217 ;; if size change caused space to be stolen
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
218 ;; from a window to the left of this one,
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
219 ;; rescind the change.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
220 (if (or (/= start-nwindows (count-windows t))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
221 (/= left (nth 0 (window-edges))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
222 (set-window-configuration wconfig)))))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
223 ;; restore the old selected window
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
224 (select-window old-selected-window))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
225
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 ;; mldrag.el ends here