🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.epoch.misc
Article #2107

epoch-move.el

#2107
From: david carlton
Date: Sun, 17 Mar 1991 21:15
200 lines
7932 bytes
Here's some functions that I wrote to allow you to move screens with
the keyboard.  To use it, just save it as epoch-move.el somewhere in
your load-path and stick the line

(autoload 'epoch-move "epoch-move" "move screens from the keyboard" t)

in your .epoch and global-set-key your favorite key to call it.

When using it you can type the cursor keys or C-f,C-b,C-p,C-n or
f,b,p,n to move the screen around.  The latter four keys move the
screen in larger increments than the others do, though of course you
can control the increment yourself.  Typing q or ESC exits.

Unfortunately, the package is less than satisfactory for a couple of
reasons.  The first is that it has to warp your cursor to the
minibuffer while it is moving the window because if it kept it on the
window being moved then things would get confused if you moved the
screen out from under the window.  The second is that the
epoch::move-screen command and the coordinates returned by
epoch::screen-information don't work together properly.  The
coordinates returned by epoch::screen-information don't include the
title bar, but the epoch::move-screen coordinates do.  While it is
possible to figure out what the offset is (by calling
epoch::screen-information, moving to the coordinates given there, and
calling it again), that would involve moving a screen, and there
should really be a way to figure out the information without moving
anything around.  Or, better yet,

(epoch::move-screen (car (epoch::screen-information))
  (cadr (epoch::screen-information)))

should be the identity.  Currently, the first time each session that
you run epoch-move, it calculates the offset for you by moving the
screen.  If you find this annoying, you can run the function
"epoch-move-display-offset" which will print a number in the
minibuffer; then, setq the variable "epoch-move-random-offset" to be
that number in your .emacs.

Also, a documentation bug: the info for epoch::screen-information is:

 * Function: epoch::screen-information &optional SCREEN-OR-XWIN

     Returns information about SCREEN-OR-XWIN, or the current screen
     if SCREEN-OR-XWIN is `nil'.  The information is a list with the
     following elements:

       1. X location of screen in pixels

       2. Y location of screen in pixels

       3. Width of screen in character columns

       4. Height of screen in character lines

       5. External Borderwidth in pixels

       6. Internal Borderwidth; for an xwin, this is always 0.

       7. Map state: `t' if normal, `nil' if iconic.

In fact, the internal borderwidth seems to come after the external
borderwidth.  And the docstring for it says 

epoch::screen-information:
Returns a list consisting of (x y width height border-width map-state)

leaving out the internal borderwidth entirely.

I don't have either official patch to 3.2 installed, so these problems
may be fixed by now, of course.

Currently, I'm really not very happy with this package - even though I
wrote it, I still find it tedious to use.  But I think that the basic
idea of being able to position windows without using the mouse is a
good one.  Any suggestions for improvement?


david carlton
carlton@husc9.harvard.edu


Here's the package:

; Function for adding keyboard control of screen movement to Epoch.
; epoch-move is the function that you want to be calling.
;
; You will probably have to tweak epoch-move-random-offset yourself.
; Also, while you are moving the window your cursor will be placed in
; the minibuffer - this is so that it won't move off of the screen
; that you are moving.

; written by david carlton, carlton@husc9.harvard.edu

(provide 'epoch-move)

; 'key-map' - have to implement this myself since i'm reading the keys
; myself.  list of pairs - car is character, cdr is function.
(defvar epoch-move-functions
  '((?q . epoch-move-quit)
    (?\e . epoch-move-quit)
    (?\C-p . epoch-move-up-small)
    (?\C-n . epoch-move-down-small)
    (?\C-b . epoch-move-left-small)
    (?\C-f . epoch-move-right-small)
    (?p . epoch-move-up-large)
    (?n . epoch-move-down-large)
    (?b . epoch-move-left-large)
    (?f . epoch-move-right-large))
  "*Assoc-list of keys and functions called by them for epoch-move.")

; I provide 2 functions - one for moving in small steps, one for
; moving in large ones.
(defvar epoch-move-distance-small 10
  "*Distance moved by the small move commands in epoch-move, in pixels.")

(defvar epoch-move-distance-large 50
  "*Distance moved by the large move commands in epoch-move, in pixels.")

; Egregious hack to get around the 'drift' cause by the height of the
; menu bar.  -21 works if your window manager is twm and your title
; font is -adobe-helvetica-bold-r-normal--*-120-*-*-*-*-*-*.
(defvar epoch-move-random-offset nil
  "*Height of titlebar, in pixels.")

; this is the important function.
(defun epoch-move ()
  "Commands for moving an epoch-window around"
  (interactive)
  (if (not epoch-move-random-offset)
      (epoch-move-set-offset))
  (cursor-to-screen (minibuf-screen))
  (unwind-protect
      (progn
	(catch 'move-done
	  (while t
	    (message "Moving window; press %c to exit"
		     (epoch-move-find-exit-command))
	    (let* ((char (read-char))
		   (fun (assq char epoch-move-functions)))
	      (if fun (funcall (cdr fun))
		(beep)))))
	(message ""))
    (cursor-to-screen (current-screen))))

(defun epoch-move-find-exit-command ()
  (do ((l epoch-move-functions (cdr l)))
      ((or (null l) (eq (cdar l) 'epoch-move-quit))
       (caar l))))

(defun epoch-move-quit ()
  (throw 'move-done t))

(defun epoch-move-up-small ()
  (do-epoch-move 0 (- epoch-move-distance-small)))
(defun epoch-move-down-small ()
  (do-epoch-move 0 epoch-move-distance-small))
(defun epoch-move-left-small ()
  (do-epoch-move (- epoch-move-distance-small) 0))
(defun epoch-move-right-small ()
  (do-epoch-move epoch-move-distance-small 0))

(defun epoch-move-up-large ()
  (do-epoch-move 0 (- epoch-move-distance-large)))
(defun epoch-move-down-large ()
  (do-epoch-move 0 epoch-move-distance-large))
(defun epoch-move-left-large ()
  (do-epoch-move (- epoch-move-distance-large) 0))
(defun epoch-move-right-large ()
  (do-epoch-move epoch-move-distance-large 0))

(defun do-epoch-move (x y)
  (let* ((screen-info (screen-information))
	 (offset (nth 5 screen-info))
	 (newx (+ x (car screen-info) (- offset)))
	 (newy (+ y (cadr screen-info) (- offset) 
		  epoch-move-random-offset)))
    (move-screen newx newy)))

(defun epoch-move-calculate-offset ()
  "Calculates offset for epoch-move-random-offset"
  (cursor-to-screen (minibuf-screen))
  (let* ((screen-info (screen-information))
	 (x (car screen-info))
	 (y (cadr screen-info)))
    (move-screen x y)
    (let* ((newinfo (screen-information))
	   (newx (car newinfo))
	   (newy (cadr newinfo))
	   (offset (- y newy (- (nth 5 newinfo)))))
      (move-screen (+ newx (* 2 (- x newx)))
		   (+ newy (* 2 (- y newy))))
      (cursor-to-screen (current-screen))
      offset)))

(defun epoch-move-display-offset ()
  (interactive)
  (message "%d" (epoch-move-calculate-offset)))

(defun epoch-move-set-offset ()
  (setq epoch-move-random-offset (epoch-move-calculate-offset)))
Technical Details
Message-ID: <CARLTON.91Mar17161502@husc10.harvard.edu>
Path: arc1-ca.pugleaf.net!gmdzi!unido!mcsun!uunet!zaphod.mps.ohio-state.edu!think.com!hsdndev!husc6!carlton

Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: fc7ee,9998896d2554978f,start
X-Google-Attributes: gidfc7ee,public
X-Google-ArrivalTime: 1991-03-18 02:59:54 PST
Path: arc1-ca.pugleaf.net!gmdzi!unido!mcsun!uunet!zaphod.mps.ohio-state.edu!think.com!hsdndev!husc6!carlton
From: carlton@husc10.harvard.edu (david carlton)
Newsgroups: gnu.epoch.misc
Subject: epoch-move.el
Message-ID: <CARLTON.91Mar17161502@husc10.harvard.edu>
Date: 17 Mar 91 21:15:02 GMT
Sender: news@husc6.harvard.edu
Distribution: gnu
Organization: Citizens for Boysenberry Jam
Lines: 200