;; custom-install.gwm --- Hack to install custom-menu functionality ;; ;; Author: Anders Holst (aho@sans.kth.se) ;; Copyright (C) 1996 Anders Holst ;; Last change: 23/3 1996 ;; ;; 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 tries to install the "custom-menu" package functionality. ;; It loads the suitable files, it installs loading and saving of the ;; customization file in the appropriate hooks, it tries to insert ;; the "Customize" alternative in the root menu, and it redefines a ;; bunch of functions to fool packages which do not support custom-menu ;; to support it anyway. ;; ;; In the standard profile you should load this file at the beginning of ;; ".profile.gwm". ;; In the vtwm profile, for maximum effect you have to load it from the ;; file "vtwm.gwm", just after the settings of 'screen-opening' and ;; 'screen-closing', but before the definition of user customizable ;; variables (that is, load it around line 449, if there are no changes ;; done to the distributed file). ;; For the mwm profile, the custom-menu package is unfortunately not ;; applicable, since the mwm profile is too different in its philosophy ;; of how things should be done. ;; (load "edit-plug") (load "advice") (load "custom-menu") (defaults-to custom-hierarchy-by-name t custom-root-menu-position 1) ;; ;; Make sure that the customization file is loaded in the beginning ;; and saved again at the end of the session. ;; (defunq ci-add-hook (hook expr) (if (not (boundp hook)) (set hook expr) (= (# 0 (eval hook)) 'progn) (set hook (+ '(progn) (list expr) (sublist 1 (length (eval hook)) (eval hook)))) (set hook (+ '(progn) (list expr) (list (eval hook)))))) (custom-load-preferences) (ci-add-hook screen-opening (custom-apply-preferences custom-global-preferences)) (ci-add-hook screen-closing (custom-save-preferences)) ;; ;; Here we try to redefine some suitable functions, to make packages ;; install themselves in the global customization menu. ;; (setq load-filename ()) (setq custom-already-installed ()) (setq custom-install-list ()) ;; Make sure to advice the *original* load (if (and (boundp 'original-load) (not (eq original-load load))) (advice (original-load f) 'custom-install 'around (with (res () load-filename (match "\\([^/]*\\)$" f 1) custom-already-installed () custom-install-list ()) (setq res (original-load f)) (if (not custom-already-installed) (custom-smart-install load-filename custom-install-list)) res)) (advice (load f) 'custom-install 'around (with (res () load-filename (match "\\([^/]*\\)$" f 1) custom-already-installed () custom-install-list ()) (setq res (load f)) (if (not custom-already-installed) (custom-smart-install load-filename custom-install-list)) res)) ) (advice defaults-to 'custom-install 'before (setq custom-install-list (+ custom-install-list args))) (advice custom-install-symbols 'custom-install 'before (setq custom-already-installed t)) (ci-add-hook screen-opening (if (not custom-already-installed) (custom-smart-install () custom-install-list))) (setq custom-smart-install-hooks '(virtual (virtual-show) virtual-door (door-mgr-show) virtual-pan (if show-pan-lists (install-pan-lists) (remove-pan-lists)) vtwm-icon-mgr (icon-mgr-show) fvwm-window (custom-redecorate-some-windows 'fvwm-window) fvwm-icon (custom-redecorate-some-icons 'fvwm-icon) vtwm-window (progn (custom-redecorate-some-windows 'vtwm-window) (custom-redecorate-some-windows ())) simple-ed-win (progn (setq simple-ed-win.data ()) (custom-redecorate-some-windows 'simple-ed-win)) )) (setq custom-smart-install-avoid '(() (root-pop root-behavior vtwm-grabs) vtwm-icon-mgr (default-icon-mgr icon-mgr-list) load-virtual t def-menus (root-pop window-pop icon-pop) )) (defun custom-redecorate-some-windows (win-func) (with (oldwob wob) (setq wob root-window) (for wob (list-of-windows 'window) (if (and (not (= window-client-class 'Gwm)) (= win-func (std-resource-get 'GwmWindow))) (re-decorate-window))) (if (wob-is-valid oldwob) (setq wob oldwob)))) (defun custom-redecorate-some-icons (win-func) (with (oldwob wob) (setq wob root-window) (for wob (list-of-windows 'icon) (if (and (not (= window-client-class 'Gwm)) (= win-func (std-resource-get 'GwmIconWindow))) (re-decorate-window))) (if (wob-is-valid oldwob) (setq wob oldwob)))) (defun custom-smart-install (name args) (with (basename (if (match "^\\(.[^.]*\\)" name) (match "^\\(.[^.]*\\)" name 1)) partname (if (match "^\\([^-]*\\)" name) (match "^\\([^-]*\\)" name 1)) instname basename len (/ (length args) 2) res (list-make len) hook (# (atom basename) custom-smart-install-hooks) avoid (# (atom basename) custom-smart-install-avoid) i 0) (while (< i len) (## i res (# (* i 2) args)) (setq i (+ i 1))) (if (= avoid t) (setq res ()) avoid (while (> i 0) (setq i (- i 1)) (if (member (# i res) avoid) (delete-nth i res)))) (if custom-hierarchy-by-name (if (and basename partname (not (= basename partname)) (custom-find-name custom-global-menu-descr partname)) (setq instname (list partname basename)))) (if res (custom-install-symbols instname res)) (if (and res hook) (custom-install-hook instname hook)))) ;; ;; Try to install a call to '(custom-global-menu)' in the root menu. ;; This is easy in the standard profile, but trickier for vtwm. ;; (if (not custom-root-menu-position) () (and (boundp 'insert-at) (boundp 'root-pop-items)) (if (not (with (found ()) (for ele root-pop-items (if (and (= (type ele) 'list) (member '(custom-global-menu) ele)) (setq found t))) found)) (insert-at '(item-make "Customize" (custom-global-menu)) root-pop-items (max 1 (min (length root-pop-items) (if (< custom-root-menu-position 0) (+ (length root-pop-items) custom-root-menu-position 1) custom-root-menu-position))))) (boundp 'construct-menu) (advice construct-menu 'custom-install2 'around (if (and (= (type (# 0 args)) 'string) (match "^[Rr]oot" (# 0 args)) (not (with (found ()) (for ele args (if (and (= (type ele) 'list) (member '(custom-global-menu) ele)) (setq found t))) found))) (setq args (+ (sublist 0 (max 1 (min (length args) (if (< custom-root-menu-position 0) (+ (length args) custom-root-menu-position 1) custom-root-menu-position) args))) '(("Customize" (custom-global-menu))) (sublist (max 1 (min (length args) (if (< custom-root-menu-position 0) (+ (length args) custom-root-menu-position 1) custom-root-menu-position))) (length args) args)))) (apply construct-menu args)) (advice (load f) 'custom-install2 'after (if (boundp 'construct-menu) (progn (advice construct-menu 'custom-install2 'around (if (and (= (type (# 0 args)) 'string) (match "^[Rr]oot" (# 0 args)) (not (with (found ()) (for ele args (if (and (= (type ele) 'list) (member '(custom-global-menu) ele)) (setq found t))) found))) (setq args (+ (sublist 0 (max 1 (min (length args) (if (< custom-root-menu-position 0) (+ (length args) custom-root-menu-position 1) custom-root-menu-position))) args) '(("Customize" (custom-global-menu))) (sublist (max 1 (min (length args) (if (< custom-root-menu-position 0) (+ (length args) custom-root-menu-position 1) custom-root-menu-position))) (length args) args)))) (apply construct-menu args)) (unadvice load 'custom-install2)))) ) ;; ;; Install this package's variables, in the same menu as "custom-menu". ;; (with (custom-already-installed ()) (custom-install-symbols '("custom-menu") '("custom-install" custom-hierarchy-by-name custom-root-menu-position)) )