annotate lisp/mldrag.el @ 19445:94a54fbffb3e

A lot of comment and doc fixes. Replace: 'nil by nil, '() by nil, 't by t. (ps-print-version): New version number (3.05). (ps-zebra-stripe, ps-number-of-zebra, ps-line-number) (ps-print-background-image, ps-print-background-text): New variables to customize zebra stripes, line number, image background and text background features, respectively. (ps-adobe-tag): Tagged to PostScript level 3. (ps-print-buffer, ps-print-buffer-with-faces) (ps-print-region, ps-print-region-with-faces) (ps-spool-buffer, ps-spool-buffer-with-faces) (ps-spool-region, ps-spool-region-with-faces): Call more primitive functions for PostScript printing (functions below). (ps-print-with-faces, ps-print-without-faces) (ps-spool-with-faces, ps-spool-without-faces): More primitive functions for PostScript printing. (ps-line-lengths, ps-nb-pages-buffer, ps-nb-pages-region) (ps-line-lengths-internal, ps-nb-pages): Doc fixes. (ps-print-prologue-1): a lot of PostScript programming: /dobackgroundstring, /dounderline, /UL: Postscript functions deleted. /reencodeFontISO, /F, /BG, /HL, /W, /S, /BeginDSCPage, /BeginPage, /EndPage: adjusted for new effects (outline, shadow, etc). /PLN, /EF, /Hline, /doBox, /doRect, /doShadow, /doOutline, /FillBgColor, /doLineNumber, /printZebra, /doColumnZebra, /doZebra, /BeginBackImage, /EndBackImage, /ShowBackText: New procedures. (ps-current-underline-p, ps-set-underline): Var and fn deleted. (ps-showline-count, ps-background-pages, ps-background-all-pages) (ps-background-text-count, ps-background-image-count): New variables. (ps-header-font, ps-header-title-font) (ps-header-line-height, ps-header-title-line-height) (ps-landscape-page-height): Set initial value to nil. (ps-print-face-extension-alist, ps-print-face-map-alist): New variables for face remapping. (ps-new-faces, ps-extend-face-list, ps-extend-face): New functions for face remapping. (ps-override-list, ps-extension-to-bit-face) (ps-extension-to-screen-face, ps-extension-bit) (ps-initialize-faces, ps-map-font-lock, ps-screen-to-bit-face): New internal functions for face remapping. (ps-get-page-dimensions): Fix error message. (ps-insert-file): Doc fix and programming enhancement. (ps-begin-file, ps-end-file, ps-get-buffer-name, ps-begin-page) (ps-next-line, ps-plot-region, ps-face-attributes) (ps-face-attribute-list, ps-plot-with-face) (ps-generate-postscript-with-faces): Handle new output features. (ps-generate): save-excursion inserted to return back point at position before calling ps-print. (ps-do-spool): Access dos-ps-printer variable through symbol-value. (ps-prsc, ps-c-prsc, ps-s-prsc): Use backquote. (ps-basic-plot-whitespace, ps-emacs-face-kind-p): Internal blank line eliminated. (ps-float-format, ps-current-effect): New internal variables. (ps-output-list, ps-count-lines, ps-background-pages) (ps-get-boundingbox, ps-float-format, ps-background-text) (ps-background-image, ps-background, ps-header-height) (ps-get-face): New internal functions. (ps-control-character): Handle control characters. (ps-gnus-print-article-from-summary): Updated for Gnus 5. (ps-jack-setup): Replace 'nil by nil, 't by t.
author Richard M. Stallman <rms@gnu.org>
date Wed, 20 Aug 1997 23:11:35 +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