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
|
;; load-virtual.gwm --- Install and setup use of virtual.gwm & co.
;;
;; Author: Anders Holst (aho@sans.kth.se)
;; Copyright (C) 1995 Anders Holst
;; Version: virtual-1.0
;; Last change: 17/6 1995
;;
;; 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 is intended for use with *other* profiles than VTWM.
;; It sets up the necessary things to use the virtual screen from
;; "virtual.gwm", and also loads "virtual-door.gwm" and "virtual-pan.gwm".
;;
;; Load it from somewhere at the end of your *rc.gwm.
;;
;; First some necessary functions
(if (not (boundp 'defname-in-screen))
(defunq defname-in-screen args
(for var args
(defname var screen.)))
)
(if (not (boundp 'black)) (: black (color-make "Black")))
(if (not (boundp 'white)) (: white (color-make "White")))
(if (or (not (boundp 'defaults-to))
(not (boundp 'declare-screen-dependent)))
(load "utils"))
;;
;; Some reasonable user defaults.
;; ------------------------------
;; Change these in your own profile. Also check the three files "virtual.gwm",
;; "virtual-door.gwm" and "virtual-pan.gwm" for more customization variables.
;;
(defaults-to
virtual-xpos 6
virtual-ypos 6
virtual-nailed-list '(XLoad XClock XBiff XConsole Gwm)
virtual-omit-list '(XLoad XClock XBiff Gwm)
virtual-omit-nailed ()
door-mgr-xpos 174
door-mgr-ypos 4
show-pan-lists t
)
(declare-screen-dependent virtual-fancy-colors)
(for screen (list-of-screens)
(if (= screen-type 'color)
(progn
(defaults-to virtual-fancy-colors
(list (list () (color-make "lightgray"))
(list 'XTerm () (color-make "lightskyblue"))
(list 'Emacs () (color-make "lightpink"))
(list t () (color-make "lightyellow")))
))))
;;----------------------------------------------------------------------------
(defunq add-hook (hook expr)
(if (not (boundp hook))
(set hook expr)
(= (# 0 (eval hook)) 'progn)
(set hook (+ (eval hook) (list expr)))
(set hook (+ '(progn) (list (eval hook)) (list expr)))))
(add-hook opening (virtual-add))
(add-hook closing (virtual-remove))
(add-hook screen-opening (virtual-show))
(add-hook screen-opening (door-add-initial))
(add-hook screen-opening (if show-pan-lists (install-pan-lists)))
(add-hook screen-closing (virtual-move-home))
(if (not (boundp 'raise-window-orig))
(progn
(: raise-window-orig raise-window)
(defun raise-window arg
(if arg
(raise-window-orig (# 0 arg))
(raise-window-orig))
(virtual-update))
))
(if (not (boundp 'lower-window-orig))
(progn
(: lower-window-orig lower-window)
(defun lower-window arg
(if arg
(lower-window-orig (# 0 arg))
(lower-window-orig))
(virtual-update))
))
(if (not (boundp 'move-window-orig))
(progn
(: move-window-orig move-window)
(defun move-window args
(if args
(eval (+ (list 'move-window-orig) args))
(move-window-orig))
(if (window-is-mapped)
(virtual-update)))
))
(if (not (boundp 'resize-window-orig))
(progn
(: resize-window-orig resize-window)
(defun resize-window args
(if args
(eval (+ (list 'resize-window-orig) args))
(resize-window-orig))
(if (window-is-mapped)
(virtual-update)))
))
(if (not (boundp 'iconify-window-orig))
(progn
(: iconify-window-orig iconify-window)
(defun iconify-window ()
(iconify-window-orig)
(virtual-update))
))
(load "virtual")
(load "virtual-door")
(load "virtual-pan")
;; Sorry, have to do this to make doors work properly in the MWM-profile.
(if (boundp 'tooClose)
(setq tooClose 0))
; "Normal" profiles
(if (boundp 'root-behavior)
(progn
(setq root-behavior (state-make root-behavior (virtual-behavior)))
(setq root-fsm (fsm-make root-behavior))))
; Special for MWM-profile
(if (and (boundp 'root-std-behavior)
(boundp 'do-bindings-state)
(boundp 'keyBindings))
(progn
(setq root-std-behavior (state-make root-std-behavior (virtual-behavior)))
(setq root-fsm (fsm-make (state-make
(do-bindings-state '(root))
(# 0 (# 'root keyBindings))
root-std-behavior)))))
; Install new behavior
(with (wob root-window)
(if (boundp 'root-fsm) (wob-fsm root-fsm))
(eval (+ '(set-grabs) (virtual-grabs))))
|
