File: std-virtual.gwm

package info (click to toggle)
gwm 1.8d-2
  • links: PTS
  • area: main
  • in suites: potato, woody
  • size: 5,120 kB
  • ctags: 3,030
  • sloc: ansic: 19,617; makefile: 1,763; lisp: 437; sh: 321; ml: 21
file content (180 lines) | stat: -rw-r--r-- 5,692 bytes parent folder | download
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
; Anders Hoslt virtual screen package loader for the standard profile
; ===================================================================

;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
;;Revision: 1.0 -- June 28 1995

;; A wrapper to use Anders very nice virtual screen package in the 
;; standard profile
;; see virtual.gwm and virtual-door.gwm for complete options

;; here is an example of use in your .profile.gwm:

;; (setq std-virtual.doors '(
;;     ("Home" screen-background)
;;     ("Comp" "LightBlue3")
;;     ("Mail" 
;;       (pixmap-make (color-make "seagreen3") "grainy" (color-make "seagreen2"))
;;       background (color-make "seagreen3"))    
;;     ("WWW" lightgrey door-icon (pixmap-load "netscape-small.xpm"))
;;     ("Text" "LightYellow3")
;;     ("Games" grey)
;; ))
;; 
;; (load "std-virtual.gwm")


;;=============================================================================
;;                    cosmetic changes, can be overriden before load
;;=============================================================================

(if (not (boundp 'frame3d-win)) (load "frame-win"))
(set-window Gwm.menu.door-mgr frame3d-win)
(set-window Gwm.menu.virtual frame3d-win)

(defvar door-borderwidth 1)
(defvar door-mgr-no-outer-border t)
(defvar show-virtual t)
(defvar std-virtual.menupos 5)
(defvar std-virtual.windowmenupos 5)
(defvar std-virtual.iconmenupos 0)
(defvar lightgrey (color-make "LightGrey"))
(defvar door-background lightgrey)
(defvar virtual-background (color-make "grey90"))
(defvar initial-doors ())
(defvar std-virtual.doors '("Home" "Free"))
(defvar virtual-horizontal-step screen-width)
(defvar virtual-vertical-step screen-height)

(defvar door-mgr-xpos (- screen-width 250))
(defvar door-mgr-ypos (- screen-height 
    (+ 16 (* 16 (/ (+ 1 (length std-virtual.doors)) 2)))))

(defvar virtual-pixsize 181)
(defvar virtual-xpos door-mgr-xpos)
(defvar virtual-ypos (- door-mgr-ypos (+ virtual-pixsize 16)))

;;=============================================================================
;;                    behaviors
;;=============================================================================
;; a change: button 2 (action) on icon de-iconifies and follows the window

(: icon-behavior
  (state-make
    (on (buttonrelease action-button any)
      (with (deiconified-win window-window)
	(std-iconify-window)
	(setq window window-window)
	(virtual-make-window-visible)
))))

(reparse-standard-behaviors)

(de de-iconify-window-in-current-room ()
  (with (win window-window
      x 0 y 0
    )
    (std-iconify-window)
    (setq window win)
    (setq x (% window-x screen-width))
    (setq y (% window-y screen-height))
    (if (< x 0) (setq x (+ x screen-width)))
    (if (< y 0) (setq y (+ y screen-height)))
    (move-window x y)
))

;;=============================================================================
;;                    menu entries
;;=============================================================================

;; add entries in the root, window, icon menus
;; root: entry to toggle global map
;; window: nail/un-nail virtual window
;; icon: an entry to de-iconify in this room

(if (not (boundp 'std-virtual.menu-added)) (progn
    (setq std-virtual.menu-added t)
    
    (insert-at '(multi-item-make
	("Virtual Map On" (progn (setq show-virtual t) (virtual-show)))
	("Off" (progn (setq show-virtual ()) (virtual-show)))
      )
      root-pop-items
      std-virtual.menupos
    )
    (insert-at '(multi-item-make
	"Virtual" ()
	("Pick" (progn
	    (if (virtual-nailed) () (virtual-nail))
	    (if virtual-omit-nailed (virtual-update))
	))
	("Drop" (progn
	    (if (virtual-nailed) (virtual-unnail))
	    (if virtual-omit-nailed (virtual-update))
	))
      )
      window-pop-items
      std-virtual.windowmenupos
    )
    (insert-at '(item-make "de-icon here" (de-iconify-window-in-current-room))
      icon-pop-items
      std-virtual.iconmenupos
    )
))

;;=============================================================================
;;                    load the packages themselves
;;=============================================================================

(load "load-virtual.gwm")
(load "virtual-action.gwm")
(load "pick.gwm")

;;=============================================================================
;;                    door manager
;;=============================================================================

;; then create the defaults doors specified in std-virtual.doors

(for doorname std-virtual.doors
  (with (context '() name doorname)
    (if (= (type doorname) 'list) (progn
	(setq color (eval (# 1 doorname)))
	(setq name (# 0 doorname))
	(if color
	  (if (= (type color) 'number) 
	    ()				;already a color
	    (= (type color) 'pixmap)	;a tile
	    (setq context (+ (list
		  'tile color
		) context	 
	    ))
	    (setq color (color-make color)) ;default
	))
	(setq context (+ 
	    (if (= (type color) 'pixmap) () (list 'background color))
	    context)
	)
	(setq context (+ context (sublist 2 (length doorname) doorname)))
	(setq door-context (+ (list (atom name) context) door-context))
        (setq screen-opening (+ screen-opening (list 
              (list 'std-virtual.add-door name 
                    (list 'list ''door-set-background color))))))
      (setq screen-opening (+ screen-opening (list 
              (list 'add-door name)))))
))


(defun door-set-background (color)
  (with (wob root-window) 
    (if color 
      (if (= (type color) 'pixmap)
	(setq wob-tile color)
	(setq wob-background color))
)))

(defun std-virtual.add-door (name action)
  (with (position (add-door name))
    (virtual-action-add position action)
  )
)