home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / emacs-19.28-src.tgz / tar.out / fsf / emacs / lisp / mldrag.el < prev    next >
Lisp/Scheme  |  1996-09-28  |  9KB  |  227 lines
  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
  227.