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