1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
;; 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)))
|
