275 lines
10 KiB
Plaintext
275 lines
10 KiB
Plaintext
;; 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))
|
|
)
|