Commit | Line | Data |
---|---|---|
be010748 | 1 | ;;; mldrag.el --- mode line and vertical line dragging to resize windows |
b578f267 EN |
2 | |
3 | ;; Copyright (C) 1994 Free Software Foundation, Inc. | |
813f532d RS |
4 | |
5 | ;; Author: Kyle E. Jones <kyle@wonderworks.com> | |
6 | ;; Keywords: mouse | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
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. | |
14 | ||
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. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
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. | |
813f532d RS |
24 | |
25 | ;;; Commentary: | |
26 | ||
27 | ;; This package lets you drag the modeline, vertical bar and | |
28 | ;; scrollbar to resize windows. Suggested bindings are: | |
29 | ;; | |
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) | |
34 | ;; | |
35 | ;; Put the bindings and (require 'mldrag) in your .emacs file. | |
36 | ||
37 | ;;; Code: | |
38 | ||
39 | (provide 'mldrag) | |
40 | ||
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) | |
101 | (t | |
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 | |
165af501 | 117 | ;; enlarge-window will affect the |
813f532d RS |
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) | |
126 | 1)) | |
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. | |
135 | ;; | |
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)))) | |
148 | ||
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") | |
a1d44216 RS |
156 | (let* ((done nil) |
157 | (echo-keystrokes 0) | |
158 | (start-event-frame (window-frame (car (car (cdr start-event))))) | |
159 | (scroll-bar-left | |
160 | (eq (cdr (assq 'vertical-scroll-bars (frame-parameters))) 'left)) | |
161 | (start-event-window (car (car (cdr start-event)))) | |
162 | (start-nwindows (count-windows t)) | |
163 | (old-selected-window (selected-window)) | |
164 | event mouse x left right edges wconfig growth) | |
813f532d RS |
165 | (if (one-window-p t) |
166 | (error "Attempt to resize sole ordinary window")) | |
9e5d67df RS |
167 | (if scroll-bar-left |
168 | (when (= (nth 0 (window-edges start-event-window)) 0) | |
169 | (error "Attempt to drag leftmost scrollbar")) | |
170 | (when (>= (nth 2 (window-edges start-event-window)) | |
171 | (frame-width start-event-frame)) | |
172 | (error "Attempt to drag rightmost scrollbar"))) | |
813f532d RS |
173 | (unwind-protect |
174 | (track-mouse | |
175 | (progn | |
176 | ;; enlarge-window only works on the selected window, so | |
177 | ;; we must select the window where the start event originated. | |
178 | ;; unwind-protect will restore the old selected window later. | |
179 | (select-window start-event-window) | |
180 | ;; loop reading events and sampling the position of | |
181 | ;; the mouse. | |
182 | (while (not done) | |
183 | (setq event (read-event) | |
184 | mouse (mouse-position)) | |
185 | ;; do nothing if | |
186 | ;; - there is a switch-frame event. | |
187 | ;; - the mouse isn't in the frame that we started in | |
188 | ;; - the mouse isn't in any Emacs frame | |
189 | ;; drag if | |
190 | ;; - there is a mouse-movement event | |
191 | ;; - there is a scroll-bar-movement event | |
192 | ;; (same as mouse movement for our purposes) | |
193 | ;; quit if | |
194 | ;; - there is a keyboard event or some other unknown event | |
195 | ;; unknown event. | |
196 | (cond ((integerp event) | |
197 | (setq done t)) | |
198 | ((eq (car event) 'switch-frame) | |
199 | nil) | |
200 | ((not (memq (car event) | |
201 | '(mouse-movement scroll-bar-movement))) | |
202 | (setq done t)) | |
203 | ((not (eq (car mouse) start-event-frame)) | |
204 | nil) | |
205 | ((null (car (cdr mouse))) | |
206 | nil) | |
207 | (t | |
208 | (setq x (car (cdr mouse)) | |
209 | edges (window-edges) | |
210 | left (nth 0 edges) | |
211 | right (nth 2 edges)) | |
212 | ;; scale back a move that would make the | |
213 | ;; window too thin. | |
a1d44216 RS |
214 | (if scroll-bar-left |
215 | (cond ((< (- right x) window-min-width) | |
216 | (setq x (- right window-min-width)))) | |
217 | (cond ((< (- x left -1) window-min-width) | |
218 | (setq x (+ left window-min-width -1))))) | |
813f532d | 219 | ;; compute size change needed |
a1d44216 RS |
220 | (setq growth (if scroll-bar-left |
221 | (- left x) | |
222 | (- x right -1)) | |
813f532d RS |
223 | wconfig (current-window-configuration)) |
224 | (enlarge-window growth t) | |
225 | ;; if this window's growth caused another | |
226 | ;; window to be deleted because it was too | |
227 | ;; thin, rescind the change. | |
228 | ;; | |
229 | ;; if size change caused space to be stolen | |
230 | ;; from a window to the left of this one, | |
231 | ;; rescind the change. | |
232 | (if (or (/= start-nwindows (count-windows t)) | |
a1d44216 RS |
233 | (if scroll-bar-left |
234 | (/= right (nth 2 (window-edges))) | |
235 | (/= left (nth 0 (window-edges))))) | |
813f532d RS |
236 | (set-window-configuration wconfig))))))) |
237 | ;; restore the old selected window | |
238 | (select-window old-selected-window)))) | |
239 | ||
240 | ;; mldrag.el ends here |