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