annotate lisp/mldrag.el @ 19476:4ae9466b064e

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