annotate lisp/mldrag.el @ 24419:30e478cd167e

(shell-command-default-error-buffer): Renamed from shell-command-on-region-default-error-buffer. (shell-command-on-region): Mention in echo area when there is some error output. Mention success or failure, too. Accumulate multiple error outputs going forward, with formfeed in between. Display the error buffer when we have put something in it. (shell-command): Add the ERROR-BUFFER argument feature.
author Karl Heuer <kwzh@gnu.org>
date Mon, 01 Mar 1999 03:19:32 +0000
parents 735a0243ce6f
children
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")
20652
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
156 (let* ((done nil)
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
157 (echo-keystrokes 0)
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
158 (start-event-frame (window-frame (car (car (cdr start-event)))))
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
159 (scroll-bar-left
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
160 (eq (cdr (assq 'vertical-scroll-bars (frame-parameters))) 'left))
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
161 (start-event-window (car (car (cdr start-event))))
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
162 (start-nwindows (count-windows t))
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
163 (old-selected-window (selected-window))
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
164 event mouse x left right edges wconfig growth)
7267
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 (if (one-window-p t)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166 (error "Attempt to resize sole ordinary window"))
20819
735a0243ce6f (mldrag-drag-vertical-line): Fix criterion
Richard M. Stallman <rms@gnu.org>
parents: 20787
diff changeset
167 (if scroll-bar-left
735a0243ce6f (mldrag-drag-vertical-line): Fix criterion
Richard M. Stallman <rms@gnu.org>
parents: 20787
diff changeset
168 (when (= (nth 0 (window-edges start-event-window)) 0)
735a0243ce6f (mldrag-drag-vertical-line): Fix criterion
Richard M. Stallman <rms@gnu.org>
parents: 20787
diff changeset
169 (error "Attempt to drag leftmost scrollbar"))
735a0243ce6f (mldrag-drag-vertical-line): Fix criterion
Richard M. Stallman <rms@gnu.org>
parents: 20787
diff changeset
170 (when (>= (nth 2 (window-edges start-event-window))
735a0243ce6f (mldrag-drag-vertical-line): Fix criterion
Richard M. Stallman <rms@gnu.org>
parents: 20787
diff changeset
171 (frame-width start-event-frame))
735a0243ce6f (mldrag-drag-vertical-line): Fix criterion
Richard M. Stallman <rms@gnu.org>
parents: 20787
diff changeset
172 (error "Attempt to drag rightmost scrollbar")))
7267
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 (unwind-protect
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174 (track-mouse
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175 (progn
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 ;; enlarge-window only works on the selected window, so
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177 ;; we must select the window where the start event originated.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178 ;; unwind-protect will restore the old selected window later.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
179 (select-window start-event-window)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180 ;; loop reading events and sampling the position of
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 ;; the mouse.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 (while (not done)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183 (setq event (read-event)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
184 mouse (mouse-position))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 ;; do nothing if
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186 ;; - there is a switch-frame event.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187 ;; - the mouse isn't in the frame that we started in
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188 ;; - the mouse isn't in any Emacs frame
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189 ;; drag if
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 ;; - there is a mouse-movement event
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191 ;; - there is a scroll-bar-movement event
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192 ;; (same as mouse movement for our purposes)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193 ;; quit if
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194 ;; - there is a keyboard event or some other unknown event
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195 ;; unknown event.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196 (cond ((integerp event)
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 ((eq (car event) 'switch-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 ((not (memq (car event)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201 '(mouse-movement scroll-bar-movement)))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202 (setq done t))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
203 ((not (eq (car mouse) start-event-frame))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204 nil)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
205 ((null (car (cdr mouse)))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206 nil)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207 (t
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208 (setq x (car (cdr mouse))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 edges (window-edges)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210 left (nth 0 edges)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211 right (nth 2 edges))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
212 ;; scale back a move that would make the
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
213 ;; window too thin.
20652
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
214 (if scroll-bar-left
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
215 (cond ((< (- right x) window-min-width)
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
216 (setq x (- right window-min-width))))
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
217 (cond ((< (- x left -1) window-min-width)
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
218 (setq x (+ left window-min-width -1)))))
7267
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
219 ;; compute size change needed
20652
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
220 (setq growth (if scroll-bar-left
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
221 (- left x)
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
222 (- x right -1))
7267
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
223 wconfig (current-window-configuration))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
224 (enlarge-window growth t)
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
225 ;; if this window's growth caused another
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 ;; window to be deleted because it was too
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227 ;; thin, rescind the change.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
228 ;;
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229 ;; if size change caused space to be stolen
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230 ;; from a window to the left of this one,
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231 ;; rescind the change.
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232 (if (or (/= start-nwindows (count-windows t))
20652
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
233 (if scroll-bar-left
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
234 (/= right (nth 2 (window-edges)))
9bdfab6be02f (mldrag-drag-vertical-line): Handle left-side scroll bars.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
235 (/= left (nth 0 (window-edges)))))
7267
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 (set-window-configuration wconfig)))))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 ;; restore the old selected window
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238 (select-window old-selected-window))))
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
239
4aa70d4d981c Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240 ;; mldrag.el ends here