home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / gnu / epoch / misc / 1123 < prev    next >
Encoding:
Text File  |  1992-11-17  |  3.2 KB  |  86 lines
  1. Newsgroups: gnu.epoch.misc
  2. Path: sparky!uunet!charon.amdahl.com!pacbell.com!iggy.GW.Vitalink.COM!cs.widener.edu!umn.edu!spool.mu.edu!uwm.edu!zaphod.mps.ohio-state.edu!cis.ohio-state.edu!ncsa.uiuc.edu!marca
  3. From: marca@ncsa.uiuc.edu (Marc Andreessen)
  4. Subject: Dragging mode line - request
  5. Message-ID: <9211180332.AA05862@wintermute.ncsa.uiuc.edu>
  6. Sender: daemon@cis.ohio-state.edu
  7. Organization: GNUs Not Usenet
  8. References: <11524@burns.ed.ac.uk>
  9. Distribution: gnu
  10. Date: Tue, 17 Nov 1992 11:32:46 GMT
  11. Lines: 73
  12.  
  13. Try this......... (you might have to have a few things from the imouse
  14. package also; see the FAQ).
  15.  
  16. Marc
  17.  
  18. ;;; Modeline drag support, extracted from Imouse package.
  19.  
  20. (require 'cl)
  21. (require 'motion)
  22. (require 'drag)
  23.  
  24. (defvar simplemouse::drag-scroll-start nil
  25.   "Where mouse-drag-scroll started.")
  26. (defvar simplemouse::drag-scroll-win nil
  27.   "The window where mouse-drag-scroll started.")
  28. (defvar simplemouse::drag-scroll-crs nil
  29.   "The cursor used before mouse-drag-scroll started.")
  30.  
  31. (defvar drag-modeline-glyph 116
  32.   "*The cursor glyph used to indicate drag scrolling.")
  33.  
  34. (defun eval-in-window (window &rest forms)
  35.   "Switch to WINDOW, evaluate FORMS, return to original window."
  36.   (` (let ((OriginallySelectedWindow (selected-window)))
  37.        (unwind-protect
  38.            (progn
  39.              (select-window (, window))
  40.              (,@ forms))
  41.          (select-window OriginallySelectedWindow)))))
  42. (put 'eval-in-window 'lisp-indent-hook 1)
  43.  
  44. (defun mouse-move-modeline (mdata)
  45.   "Shrink or stretch a window by dragging its modeline."
  46.   (setq mouse::downp nil) 
  47.   (setq simplemouse::drag-scroll-win (nth 2 mdata))
  48.   (setq simplemouse::drag-scroll-crs (epoch::cursor-glyph nil))
  49.   (let ((modeline (nth 3 (window-pixedges simplemouse::drag-scroll-win))))
  50.     (epoch::warp-pointer (/ (window-pixwidth simplemouse::drag-scroll-win) 2)
  51.              (- modeline 3)))
  52.   (setq simplemouse::drag-scroll-start (epoch::query-pointer))
  53.   (epoch::cursor-glyph drag-modeline-glyph)
  54.   (message "Hold button down to shrink or stretch window, release it when done."))
  55.  
  56. (defun mouse-move-modeline-terminate (mdata)
  57.   "The up click handler that goes with mouse-move-modeline.
  58. This actually resizes the window in one fell swoop"
  59.   (unwind-protect
  60.       (let* ((drag-scroll-end   (epoch::query-pointer))
  61.          (delta-y        (- (nth 1 simplemouse::drag-scroll-start)
  62.                    (nth 1 drag-scroll-end)))
  63.          (pixheight        (window-pixheight simplemouse::drag-scroll-win))
  64.          (height        (window-height simplemouse::drag-scroll-win)))
  65.     (unless (< (abs delta-y) 2)
  66.       (eval-in-window simplemouse::drag-scroll-win
  67.         (move-modeline-up (/ (* delta-y height) pixheight)))))
  68.     ;; Restore normal environment.
  69.     (epoch::cursor-glyph simplemouse::drag-scroll-crs)
  70.     (message "width: %d, height: %d"
  71.          (window-width simplemouse::drag-scroll-win)
  72.          (window-height simplemouse::drag-scroll-win)))
  73.   )
  74.  
  75. (defun simplemouse-do-bindings ()
  76.   "Bind the mouse keys according to Simplemouse's preferences."
  77.   (let ((MODE-MODIFY  (+ mouse-middle mouse-mode -1))
  78.     (DOWN          mouse-down)
  79.     (UP          mouse-up))
  80.     (global-set-mouse MODE-MODIFY DOWN    'mouse-move-modeline)
  81.     (global-set-mouse MODE-MODIFY UP    'mouse-move-modeline-terminate)
  82.     ))
  83.  
  84. (simplemouse-do-bindings)
  85.  
  86.