🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.epoch.misc
Article #394

Dragging mode line - request

#394
From: Marc Andreessen
Date: Tue, 17 Nov 1992 11:32
72 lines
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!marca
References: <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