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)
)
)
|