lisp/mldrag.el

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