204 lines
6.1 KiB
Plaintext
204 lines
6.1 KiB
Plaintext
; Icon Manager Support For Twm Emulator
|
|
; =====================================
|
|
;
|
|
; Author : Arup Mukherjee (arup@grasp.cis.upenn.edu) [Dec 1989]
|
|
;
|
|
; Within the restrictions of the GWM copyright, you may do whatever you
|
|
; want with this code. It would be nice, however, if my name were to remain
|
|
; in it somewhere.
|
|
;
|
|
; New and improved (faster) icon manager. Credit due to
|
|
; J.K.Wight@newcastle.ac.uk for the redesign suggestion
|
|
;
|
|
; Bugs found and corrected 3/2-92 Dag Diesen
|
|
|
|
|
|
(if (not (boundp 'icon-pixmap))
|
|
(: icon-pixmap (pixmap-make title-background
|
|
(+ bitmaps-dir "iconify.xbm")
|
|
title-foreground)))
|
|
|
|
(if (not (boundp 'iconify-before-icon-mgr))
|
|
(: iconify-before-icon-mgr iconify-window))
|
|
|
|
(de iconify-window ()
|
|
(if (not iconify-by-unmapping)
|
|
(iconify-before-icon-mgr)
|
|
(if (window-is-mapped)
|
|
(unmap-window)
|
|
(map-window)))
|
|
(if (and show-icon-mgr (boundp 'icon-mgr-wob))
|
|
(send-user-event 'icon-mgr-rethink icon-mgr-wob)))
|
|
|
|
(: make-iconification-mgr
|
|
(fsm-make
|
|
(state-make
|
|
(on enter-window
|
|
(set-focus (# 'window wob-property)))
|
|
(on leave-window
|
|
(set-focus ()))
|
|
(on (buttonpress any any)
|
|
(with (window (# 'window wob-property))
|
|
(iconify-window)
|
|
(set-focus))))))
|
|
|
|
(: icon-mgr-plug-fsm
|
|
(fsm-make
|
|
(state-make
|
|
(on (user-event 'icon-mgr-rethink)
|
|
(with (w1 wob)
|
|
(if (with (window (# 'window wob-property))
|
|
(window-is-mapped))
|
|
(progn (wob w1)
|
|
(wob-tile (with (foreground icon-mgr-background)
|
|
(pixmap-make (width icon-pixmap)
|
|
(height icon-pixmap)))))
|
|
(progn (wob w1)
|
|
(wob-tile icon-pixmap))))))))
|
|
|
|
(: icon-mgr-label-plug-fsm
|
|
(fsm-make
|
|
(state-make
|
|
(on (user-event 'icon-mgr-rethink)
|
|
(with (w1 wob
|
|
borderwidth 0 background icon-mgr-background
|
|
foreground icon-mgr-foreground
|
|
borderpixel icon-mgr-background
|
|
font icon-mgr-font
|
|
dumb-temporary
|
|
(active-label-make (with (window (# 'window wob-property))
|
|
window-icon-name)))
|
|
(wob w1)
|
|
(wob-tile dumb-temporary)
|
|
(move-window (icon-mgr-x-pos) (icon-mgr-y-pos)))))))
|
|
|
|
|
|
|
|
(df update-menu-expr extras
|
|
(: menu-expr '(menu-make))
|
|
(with (borderwidth 0 background icon-mgr-background
|
|
foreground icon-mgr-foreground
|
|
borderpixel icon-mgr-background
|
|
font icon-mgr-font
|
|
direction vertical)
|
|
|
|
(for window (sort (+ (list-of-windows 'window))
|
|
(lambda (w1 w2)
|
|
(compare (with (window w1) (window-name))
|
|
(with (window w2) (window-name)))))
|
|
(if (and (not (member (window-name) icon-mgr-exclusions))
|
|
(not (= window icon-mgr-dying-window)))
|
|
(progn
|
|
(: mgd-bar
|
|
(with (fsm make-iconification-mgr
|
|
font icon-mgr-font
|
|
property (+ (list 'window window)
|
|
property))
|
|
(bar-make
|
|
(with (fsm icon-mgr-plug-fsm)
|
|
(if (and (not (window-is-mapped))
|
|
(not (member window extras)))
|
|
(plug-make icon-pixmap)
|
|
(with (foreground icon-mgr-background)
|
|
(plug-make
|
|
(pixmap-make
|
|
(width icon-pixmap)
|
|
(height icon-pixmap))))))
|
|
(with (fsm icon-mgr-label-plug-fsm)
|
|
(plug-make (active-label-make
|
|
(window-icon-name))))
|
|
())))
|
|
(: menu-expr (+ menu-expr (list mgd-bar))))))
|
|
(with (menu-max-width icon-mgr-max-width
|
|
menu-min-width icon-mgr-min-width
|
|
fsm ())
|
|
(if (> (length menu-expr) 1)
|
|
(: icon-mgr-menu (eval menu-expr))
|
|
(: icon-mgr-menu ())))))
|
|
|
|
|
|
(if (not (boundp 'icon-mgr-x-pos))
|
|
(df icon-mgr-x-pos ()
|
|
(with (wob (menu-wob icon-mgr-menu))
|
|
(if (or (> (+ icon-mgr-xpos (wob-width)) screen-width)
|
|
(> (+ icon-mgr-xpos icon-mgr-xstickyness) screen-width))
|
|
(- screen-width (+ wob-width 2))
|
|
icon-mgr-xpos))))
|
|
|
|
(if (not (boundp 'icon-mgr-y-pos))
|
|
(df icon-mgr-y-pos ()
|
|
(with (wob (menu-wob icon-mgr-menu))
|
|
(if (or (> (+ icon-mgr-ypos (wob-height)) screen-height)
|
|
(> (+ icon-mgr-ypos icon-mgr-ystickyness) screen-height))
|
|
(- screen-height (+ wob-height 2))
|
|
icon-mgr-ypos))))
|
|
|
|
(df icon-mgr-display extras
|
|
(if (boundp 'icon-mgr-wob)
|
|
(progn
|
|
(with (wob icon-mgr-wob)
|
|
(setq icon-mgr-xpos
|
|
(+ wob-x 1))
|
|
(setq icon-mgr-ypos
|
|
(+ (+ wob-y window-client-y) 1)))
|
|
(kill-window icon-mgr-wob)
|
|
(unbind 'icon-mgr-wob)))
|
|
(process-events)
|
|
(if (> (length (list-of-windows 'window)) 0)
|
|
(progn
|
|
(if (not (= (length extras) 0))
|
|
(eval (list 'update-menu-expr (eval extras)))
|
|
(update-menu-expr))
|
|
(with (reenter-on-opening ())
|
|
(if icon-mgr-menu
|
|
(if (or (not (boundp 'icon-mgr-xpos))
|
|
(not (boundp 'icon-mgr-ypos)))
|
|
(: icon-mgr-wob
|
|
(place-menu icon-mgr-name icon-mgr-menu))
|
|
(: icon-mgr-wob (place-menu icon-mgr-name
|
|
icon-mgr-menu
|
|
(icon-mgr-x-pos)
|
|
(icon-mgr-y-pos))))
|
|
(progn
|
|
(if (boundp 'icon-mgr-menu)
|
|
(unbind 'icon-mgr-menu))
|
|
(setq show-icon-mgr ())) )))
|
|
(progn
|
|
(if (boundp 'icon-mgr-menu)
|
|
(unbind 'icon-mgr-menu))
|
|
(setq show-icon-mgr ())) ))
|
|
|
|
|
|
(df icon-mgr-toggle ()
|
|
(if show-icon-mgr
|
|
(progn
|
|
(setq show-icon-mgr ())
|
|
(setq iconify-by-unmapping ())
|
|
(if (boundp 'icon-mgr-wob)
|
|
(progn
|
|
(kill-window icon-mgr-wob)
|
|
(unbind 'icon-mgr-menu)
|
|
(unbind 'icon-mgr-wob))))
|
|
(if (> (length (list-of-windows 'window)) 0)
|
|
(progn (setq show-icon-mgr t)
|
|
(setq iconify-by-unmapping t)
|
|
(icon-mgr-display))
|
|
(print "Can not display empty Icon Manager!\n"))
|
|
))
|
|
|
|
(: to-be-done-after-setup
|
|
'(progn
|
|
(if show-icon-mgr
|
|
(if (> (length (list-of-windows 'window)) 0)
|
|
(progn
|
|
(: setup-done t)
|
|
(eval icon-mgr-font)
|
|
(icon-mgr-display)
|
|
(if show-icon-mgr
|
|
(with (wob icon-mgr-wob)
|
|
(move-window (icon-mgr-x-pos) (icon-mgr-y-pos))))
|
|
(process-exposes))
|
|
(progn
|
|
(setq show-icon-mgr nil)
|
|
(print "Can not display empty Icon Manager!\n")) ))))
|