186 lines
6.8 KiB
Plaintext
186 lines
6.8 KiB
Plaintext
;; virtual-pan.gwm --- Autopanning or pan on click for "virtual.gwm"
|
|
;;
|
|
;; Author: Anders Holst (aho@sans.kth.se)
|
|
;; Copyright (C) 1995 Anders Holst
|
|
;; Version: virtual-1.0
|
|
;; Last change: 24/11 1996
|
|
;;
|
|
;; This file is copyrighted under the same terms as the rest of GWM
|
|
;; (see the X Inc license for details). There is no warranty that it
|
|
;; works.
|
|
;;
|
|
;; ---------------------------------------------------------------------
|
|
;;
|
|
;; This file defines "pan-lists" to put around the edges of the
|
|
;; screen. These can be used either for autopanning on the virtual
|
|
;; screen (ie. the real window moves when the mouse enters a
|
|
;; pan-list), or "pan on click" (ie. panning occurs when the user
|
|
;; clicks on the list). Which mode to use is controlled by the
|
|
;; variable 'pan-on-click'.
|
|
;;
|
|
;; When "panning on click", the length to pan is the same as the
|
|
;; horizontal and vertical step lengths in "virtual.gwm". When
|
|
;; "autopanning", the step length is controlled by 'pan-x-step' and
|
|
;; 'pan-y-step'.
|
|
;;
|
|
;; The pan lists are installed with '(install-pan-lists)' and removed
|
|
;; with '(remove-pan-lists)'.
|
|
;;
|
|
|
|
(declare-screen-dependent
|
|
show-pan-lists
|
|
pan-on-click
|
|
pan-x-step
|
|
pan-y-step
|
|
pan-delay
|
|
pan-warp-step
|
|
pan-warp-wrapped
|
|
pan-corner-width
|
|
)
|
|
|
|
;;
|
|
;; USER CUSTOMIZABLE VARIABLES
|
|
;; ---------------------------
|
|
;; Adjust these in your own profile
|
|
;;
|
|
(for screen (list-of-screens)
|
|
(defaults-to
|
|
show-pan-lists t ; Enable pan lists
|
|
pan-on-click t ; Pan on click (i.e. when you click
|
|
; in an edge or corner of the screen), or on enter (i.e. autopan,
|
|
; pan as soon as the cursor reaches the edge of the screen).
|
|
pan-x-step (/ screen-width 4) ; How much to pan (when autopanning)
|
|
pan-y-step (/ screen-height 4) ; - " -
|
|
pan-delay () ; Time in milliseconds before autopanning
|
|
pan-warp-step 4 ; Movement of cursor from edge on autopan
|
|
pan-warp-wrapped () ; Move cursor to opposite edge on autopan
|
|
pan-corner-width 30 ; Diagonal pan when this close to corner
|
|
)
|
|
)
|
|
|
|
(defun pan-top-window ()
|
|
(with (l (list-of-windows 'stacking-order)
|
|
len (length l)
|
|
i (- len 1))
|
|
(tag ret
|
|
(while (> i -1)
|
|
(with (win (# i l))
|
|
(if (and (not (= (# 'float win) 'up))
|
|
(not (= wob win)))
|
|
(exit ret win))
|
|
(: i (- i 1)))))))
|
|
|
|
(setq pan-fsm
|
|
(fsm-make
|
|
(state-make
|
|
(on visibility-fully-obscured
|
|
(if (boundp 'raise-window-orig)
|
|
(raise-window-orig (pan-top-window))
|
|
(raise-window (pan-top-window))))
|
|
(on visibility-partially-obscured
|
|
(if (boundp 'raise-window-orig)
|
|
(raise-window-orig (pan-top-window))
|
|
(raise-window (pan-top-window))))
|
|
(on enter-window
|
|
(if (not pan-on-click)
|
|
(with (etime (if pan-delay (elapsed-time))
|
|
xpos (current-event-x)
|
|
ypos (current-event-y)
|
|
xdir (if (< xpos pan-corner-width) 1
|
|
(> xpos (- screen-width pan-corner-width 1)) -1
|
|
0)
|
|
ydir (if (< ypos pan-corner-width) 1
|
|
(> ypos (- screen-height pan-corner-width 1)) -1
|
|
0)
|
|
mpos ())
|
|
(if (or (not pan-delay)
|
|
(progn
|
|
(while (< (- (elapsed-time) etime) pan-delay) (process-events))
|
|
(setq mpos (current-mouse-position))
|
|
(= window (wob-at-coords (# 0 mpos) (# 1 mpos)))))
|
|
(progn
|
|
(virtual-move-windows (* pan-x-step xdir)
|
|
(* pan-y-step ydir))
|
|
(if pan-warp-wrapped
|
|
(warp-pointer (* (- pan-x-step pan-warp-step) xdir)
|
|
(* (- pan-y-step pan-warp-step) ydir))
|
|
(warp-pointer (* pan-warp-step xdir)
|
|
(* pan-warp-step ydir))))))))
|
|
(on (button any any)
|
|
(if pan-on-click
|
|
(with (xpos (current-event-x)
|
|
ypos (current-event-y)
|
|
xdir (if (< xpos pan-corner-width) 1
|
|
(> xpos (- screen-width pan-corner-width 1)) -1
|
|
0)
|
|
ydir (if (< ypos pan-corner-width) 1
|
|
(> ypos (- screen-height pan-corner-width 1)) -1
|
|
0))
|
|
(virtual-move-windows (* virtual-horizontal-step xdir)
|
|
(* virtual-vertical-step ydir)))))
|
|
)))
|
|
|
|
(setq no-fsm
|
|
(fsm-make
|
|
(state-make
|
|
())))
|
|
|
|
(defun make-pan-list (x y xs ys)
|
|
(with (fsm pan-fsm
|
|
background black
|
|
borderwidth 0
|
|
inner-borderwidth 0
|
|
opening '(lambda () ())
|
|
closing '(lambda () ())
|
|
property (+ '(float up) property) ; Tell others that it is topmost
|
|
describe-window '(lambda () (list (window-make () () () () ())
|
|
(window-make () () () () ())))
|
|
direction vertical
|
|
reenter-on-opening ())
|
|
(place-menu
|
|
'panlist
|
|
(with (fsm no-fsm
|
|
menu-min-width xs
|
|
menu-max-width menu-min-width
|
|
bar-min-width ys
|
|
bar-max-width bar-min-width)
|
|
(menu-make (bar-make ())))
|
|
x y)))
|
|
|
|
;; On eg. DEC-stations the pointer does not seem able to reach the last
|
|
;; pixel to the right or down. Check this to decide how broad the panlist
|
|
;; has to be.
|
|
(defun check-buggy-screen ()
|
|
(with (pos (current-mouse-position)
|
|
corner ())
|
|
(warp-pointer screen-width screen-height root-window)
|
|
(: corner (current-mouse-position))
|
|
(warp-pointer (# 0 pos) (# 1 pos) root-window)
|
|
(or (not (= (# 0 corner) (- screen-width 1)))
|
|
(not (= (# 1 corner) (- screen-height 1))))))
|
|
|
|
(defun remove-pan-lists ()
|
|
(for wob (list-of-windows)
|
|
(if (= window-name 'panlist)
|
|
(delete-window wob))))
|
|
|
|
(defun install-pan-lists ()
|
|
(remove-pan-lists)
|
|
(process-events)
|
|
(if (check-buggy-screen)
|
|
(progn
|
|
(make-pan-list 0 0 1 screen-height)
|
|
(make-pan-list 1 0 (- screen-width 3) 1)
|
|
(make-pan-list (- screen-width 2) 0 2 screen-height)
|
|
(make-pan-list 1 (- screen-height 2) (- screen-width 3) 2))
|
|
(progn
|
|
(make-pan-list 0 0 1 screen-height)
|
|
(make-pan-list 1 0 (- screen-width 2) 1)
|
|
(make-pan-list (- screen-width 1) 0 1 screen-height)
|
|
(make-pan-list 1 (- screen-height 1) (- screen-width 2) 1))))
|
|
|
|
(defun toggle-pan-lists ()
|
|
(setq show-pan-lists (not show-pan-lists))
|
|
(if show-pan-lists
|
|
(install-pan-lists)
|
|
(remove-pan-lists))) |