Article View: gnu.epoch.misc
Article #394Dragging mode line - request
From: Marc Andreessen
Date: Tue, 17 Nov 1992 11:32
Date: Tue, 17 Nov 1992 11:32
72 lines
3331 bytes
3331 bytes
Try this......... (you might have to have a few things from the imouse
package also; see the FAQ).
Marc
;;; Modeline drag support, extracted from Imouse package.
(require 'cl)
(require 'motion)
(require 'drag)
(defvar simplemouse::drag-scroll-start nil
"Where mouse-drag-scroll started.")
(defvar simplemouse::drag-scroll-win nil
"The window where mouse-drag-scroll started.")
(defvar simplemouse::drag-scroll-crs nil
"The cursor used before mouse-drag-scroll started.")
(defvar drag-modeline-glyph 116
"*The cursor glyph used to indicate drag scrolling.")
(defun eval-in-window (window &rest forms)
"Switch to WINDOW, evaluate FORMS, return to original window."
(` (let ((OriginallySelectedWindow (selected-window)))
(unwind-protect
(progn
(select-window (, window))
(,@ forms))
(select-window OriginallySelectedWindow)))))
(put 'eval-in-window 'lisp-indent-hook 1)
(defun mouse-move-modeline (mdata)
"Shrink or stretch a window by dragging its modeline."
(setq mouse::downp nil)
(setq simplemouse::drag-scroll-win (nth 2 mdata))
(setq simplemouse::drag-scroll-crs (epoch::cursor-glyph nil))
(let ((modeline (nth 3 (window-pixedges simplemouse::drag-scroll-win))))
(epoch::warp-pointer (/ (window-pixwidth simplemouse::drag-scroll-win) 2)
(- modeline 3)))
(setq simplemouse::drag-scroll-start (epoch::query-pointer))
(epoch::cursor-glyph drag-modeline-glyph)
(message "Hold button down to shrink or stretch window, release it when done."))
(defun mouse-move-modeline-terminate (mdata)
"The up click handler that goes with mouse-move-modeline.
This actually resizes the window in one fell swoop"
(unwind-protect
(let* ((drag-scroll-end (epoch::query-pointer))
(delta-y (- (nth 1 simplemouse::drag-scroll-start)
(nth 1 drag-scroll-end)))
(pixheight (window-pixheight simplemouse::drag-scroll-win))
(height (window-height simplemouse::drag-scroll-win)))
(unless (< (abs delta-y) 2)
(eval-in-window simplemouse::drag-scroll-win
(move-modeline-up (/ (* delta-y height) pixheight)))))
;; Restore normal environment.
(epoch::cursor-glyph simplemouse::drag-scroll-crs)
(message "width: %d, height: %d"
(window-width simplemouse::drag-scroll-win)
(window-height simplemouse::drag-scroll-win)))
)
(defun simplemouse-do-bindings ()
"Bind the mouse keys according to Simplemouse's preferences."
(let ((MODE-MODIFY (+ mouse-middle mouse-mode -1))
(DOWN mouse-down)
(UP mouse-up))
(global-set-mouse MODE-MODIFY DOWN 'mouse-move-modeline)
(global-set-mouse MODE-MODIFY UP 'mouse-move-modeline-terminate)
))
(simplemouse-do-bindings)
Technical Details
Message-ID:
<9211180332.AA05862@wintermute.ncsa.uiuc.edu>Path:
arc1-ca.pugleaf.net!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!marcaReferences:
<11524@burns.ed.ac.uk>Show Full Headers
Complete Article Headers
Newsgroups: gnu.epoch.misc Path: arc1-ca.pugleaf.net!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 From: marca@ncsa.uiuc.edu (Marc Andreessen) Subject: Dragging mode line - request Message-ID: <9211180332.AA05862@wintermute.ncsa.uiuc.edu> Sender: daemon@cis.ohio-state.edu Organization: GNUs Not Usenet References: <11524@burns.ed.ac.uk> Distribution: gnu Date: Tue, 17 Nov 1992 11:32:46 GMT Lines: 73