lisp/mldrag.el

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