;; vtwm-icon-mgr.gwm --- Multiple Icon Managers for VTWM Profile ;; ;; Author: Anders Holst (aho@sans.kth.se) ;; Copyright (C) 1995 Anders Holst ;; Version: vtwm-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 implements icon managers for the VTWM profile. ;; ;; This file is highly inspired by "twm-icon-mgr.gwm" by Arup Mukherjee. ;; However it is thoroughly rewritten, to, among other things, handle ;; multiple icon managers. ;; ;; By default the "default icon manager" handles all windows not in ;; 'icon-mgr-omit-list'. In addition, you can add icon managers with ;; '(make-icon-mgr NAME XPOS YPOS CONDITION)' which then "steals" ;; windows from the default icon manager. ;; CONDITION can be (as can the elements of 'icon-mgr-omit-list') ;; an atom representing a client class, a string representing a window ;; name regexp, a list mathced by 'match-windowspec, or an arbitrary ;; WOOL expression. ;; NOTE: If you create multiple managers from your vtwmrc.gwm, put the ;; calls to 'make-icon-mgr' in 'to-be-done-after-setup'. ;; ;; In addition to the variables below, you might want to copy the ;; setting of 'icon-mgr-behavior' to "vtwmrc.gwm" and change it. ;; ;; To use these icon managers in other profiles than VTWM, load the ;; file "load-icon-mgr.gwm" which sets up the necessary environment. ;; (declare-screen-dependent icon-mgr-name icon-mgr-xpos icon-mgr-ypos show-default-icon-mgr show-icon-mgr icon-mgr-hide-if-empty iconify-by-unmapping iconify-unmanaged-by-icon iconify-by-icon-list iconify-on-start-list icon-mgr-omit-list icon-mgr-sort icon-mgr-font icon-mgr-width icon-mgr-foreground icon-mgr-background icon-mgr-title-foreground icon-mgr-title-background icon-mgr-no-title icon-mgr-framed-bars icon-mgr-fancy-colors default-icon-mgr icon-mgr-list icon-mgr-window-feedback icon-mgr-pixmap-name ) ;; ;; USER CUSTOMIZABLE VARIABLES ;; --------------------------- ;; Adjust these in your own profile ;; (for screen (list-of-screens) (defaults-to icon-mgr-name "Icon Manager" ; Default name of icon manager icon-mgr-xpos 0 ; Default x position icon-mgr-ypos 0 ; Default y position show-default-icon-mgr t ; Default icon manager is used show-icon-mgr t ; Use icon managers icon-mgr-hide-if-empty t ; Don't show empty managers iconify-by-unmapping t ; Do not use icons by default iconify-unmanaged-by-icon t ; Use an icon if not in any manager iconify-by-icon-list () ; Always use icons for these iconify-on-start-list () ; List of window types to iconify on start icon-mgr-omit-list () ; Window types not handled in default manager icon-mgr-sort () ; Sort the entries in an icon manager icon-mgr-font (font-make "8x13") ; Font in icon managers icon-mgr-width 150 ; Width of icon manager icon-mgr-foreground black ; Foreground of icon managers icon-mgr-background white ; Background of icon managers icon-mgr-title-foreground () icon-mgr-title-background () icon-mgr-no-title () ; Inhibits the icon manager title icon-mgr-framed-bars () ; Makes it look more like in real VTWM icon-mgr-fancy-colors () ; List of (wintype fg bg) specifications icon-mgr-window-feedback t ; Rely on focus feedback from windows icon-mgr-pixmap-name (if (boundp 'iconify-pixmap-name) iconify-pixmap-name "iconify2") ; Pixmap file for iconified symbol ; In addition, the property 'icon-mgr-special-pixmap' can be set on ; a window to the pixmap to use in the icon manager for that window. ) ) (for screen (list-of-screens) (with (imcond '(not (matches-list icon-mgr-omit-list))) (defaults-to default-icon-mgr (list () () () () imcond ())) (defaults-to icon-mgr-list (list default-icon-mgr))) ) (if (not (boundp 'iconify-before-icon-mgr)) (: iconify-before-icon-mgr iconify-window)) ;; Redefine iconify-window ;; During the time a window is "iconified by unmapping" the "wm-state-icon" ;; is set to the real icon, and the "wm-state" to 'icon, to fool the client ;; that the window is iconified when it is really withdrawn. (defun iconify-window () (if (# 'icon? window-window) (iconify-before-icon-mgr) (if (= window-status 'icon) (progn (map-window window-window) (window-wm-state-icon 0)) (progn (window-wm-state-icon (window-icon)) (unmap-window window-window) (window-wm-state-update 'icon)))) (if raise-on-iconify (raise-window-orig)) (icon-mgr-update) (virtual-update)) ;; Some useful functions for iconification (defun window-iconified () (= (window-wm-state) 'icon)) ;; (not (with (wob window-window) window-is-mapped))) (defun de-iconify-window () (if (with (wob window-window) (not window-is-mapped)) (with (wob (window-icon)) (iconify-window)))) (defun do-iconify-window () (if (not (window-iconified)) (with (wob window-window) (iconify-window)))) (defun toggle-iconify-window () (if (with (wob window-window) (not window-is-mapped)) (with (wob (window-icon)) (iconify-window)) (with (wob window-window) (iconify-window)))) (defun icon-mgr-focusin () (with (prop (# 'imgr-bar window)) (if (and (# 1 prop) (wob-is-valid (# 1 prop))) (send-user-event 'imgr-focusin (# 1 prop))))) (defun icon-mgr-focusout () (with (prop (# 'imgr-bar window)) (if (and (# 1 prop) (wob-is-valid (# 1 prop))) (send-user-event 'imgr-focusout (# 1 prop))))) (defun icon-mgr-update () (with (prop (# 'imgr-bar window-window)) (if (and (# 1 prop) (wob-is-valid (# 1 prop))) (send-user-event 'imgr-rethink (# 1 prop))))) (defun icon-mgr-raise-all () (for ele icon-mgr-list (if (and (# 0 ele) (wob-is-valid (# 0 ele))) (with (wob (# 0 ele)) (if (wob-is-valid wob-parent) (with (wob wob-parent) (raise-window-orig))))))) (defun icon-mgr-lower-all () (for ele icon-mgr-list (if (and (# 0 ele) (wob-is-valid (# 0 ele))) (with (wob (# 0 ele)) (if (wob-is-valid wob-parent) (with (wob wob-parent) (lower-window-orig))))))) (if (not (boundp 'icon-mgr-header-behavior)) (: icon-mgr-header-behavior (state-make (on (buttonpress 1 alone) (icon-mgr-raise-all)) (on (buttonpress 2 alone) (move-window)) (on (buttonpress 3 alone) (icon-mgr-lower-all)))) ) (defun imgr-header-fsm () (fsm-make (state-make icon-mgr-header-behavior (if (boundp 'standard-title-behavior) standard-title-behavior) (if (boundp 'standard-behavior) standard-behavior)))) (defunq icon-mgr-with-window body (with (wob (# 'window wob-property)) (eval (+ '(progn) body)) (if autofocus (set-focus)))) (if (not (boundp 'icon-mgr-behavior)) (: icon-mgr-behavior (state-make (on (buttonpress 1 any) (icon-mgr-with-window (de-iconify-window) (raise-window) (if (not autofocus) (set-focus window)))) (on (buttonpress 2 any) (icon-mgr-with-window (toggle-iconify-window))) (on (buttonpress 3 any) (icon-mgr-with-window (de-iconify-window) (lower-window))) )) ) (: imgr-bar-behavior (state-make (on enter-window (progn (if autofocus (set-focus (# 'window wob-property))) (if (not icon-mgr-window-feedback) (wob-borderpixel (with (wob (# 'window wob-property) cols (matches-cond icon-mgr-fancy-colors)) (or (# 0 cols) icon-mgr-foreground)))))) (on leave-window (progn (if autofocus (set-focus ())) (if (not icon-mgr-window-feedback) (wob-borderpixel (with (wob (# 'window wob-property) cols (matches-cond icon-mgr-fancy-colors)) (or (# 1 cols) icon-mgr-background)))))) (on (user-event 'imgr-install-yourself) (with (barwob wob menuwob wob-parent wob (# 'window wob-property)) (## 'imgr-bar wob (list menuwob barwob)))) (on (user-event 'imgr-focusin) (wob-borderpixel (with (wob (# 'window wob-property) cols (matches-cond icon-mgr-fancy-colors)) (or (# 0 cols) icon-mgr-foreground)))) (on (user-event 'imgr-focusout) (wob-borderpixel (with (wob (# 'window wob-property) cols (matches-cond icon-mgr-fancy-colors)) (or (# 1 cols) icon-mgr-background)))))) (defun imgr-bar-fsm () (fsm-make (state-make imgr-bar-behavior icon-mgr-behavior ))) (defun imgr-icon-pixmap () (or (# 'icon-mgr-special-pixmap window) (if (= (type icon-mgr-pixmap-name) 'pixmap) icon-mgr-pixmap-name) (pixmap-make icon-mgr-background icon-mgr-pixmap-name icon-mgr-foreground))) (defun imgr-empty-pixmap (icon-pmap) (with (foreground icon-mgr-background) (pixmap-make (width icon-pmap) (height icon-pmap)))) (defun imgr-smart-icon-name () (if (= window-icon-name "icon") ; Means that no icon name was specified window-name window-icon-name)) (: imgr-icon-fsm (fsm-make (state-make (on (user-event 'imgr-rethink) (if (with (wob (# 'window wob-property)) (window-iconified)) (wob-tile (# 'icon-pixmap wob-property)) (wob-tile (# 'empty-pixmap wob-property))))))) (: imgr-label-fsm (fsm-make (state-make (on (user-event 'imgr-rethink) (with (borderwidth 0 cols (with (wob (# 'window wob-property)) (matches-cond icon-mgr-fancy-colors)) icon-mgr-foreground (or (# 0 cols) icon-mgr-foreground) icon-mgr-background (or (# 1 cols) icon-mgr-background) background icon-mgr-background foreground icon-mgr-foreground borderpixel icon-mgr-background font icon-mgr-font dumb-temporary (active-label-make (with (wob (# 'window wob-property)) (imgr-smart-icon-name)))) (wob-tile dumb-temporary)))))) (defun imgr-make-bar (wind) (with (wob wind plug-separator 0 cols (matches-cond icon-mgr-fancy-colors) icon-mgr-foreground (or (# 0 cols) icon-mgr-foreground) icon-mgr-background (or (# 1 cols) icon-mgr-background) foreground icon-mgr-foreground background icon-mgr-background borderpixel icon-mgr-background font icon-mgr-font fsm (imgr-bar-fsm) icon-pmap (imgr-icon-pixmap) empty-pmap (imgr-empty-pixmap icon-pmap) property (+ (list 'window window 'icon-pixmap icon-pmap 'empty-pixmap empty-pmap) property)) (list wind (if icon-mgr-framed-bars (with (borderwidth 2) (bar-make (with (borderwidth 0 fsm ()) (bar-make (with (borderwidth 1 borderpixel icon-mgr-foreground) (bar-make (with (borderwidth 0 bar-min-width 3) (bar-make )) (with (borderwidth 0 fsm imgr-icon-fsm) (if (window-iconified) (plug-make icon-pmap) (plug-make empty-pmap))) (with (borderwidth 0 bar-min-width 3) (bar-make )) (with (borderwidth 0 fsm imgr-label-fsm) (plug-make (active-label-make (imgr-smart-icon-name)))) ())))))) (with (borderwidth 1) (bar-make (with (fsm imgr-icon-fsm) (if (window-iconified) (plug-make icon-pmap) (plug-make empty-pmap))) (with (fsm imgr-label-fsm) (plug-make (active-label-make (imgr-smart-icon-name)))) ())))))) (defun imgr-create-barlist (imcond) (with (barlist ()) (for wob (list-of-windows 'window) (if (eval imcond) (: barlist (+ (list (imgr-make-bar window)) barlist)))) (if icon-mgr-sort (sort barlist (lambdaq (e1 e2) (compare (with (wob (# 0 e1)) (imgr-smart-icon-name)) (with (wob (# 0 e2)) (imgr-smart-icon-name))))) barlist))) (defun imgr-add-barlist (wind lst) (with (ibar (imgr-make-bar wind)) (if icon-mgr-sort (with (i 0 len (length lst) name (with (wob wind) (imgr-smart-icon-name))) (while (and (< i len) (le 0 (compare name (with (wob (# 0 (# i lst))) (imgr-smart-icon-name))))) (: i (+ 1 i))) (+ (sublist 0 i lst) (list ibar) (sublist i len lst))) (+ lst (list ibar))))) (defun imgr-remove-barlist (wind lst) (with (i 0 len (length lst)) (while (and (< i len) (not (= wind (# 0 (# i lst))))) (: i (+ 1 i))) (delete-nth i lst))) (defun imgr-redraw-focus () (if (and autofocus icon-mgr-window-feedback) (with (pos (current-mouse-position) wind (wob-at-coords (# 0 pos) (# 1 pos))) (if wind (with (wob wind) (if (not (= window-client-class 'Gwm)) (set-focus window)) (icon-mgr-focusin) ))))) (defun imgr-make-header-bar (name) (with (fsm (imgr-header-fsm) font icon-mgr-font plug-separator 0 background (or icon-mgr-title-background icon-mgr-background) foreground (or icon-mgr-title-foreground icon-mgr-foreground)) (if icon-mgr-framed-bars (with (borderwidth 0 borderpixel background) (bar-make (bar-make (with (borderwidth 2 fsm ()) (bar-make (with (borderwidth 0) (bar-make (with (borderwidth 2 borderpixel foreground) (bar-make () (with (borderwidth 0) (plug-make (active-label-make name))) ())))))) (with (borderwidth 0 borderpixel background bar-min-width 1 background foreground) (bar-make ))))) (with (borderwidth 1 borderpixel foreground) (bar-make () (with (borderpixel background) (plug-make (active-label-make name))) ()))))) (defun imgr-create-menu (name barlist) (with (header (if (not icon-mgr-no-title) (imgr-make-header-bar name)) allmenu (with (menu-max-width icon-mgr-width menu-min-width icon-mgr-width direction vertical borderwidth 0 background (or icon-mgr-title-background icon-mgr-background) foreground (or icon-mgr-title-foreground icon-mgr-foreground) borderpixel foreground fsm ()) (eval (+ '(menu-make) (if header (list header)) (mapfor ele barlist (# 1 ele)))))) (send-user-event 'imgr-install-yourself (menu-wob allmenu)) (send-user-event 'imgr-rethink (menu-wob allmenu)) (imgr-redraw-focus) allmenu)) (defun imgr-decouple-all () (for wob (list-of-windows 'window) (if (# 'imgr-bar window) (## 'imgr-bar wob ())))) (defun imgr-reconsider-icons () (for wob (list-of-windows 'window) (if (or (not iconify-by-unmapping) (matches-list iconify-by-icon-list) (and iconify-unmanaged-by-icon (not (# 'imgr-bar window)))) (progn (## 'icon? wob t) (if (and (window-iconified) (with (wob (window-icon)) (not window-is-mapped))) (iconify-before-icon-mgr)) (window-wm-state-icon 0)) (progn (## 'icon? wob ()) (if (window-iconified) (if (with (wob (window-icon)) (window-is-mapped)) (progn (window-wm-state-icon (window-icon)) (unmap-window (window-icon)) (window-wm-state-update 'icon))) (window-wm-state-icon 0)))))) (defun imgr-xpos (ele) (with (wob (# 0 ele) xpos (or (# 2 ele) icon-mgr-xpos)) (if (< xpos 0) (- (+ screen-width xpos) (width wob)) xpos))) (defun imgr-ypos (ele) (with (wob (# 0 ele) ypos (or (# 3 ele) icon-mgr-ypos)) (if (< ypos 0) (- (+ screen-height ypos) (height wob)) ypos))) (defun imgr-save-pos (ele) (with (wob (# 0 ele) xpos (# 2 ele) ypos (# 3 ele)) (setq xpos (if (< xpos 0) (+ wob-x window-client-x window-client-borderwidth (- screen-width) (width wob)) (+ wob-x window-client-x window-client-borderwidth))) (setq ypos (if (< ypos 0) (+ wob-y window-client-y window-client-borderwidth (- screen-height) (height wob)) (+ wob-y window-client-y window-client-borderwidth))) (## 2 ele xpos) (## 3 ele ypos))) (defun imgr-delete-menu (ele) (if (and (# 0 ele) (wob-is-valid (# 0 ele))) (with (wob (# 0 ele)) (imgr-save-pos ele) (if (wob-is-valid wob-parent) (delete-window wob-parent))))) (defun imgr-show-menu (ele) (with (menuwob (if (and (# 0 ele) (wob-is-valid (# 0 ele))) (# 0 ele)) menu () name (or (# 1 ele) icon-mgr-name) imcond (list 'and '(not (= window-client-class 'Gwm)) '(not (# 'imgr-bar window)) (list 'matches-token (list 'quote (# 4 ele)))) barlist (# 5 ele) property property reenter-on-opening ()) (if (not barlist) (## 5 ele (: barlist (imgr-create-barlist imcond)))) (if menuwob (progn (if (and (wob-is-valid menuwob) (with (wob menuwob) (wob-is-valid wob-parent))) (setq property (with (wob menuwob) (with (wob wob-parent) wob-property)))) (imgr-delete-menu ele))) (if (or (> (length barlist) 0) ; Get around bug: non-nil empty list (not icon-mgr-hide-if-empty)) (progn (## 0 ele (: menuwob (menu-wob (: menu (imgr-create-menu name barlist))))) (place-menu name menu (imgr-xpos ele) (imgr-ypos ele))) (## 0 ele ())))) (defun icon-mgr-add () (if (and (not (= window-status 'icon)) (not (= window-client-class 'Gwm))) (progn (tag done (if show-icon-mgr (for ele icon-mgr-list (if (and (matches-token (# 4 ele)) (or show-default-icon-mgr (not (= ele default-icon-mgr)))) (exit done (## 5 ele (imgr-add-barlist window (# 5 ele))) (if setup-done ; Only if already realised (imgr-show-menu ele)))))) (if iconify-unmanaged-by-icon (## 'icon? window t))) (if (or (not iconify-by-unmapping) (matches-list iconify-by-icon-list)) (## 'icon? window t)) (if (matches-list iconify-on-start-list) (: window-starts-iconic t))))) (defun icon-mgr-remove () (with (prop (# 'imgr-bar window)) (if (and show-icon-mgr (# 0 prop) (wob-is-valid (# 0 prop))) (tag done (for ele icon-mgr-list (if (and (= (# 0 prop) (# 0 ele)) (or show-default-icon-mgr (not (= ele default-icon-mgr)))) (exit done (## 5 ele (imgr-remove-barlist window (# 5 ele))) (if setup-done ; Only if already realised (imgr-show-menu ele))))))) )) (defun icon-mgr-show () (for ele icon-mgr-list (## 5 ele ())) (imgr-decouple-all) (if show-icon-mgr (for ele icon-mgr-list (if (and (not show-default-icon-mgr) (= ele default-icon-mgr)) (imgr-delete-menu default-icon-mgr) (imgr-show-menu ele))) (for ele icon-mgr-list (imgr-delete-menu ele) (## 0 ele ()))) (imgr-reconsider-icons)) (defun icon-mgr-toggle () (: show-icon-mgr (not show-icon-mgr)) (icon-mgr-show)) (defun make-icon-mgr (name xpos ypos imcond) (: icon-mgr-list (+ (sublist 0 (- (length icon-mgr-list) 1) icon-mgr-list) (list (list () name xpos ypos imcond ())) (list default-icon-mgr))) (icon-mgr-show)) (defun remove-icon-mgr (name) (with (ind 0 len (length icon-mgr-list) ele (# 0 icon-mgr-list)) (while (and (< ind len) (not (= name (# 1 ele)))) (setq ind (+ 1 ind)) (setq ele (# ind icon-mgr-list))) (if (and (< ind len)) (progn (imgr-delete-menu ele) (delete-nth ind icon-mgr-list) (icon-mgr-show)))))