693 lines
25 KiB
Plaintext
693 lines
25 KiB
Plaintext
;; custom-menu.gwm --- User-friendlier package customizations
|
|
;;
|
|
;; 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 implements a way for other packages to provide easy
|
|
;; customization via menus, without spending too much effort on it
|
|
;; themselves.
|
|
;;
|
|
;;
|
|
;; The main function is '(custom-menu <MENU-DESCRIPTION>)'.
|
|
;;
|
|
;; In the simplest case its argument is a list of strings and variables,
|
|
;; and it constructs a menu where the user can edit the values of the
|
|
;; given variables. Typically the first element in the list should be
|
|
;; the name of the menu, but any strings in the list show up as labels.
|
|
;;
|
|
;; The list can also contain other "menu descriptions" as elements.
|
|
;; They will turn up as buttons leading to these "sub-menus". Note that
|
|
;; then the first element in each sub-menu description *must* be
|
|
;; the name of it (and not a variable or a sub-description).
|
|
;;
|
|
;; Actually, the first element in each menu-description can also be a
|
|
;; list where the first element is the name of it and the rest an
|
|
;; association list. Currently the only supported field in this
|
|
;; association list is 'hook', which should be some code to run whenever
|
|
;; the value of a variable is changed in the menu.
|
|
;;
|
|
;; To start edit a value in the menu, you click in the corresponding
|
|
;; field. If the variable 'custom-immediate-change' is non-nil, the
|
|
;; variable is assigned to the new value as soon you finish editing.
|
|
;; There is also a special construct, to allow more complex values. If
|
|
;; the field starts with a comma (,) the following expression is
|
|
;; evaluated before the assignment.
|
|
;;
|
|
;; But that's all there is to it really.
|
|
;;
|
|
;; The rest of the code in this file is to provide a simple way
|
|
;; for packages to install their customizable variables in a global
|
|
;; custom-menu hierarchy, and to maintain the user's variable settings
|
|
;; between GWM sessions.
|
|
;;
|
|
;;
|
|
;; There are two functions intended to be used by the package developer:
|
|
;; (custom-install-symbols <PACKAGE-NAME> <SYMBOL-LIST>)
|
|
;; (custom-install-hook <PACKAGE-NAME> <HOOK-CODE>)
|
|
;;
|
|
;; The <PACKAGE-NAME> is either a string, or a list of strings serving
|
|
;; as a "path" through the menu hierarchy. <SYMBOL-LIST> is the list of
|
|
;; all customizable variables in the package. <HOOK-CODE> is a piece of
|
|
;; code (quoted) to run whenever any of the customizable variables
|
|
;; have changed. It is of course not necessary to provide such a hook,
|
|
;; but it is very nice to have one.
|
|
;;
|
|
;; Another thing to consider for the package developer is to make the
|
|
;; variables suitable for customization in this way. Colors and fonts
|
|
;; should *not* be stored as numbers but as the strings used when
|
|
;; creating them. The contents of variables should preferably not be
|
|
;; very long lists, since these are hard to edit. If values are cached
|
|
;; there should be some way of updating the cache when the values have
|
|
;; changed, and if values are not cached the package should not assume
|
|
;; that the contents of variables will remain the same during the whole
|
|
;; session.
|
|
;;
|
|
;;
|
|
;; There are three functions intended for the GWM user:
|
|
;; (custom-global-menu)
|
|
;; (custom-load-preferences)
|
|
;; (custom-save-preferences)
|
|
;;
|
|
;; '(custom-global-menu)' brings you into the top of the custom-menu
|
|
;; hierarchy. It is most suitably called from the root menu.
|
|
;;
|
|
;; The function '(custom-load-preferences)' can be called either when
|
|
;; loading the profile, or from the 'screen-opening' hook and
|
|
;; '(custom-save-preferences)' can be called from the 'screen-closing'
|
|
;; hook. They try to maintain a file ".customize.gwm" where the
|
|
;; variables the user have changed through the custom menus are saved.
|
|
;;
|
|
|
|
(declare-screen-dependent
|
|
custom-font
|
|
custom-symbol-font
|
|
custom-value-font
|
|
custom-value-font-slant
|
|
custom-background
|
|
custom-foreground
|
|
custom-button-background
|
|
custom-value-background
|
|
custom-value-frame
|
|
custom-immediate-feedback
|
|
custom-immediate-change
|
|
custom-keep-comma-string
|
|
custom-preference-file
|
|
custom-global-preferences
|
|
custom-preferences-changed
|
|
custom-global-menu-descr
|
|
)
|
|
|
|
;;
|
|
;; USER CUSTOMIZABLE VARIABLES
|
|
;; ---------------------------
|
|
;; Adjust these in your own profile
|
|
;;
|
|
(with (wob wob)
|
|
(for screen (list-of-screens)
|
|
(defaults-to
|
|
custom-font "6x13bold"
|
|
custom-symbol-font "6x13"
|
|
custom-value-font "6x13"
|
|
custom-value-font-slant 0
|
|
custom-foreground "black"
|
|
custom-background "lightcyan"
|
|
custom-button-background "white"
|
|
custom-value-background "white"
|
|
custom-value-frame t
|
|
custom-immediate-feedback t
|
|
custom-immediate-change t
|
|
custom-keep-comma-string t
|
|
)))
|
|
|
|
(with (wob wob)
|
|
(for screen (list-of-screens)
|
|
(setq custom-global-preferences ())
|
|
(setq custom-preferences-changed ())
|
|
(setq custom-global-menu-descr '("Customizations"))
|
|
))
|
|
|
|
(with (tmp (getenv "GWM_CUSTOM_FILE"))
|
|
(if (= tmp "")
|
|
(setq custom-preference-file "./.customize.gwm")
|
|
(match "/" tmp)
|
|
(setq custom-preference-file tmp)
|
|
(setq custom-preference-file (+ "./" tmp))))
|
|
|
|
(if (not (boundp 'edit-plug-make))
|
|
(load "edit-plug"))
|
|
|
|
(defun custom-print-to-string (val)
|
|
(if (member (type val) '(subr fsubr expr fexpr))
|
|
"<PROC>"
|
|
(= (type val) 'string)
|
|
(+ "\"" val "\"")
|
|
(= (type val) 'list)
|
|
(with (parts (mapfor ele val (custom-print-to-string ele))
|
|
len (length parts)
|
|
res (list-make (+ (* len 2) 1))
|
|
i 0 j 1)
|
|
(## 0 res "(")
|
|
(while (< i len)
|
|
(## j res (# i parts))
|
|
(## (+ j 1) res " ")
|
|
(setq i (+ i 1))
|
|
(setq j (+ j 2)))
|
|
(## (max 1 (- j 1)) res ")")
|
|
(apply + res))
|
|
(with-output-to-string (? val))))
|
|
|
|
(defun custom-read-from-string (_str_)
|
|
(with (_res_ ()
|
|
_bad_ t)
|
|
(error-occurred
|
|
(if (match "^," _str_)
|
|
(execute-string (+ "(setq _bad_ (error-occurred (setq _res_ "
|
|
(match "^.\\(.*\\)$" _str_ 1)
|
|
")))"))
|
|
(execute-string (+ "(setq _bad_ (error-occurred (setq _res_ (quote "
|
|
_str_
|
|
"))))"))))
|
|
(if _bad_
|
|
()
|
|
(list _res_))))
|
|
|
|
(defun custom-substitute-in-string (from to str)
|
|
(with (res ()
|
|
mlst ()
|
|
head str)
|
|
(while (> (length (setq mlst (match (+ "\\(.*\\)\\(" from "\\)\\(.*\\)")
|
|
head 1 2 3)))
|
|
0)
|
|
(setq res (+ (list to (# 2 mlst)) res))
|
|
(setq head (# 0 mlst)))
|
|
(eval (+ '(+) (list head) res))))
|
|
|
|
;; Specialized normal state, how to start editing.
|
|
(: custom-edit-normal-state
|
|
(state-make
|
|
(on (button any any)
|
|
(progn
|
|
(send-user-event 'edit-plug-start wob)
|
|
(edit-plug-xposition (current-event-relative-x))))
|
|
edit-plug-normal-state
|
|
))
|
|
|
|
;; Specialized active state, when to stop or abort editing.
|
|
(: custom-edit-active-state
|
|
(state-make
|
|
(on focus-out
|
|
(send-user-event 'edit-plug-done wob))
|
|
edit-plug-active-state
|
|
))
|
|
|
|
;; Things to do when starting editing.
|
|
(defun custom-start-edit ()
|
|
(set-focus wob)
|
|
(process-events)) ; To let the focus change take effect before the
|
|
; fsm enters the active state. Otherwise the fsm
|
|
; may immediately leave the active state again,
|
|
; due to some spurious focus-out event.
|
|
|
|
;; Things to do when editing is done.
|
|
(defun custom-end-edit ()
|
|
(with (menuwob (custom-top-parent)
|
|
immch (# 'immch menuwob)
|
|
sym (# 'symbol wob)
|
|
str (edit-plug-get)
|
|
comma (and custom-keep-comma-string (match "^," str))
|
|
res (custom-read-from-string str))
|
|
(if res
|
|
(if (not (equal (# 2 sym) (if comma str res)))
|
|
(progn
|
|
(if (not (# 3 sym))
|
|
(## 3 sym (or (# 2 sym) t)))
|
|
(## 2 sym (if comma str res))
|
|
(if immch
|
|
(progn
|
|
(set (# 0 sym) (# 0 res))
|
|
(## 4 sym t)
|
|
(eval (# 'hook wob))))
|
|
(if (and (not comma) custom-immediate-feedback)
|
|
(edit-plug-change (custom-print-to-string (# 0 res))))))
|
|
(if custom-immediate-feedback
|
|
(edit-plug-change (if (# 2 sym)
|
|
(if (= (type (# 2 sym)) 'string)
|
|
(# 2 sym)
|
|
(custom-print-to-string (# 0 (# 2 sym))))
|
|
""))))))
|
|
|
|
(defun custom-abort-edit ()
|
|
())
|
|
|
|
(defun custom-plug-separator (size)
|
|
(with (fsm ()
|
|
foreground background)
|
|
(plug-make (pixmap-make size 1))))
|
|
|
|
(defun custom-symbol-plug (label)
|
|
(with (fsm ()
|
|
font (if (= (type custom-symbol-font) 'number)
|
|
custom-symbol-font
|
|
(font-make custom-symbol-font))
|
|
label-horizontal-margin 2
|
|
label-vertical-margin 2)
|
|
(plug-make (label-make label))))
|
|
|
|
(defun custom-label-plug (label)
|
|
(with (fsm ()
|
|
font (if (= (type custom-font) 'number)
|
|
custom-font
|
|
(font-make custom-font))
|
|
label-horizontal-margin 2
|
|
label-vertical-margin 2)
|
|
(plug-make (label-make label))))
|
|
|
|
(defun custom-value-plug (item)
|
|
(with (font (if (= (type custom-value-font) 'number)
|
|
custom-value-font
|
|
(font-make custom-value-font))
|
|
font-slant (or custom-value-font-slant 0)
|
|
label-horizontal-margin 4
|
|
label-vertical-margin 1
|
|
edit-plug-start-hook '(custom-start-edit)
|
|
edit-plug-done-hook '(custom-end-edit)
|
|
edit-plug-abort-hook '(custom-abort-edit)
|
|
edit-plug-normal-state custom-edit-normal-state
|
|
edit-plug-active-state custom-edit-active-state
|
|
property (+ (list 'symbol item 'hook hook) property))
|
|
(with (borderwidth (if custom-value-frame 1 0)
|
|
borderpixel foreground)
|
|
(bar-make
|
|
(with (borderwidth 0)
|
|
(bar-make
|
|
(with (borderwidth 1
|
|
background (if custom-value-background
|
|
(if (= (type custom-value-background)
|
|
'number)
|
|
custom-value-background
|
|
(color-make custom-value-background))
|
|
background)
|
|
borderpixel background
|
|
active-borderpixel foreground)
|
|
(edit-plug-make (if (# 2 item)
|
|
(if (= (type (# 2 item)) 'string)
|
|
(# 2 item)
|
|
(custom-print-to-string (# 0 (# 2 item))))
|
|
"")))))))))
|
|
|
|
(defun custom-button-plug (label action)
|
|
(with (font (if (= (type custom-font) 'number)
|
|
custom-font
|
|
(font-make custom-font))
|
|
outer-background background
|
|
background (if custom-button-background
|
|
(if (= (type custom-button-background) 'number)
|
|
custom-button-background
|
|
(color-make custom-button-background))
|
|
background)
|
|
label-horizontal-margin 5
|
|
label-vertical-margin 3
|
|
pix (label-make label)
|
|
dim (dimensions pix))
|
|
(draw-rectangle pix 2 2 (- (# 2 dim) 4) (- (# 3 dim) 4) 2 1)
|
|
(with (foreground outer-background)
|
|
(draw-line pix 0 0 0 1)
|
|
(draw-line pix 1 0 1 0)
|
|
(draw-line pix 0 (- (# 3 dim) 2) 0 (- (# 3 dim) 1))
|
|
(draw-line pix 1 (- (# 3 dim) 1) 1 (- (# 3 dim) 1))
|
|
(draw-line pix (- (# 2 dim) 1) 0 (- (# 2 dim) 1) 1)
|
|
(draw-line pix (- (# 2 dim) 2) 0 (- (# 2 dim) 2) 0)
|
|
(draw-line pix (- (# 2 dim) 1) (- (# 3 dim) 2)
|
|
(- (# 2 dim) 1) (- (# 3 dim) 1))
|
|
(draw-line pix (- (# 2 dim) 2) (- (# 3 dim) 1)
|
|
(- (# 2 dim) 2) (- (# 3 dim) 1)))
|
|
(draw-line pix 2 2 2 2)
|
|
(draw-line pix (- (# 2 dim) 3) 2 (- (# 2 dim) 3) 2)
|
|
(draw-line pix 2 (- (# 3 dim) 3) 2 (- (# 3 dim) 3))
|
|
(draw-line pix (- (# 2 dim) 3) (- (# 3 dim) 3)
|
|
(- (# 2 dim) 3) (- (# 3 dim) 3))
|
|
(with (fsm (fsm-make (state-make (on-eval '(button any any) action))))
|
|
(plug-make pix))))
|
|
|
|
(defun custom-top-parent ()
|
|
(with (wob wob
|
|
par wob-parent)
|
|
(while (not (= par window))
|
|
(setq wob wob-parent)
|
|
(setq par wob-parent))
|
|
wob))
|
|
|
|
(defun custom-done ()
|
|
(with (menuwob (custom-top-parent)
|
|
descr (# 'descr menuwob)
|
|
hook (# 'hook menuwob)
|
|
change ()
|
|
res ())
|
|
(set-focus)
|
|
(process-events)
|
|
(for sym descr
|
|
(if (and (# 0 sym) (# 2 sym) (# 3 sym) (not (# 4 sym)))
|
|
(if (= (type (# 2 sym)) 'string)
|
|
(if (setq res (custom-read-from-string (# 2 sym)))
|
|
(progn
|
|
(set (# 0 sym) (# 0 res))
|
|
(setq change t)))
|
|
(progn
|
|
(set (# 0 sym) (# 0 (# 2 sym)))
|
|
(setq change t)))))
|
|
(if change
|
|
(with (custom-refresh-menu ())
|
|
(eval hook)))
|
|
(for sym descr
|
|
(if (and (# 0 sym) (# 2 sym) (# 3 sym))
|
|
(custom-put-preference (# 0 sym) (# 2 sym))))
|
|
(if (window-is-valid window)
|
|
(delete-window window))))
|
|
|
|
(defun custom-cancel ()
|
|
(with (menuwob (custom-top-parent)
|
|
descr (# 'descr menuwob)
|
|
hook (# 'hook menuwob)
|
|
change ()
|
|
res ())
|
|
(set-focus)
|
|
(process-events)
|
|
(for sym descr
|
|
(if (and (# 0 sym) (# 3 sym) (# 4 sym))
|
|
(if (= (# 3 sym) t)
|
|
(unbind (# 0 sym))
|
|
(= (type (# 3 sym)) 'string)
|
|
(if (setq res (custom-read-from-string (# 3 sym)))
|
|
(progn
|
|
(set (# 0 sym) (# 0 res))
|
|
(setq change t)))
|
|
(progn
|
|
(set (# 0 sym) (# 0 (# 3 sym)))
|
|
(setq change t)))))
|
|
(if change
|
|
(with (custom-refresh-menu ())
|
|
(eval hook)))
|
|
(delete-window window)))
|
|
|
|
(defun custom-construct-menu (descr)
|
|
(with (fsm ()
|
|
bordertile ()
|
|
bar-max-width 3000
|
|
bar-min-width 0
|
|
background (if (= (type custom-background) 'number)
|
|
custom-background
|
|
(color-make custom-background))
|
|
foreground (if (= (type custom-foreground) 'number)
|
|
custom-foreground
|
|
(color-make custom-foreground))
|
|
borderpixel background
|
|
borderwidth 1
|
|
direction vertical
|
|
align-column 0
|
|
bar-list ()
|
|
hook (if (not (# 0 (# 0 descr))) (# 'hook (# 2 (# 0 descr)))))
|
|
(with (m 0 sz ())
|
|
(for ele descr
|
|
(if (# 0 ele)
|
|
(with (font (if (= (type custom-symbol-font) 'number)
|
|
custom-symbol-font
|
|
(font-make custom-symbol-font)))
|
|
(setq sz (# 2 (dimensions (+ (# 0 ele)))))
|
|
(## 1 ele sz)
|
|
(setq m (max m sz)))))
|
|
(setq align-column (+ m 2)))
|
|
(setq bar-list
|
|
(mapfor ele descr
|
|
(if (# 0 ele)
|
|
(bar-make
|
|
(custom-plug-separator 5)
|
|
(custom-symbol-plug (# 0 ele))
|
|
(custom-plug-separator (- align-column (# 1 ele)))
|
|
(custom-value-plug ele)
|
|
(custom-plug-separator 10))
|
|
(= (type (# 1 ele)) 'list)
|
|
(bar-make
|
|
(custom-plug-separator 10)
|
|
(custom-button-plug (if (= (type (# 0 (# 1 ele))) 'string)
|
|
(# 0 (# 1 ele))
|
|
(# 0 (# 0 (# 1 ele))))
|
|
(list 'custom-menu
|
|
(list 'quote (# 1 ele))
|
|
'(+ window-x 15)
|
|
'(+ window-y 15))))
|
|
(= (type (# 1 ele)) 'string)
|
|
(bar-make
|
|
(custom-plug-separator 10)
|
|
(custom-label-plug (# 1 ele))))))
|
|
(setq bar-list (+ bar-list
|
|
(list (bar-make
|
|
(custom-plug-separator 10)
|
|
(custom-button-plug "Done" '(custom-done))
|
|
(custom-plug-separator 15)
|
|
(custom-button-plug "Cancel" '(custom-cancel))
|
|
(custom-plug-separator 10)))))
|
|
(with (property (+ (list 'descr descr
|
|
'hook hook
|
|
'immch custom-immediate-change) property)
|
|
borderpixel foreground)
|
|
(apply menu-make bar-list))))
|
|
|
|
(defun custom-menu _args_
|
|
(with (descr (mapfor _cele_ (# 0 _args_)
|
|
(if (not (member (type _cele_) '(string list)))
|
|
(list _cele_ ()
|
|
(or (with (res (custom-get-preference _cele_))
|
|
(if (and res (= (type res) 'string)) res ()))
|
|
(if (boundp _cele_) (list (eval _cele_)) ()))
|
|
() ())
|
|
(list () _cele_)))
|
|
xpos (if (= (type (# 1 _args_)) 'number) (# 1 _args_))
|
|
ypos (if (= (type (# 2 _args_)) 'number) (# 2 _args_))
|
|
mn ())
|
|
(if (and (not (# 0 (# 0 descr)))
|
|
(= (type (# 1 (# 0 descr))) 'list)
|
|
(= (type (# 0 (# 1 (# 0 descr)))) 'string))
|
|
(## 0 descr (list ()
|
|
(# 0 (# 1 (# 0 descr)))
|
|
(sublist 1 (length (# 1 (# 0 descr)))
|
|
(# 1 (# 0 descr))))))
|
|
(setq mn (custom-construct-menu descr))
|
|
(if mn
|
|
(with (reenter-on-opening ()
|
|
dim (dimensions mn)
|
|
x (max 10 (/ (- screen-width (# 2 dim)) 3))
|
|
y (max 10 (/ (- screen-height (# 3 dim)) 3)))
|
|
(if (and xpos ypos)
|
|
(place-menu 'custom mn xpos ypos)
|
|
(place-menu 'custom mn x y))))))
|
|
|
|
(defun custom-refresh-menu ()
|
|
(with (menuwob (custom-top-parent)
|
|
descr (# 'descr menuwob)
|
|
hook (# 'hook menuwob)
|
|
immch (# 'immch menuwob)
|
|
xpos (+ window-x window-client-x
|
|
(with (wob window) wob-borderwidth)
|
|
(with (wob menuwob) (- wob-borderwidth))
|
|
window-client-borderwidth)
|
|
ypos (+ window-y window-client-y
|
|
(with (wob window) wob-borderwidth)
|
|
(with (wob menuwob) (- wob-borderwidth))
|
|
window-client-borderwidth)
|
|
mn ())
|
|
(if (not (= immch custom-immediate-change))
|
|
(for sym descr
|
|
(if (and (# 0 sym) (# 4 sym))
|
|
(## 4 sym ()))))
|
|
(setq mn (custom-construct-menu descr))
|
|
(if mn
|
|
(with (reenter-on-opening ())
|
|
(delete-window window)
|
|
(place-menu 'custom mn xpos ypos)))))
|
|
|
|
(defun custom-save-file (file lst)
|
|
(with-output-to-file (+ file ":")
|
|
(? "(setq tmp '(\n")
|
|
(with (i 0)
|
|
(while (< i (length lst))
|
|
(? (custom-print-to-string (# i lst)) " "
|
|
(custom-print-to-string
|
|
(if (= (type (# (+ i 1) lst)) 'string)
|
|
(custom-substitute-in-string "\"" "\\\""
|
|
(# (+ i 1) lst))
|
|
(# (+ i 1) lst)))
|
|
"\n")
|
|
(setq i (+ i 2))))
|
|
(? "))\n"))
|
|
(! "sh" "-c" (+ "mv " file " " file "~ ; mv " file ": " file " ;"))
|
|
)
|
|
|
|
(defun custom-read-file (file)
|
|
(with (tmp 'magicatom)
|
|
(error-occurred
|
|
(load file))
|
|
(if (= tmp 'magicatom)
|
|
()
|
|
tmp)))
|
|
|
|
(defun custom-put-preference (var val)
|
|
(if (member var custom-global-preferences)
|
|
(## var custom-global-preferences val)
|
|
(setq custom-global-preferences
|
|
(+ custom-global-preferences
|
|
(list var val))))
|
|
(setq custom-preferences-changed t))
|
|
|
|
(defun custom-get-preference (var)
|
|
(# var custom-global-preferences))
|
|
|
|
(defun custom-apply-preferences (prefs)
|
|
(with (len (length prefs)
|
|
i 0
|
|
res ())
|
|
(while (< i len)
|
|
(if (= (type (# (+ i 1) prefs)) 'string)
|
|
(if (setq res (custom-read-from-string (# (+ i 1) prefs)))
|
|
(set (# i prefs) (# 0 res)))
|
|
(set (# i prefs) (# 0 (# (+ i 1) prefs))))
|
|
(setq i (+ i 2)))))
|
|
|
|
(defun custom-save-preferences ()
|
|
(if custom-preferences-changed
|
|
(custom-save-file custom-preference-file custom-global-preferences))
|
|
(setq custom-preferences-changed ()))
|
|
|
|
(defun custom-load-preferences ()
|
|
(setq custom-global-preferences (custom-read-file custom-preference-file))
|
|
(custom-apply-preferences custom-global-preferences)
|
|
(setq custom-preferences-changed ()))
|
|
|
|
(defun custom-insert-symbols (lst syms)
|
|
(with (len (length lst)
|
|
i (- len 1)
|
|
syms (copy syms)
|
|
s1 ()
|
|
s2 ())
|
|
(while (and (> i 0) (= (type (# i lst)) 'list))
|
|
(setq i (- i 1)))
|
|
(setq s1 (sublist 0 (+ i 1) lst))
|
|
(setq s2 (sublist (+ i 1) len lst))
|
|
(setq i (- (length syms) 1))
|
|
(while (> i -1)
|
|
(if (member (# i syms) s1)
|
|
(delete-nth i syms))
|
|
(setq i (- i 1)))
|
|
(+ s1 syms s2)))
|
|
|
|
(defun custom-insert-hook (head hook)
|
|
(if (not (= (type head) 'list))
|
|
(list head 'hook hook)
|
|
(not (member 'hook head))
|
|
(+ head (list 'hook hook))
|
|
(with (oh (# 'hook head))
|
|
(## 'hook head
|
|
(if (not oh)
|
|
hook
|
|
(and (= (type oh) 'list) (= (# 0 oh) 'progn))
|
|
(+ oh (list hook))
|
|
(list 'progn oh hook))))))
|
|
|
|
(defun custom-find-name (lst name)
|
|
(with (len (length lst)
|
|
i 1)
|
|
(while (and (< i len)
|
|
(not (and (= (type (# i lst)) 'list)
|
|
(or (and (= (type (# 0 (# i lst))) 'string)
|
|
(= (# 0 (# i lst)) name))
|
|
(and (= (type (# 0 (# i lst))) 'list)
|
|
(= (type (# 0 (# 0 (# i lst)))) 'string)
|
|
(= (# 0 (# 0 (# i lst))) name))))))
|
|
(setq i (+ i 1)))
|
|
(if (< i len)
|
|
i
|
|
())))
|
|
|
|
(defun custom-install-symbols (name syms)
|
|
(if (not name)
|
|
(setq custom-global-menu-descr
|
|
(custom-insert-symbols custom-global-menu-descr syms))
|
|
(with (name (if (not (= (type name) 'list)) (list name) name)
|
|
len (length name)
|
|
i 0
|
|
lst1 ()
|
|
pos1 ()
|
|
lst custom-global-menu-descr
|
|
pos ())
|
|
(while (< i len)
|
|
(setq pos (custom-find-name lst (# i name)))
|
|
(if (not pos)
|
|
(progn
|
|
(if pos1
|
|
(## pos1 lst1 (setq lst (+ lst (list (list (# i name))))))
|
|
(setq lst (setq custom-global-menu-descr
|
|
(+ custom-global-menu-descr
|
|
(list (list (# i name)))))))
|
|
(setq pos (- (length lst) 1))))
|
|
(setq pos1 pos)
|
|
(setq lst1 lst)
|
|
(setq lst (# pos1 lst1))
|
|
(setq i (+ i 1)))
|
|
(## pos1 lst1 (custom-insert-symbols lst syms)))))
|
|
|
|
(defun custom-install-hook (name hook)
|
|
(if (not name)
|
|
(## 0 custom-global-menu-descr
|
|
(custom-insert-hook (# 0 custom-global-menu-descr) hook))
|
|
(with (name (if (not (= (type name) 'list)) (list name) name)
|
|
len (length name)
|
|
i 0
|
|
lst1 ()
|
|
pos1 ()
|
|
lst custom-global-menu-descr
|
|
pos ())
|
|
(while (< i len)
|
|
(setq pos (custom-find-name lst (# i name)))
|
|
(if (not pos)
|
|
(progn
|
|
(if pos1
|
|
(## pos1 lst1 (setq lst (+ lst (list (list (# i name))))))
|
|
(setq lst (setq custom-global-menu-descr
|
|
(+ custom-global-menu-descr
|
|
(list (list (# i name)))))))
|
|
(setq pos (- (length lst) 1))))
|
|
(setq pos1 pos)
|
|
(setq lst1 lst)
|
|
(setq lst (# pos1 lst1))
|
|
(setq i (+ i 1)))
|
|
(## 0 lst (custom-insert-hook (# 0 lst) hook)))))
|
|
|
|
(defun custom-global-menu ()
|
|
(custom-menu custom-global-menu-descr))
|
|
|
|
|
|
;; Now, let this package install itself
|
|
(custom-install-symbols "custom-menu"
|
|
'(custom-font
|
|
custom-symbol-font
|
|
custom-value-font
|
|
custom-value-font-slant
|
|
custom-foreground
|
|
custom-background
|
|
custom-button-background
|
|
custom-value-background
|
|
custom-value-frame
|
|
custom-immediate-feedback
|
|
custom-immediate-change
|
|
custom-keep-comma-string)
|
|
)
|
|
|
|
(custom-install-hook "custom-menu" '(custom-refresh-menu))
|
|
|