summaryrefslogtreecommitdiff
path: root/elpa/auctex-13.1.3/toolbar-x.el
diff options
context:
space:
mode:
authormattkae <mattkae@protonmail.com>2022-05-17 07:07:37 -0400
committermattkae <mattkae@protonmail.com>2022-05-17 07:07:37 -0400
commitbecff06c71d277647eda4378203d03ab36e141eb (patch)
treea1f73bba3676f34e0faf76764f5de963321f5576 /elpa/auctex-13.1.3/toolbar-x.el
parent3f4a0d5370ae6c34afe180df96add3b8522f4af1 (diff)
Evil mode and latex support
Diffstat (limited to 'elpa/auctex-13.1.3/toolbar-x.el')
-rw-r--r--elpa/auctex-13.1.3/toolbar-x.el1565
1 files changed, 1565 insertions, 0 deletions
diff --git a/elpa/auctex-13.1.3/toolbar-x.el b/elpa/auctex-13.1.3/toolbar-x.el
new file mode 100644
index 0000000..d97035f
--- /dev/null
+++ b/elpa/auctex-13.1.3/toolbar-x.el
@@ -0,0 +1,1565 @@
+;;; toolbar-x.el --- fancy toolbar handling in Emacs -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2004-2022 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 3 of
+;; the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be
+;; useful, but WITHOUT ANY WARRANTY; without even the implied
+;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;; PURPOSE. See the GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public
+;; License along with this program; if not, write to the Free
+;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+;; MA 02110-1301 USA
+
+;;; Author: Miguel Vinicius Santini Frasson
+
+;;; Commentary:
+;; This program implements a common interface to display toolbar
+;; buttons. A toolbar should be basically
+;; defined by a image and a command to run when the button is pressed,
+;; and additional properties could be added. This is the idea of this
+;; program. See the documentation of function
+;; `toolbarx-install-toolbar' for a description of how to specify
+;; toolbars.
+
+;;; Features:
+
+;; * Button properties are given in the toolbar definition (BUTTON
+;; paramenter in `toolbarx-install-toolbar') and/or in an alist with
+;; associates the symbol with properties (MEANING-ALIST paramenter in
+;; `toolbarx-install-toolbar').
+
+;; * Supported properties:
+;; - `:insert', `:image', `:command', `:help', `:enable',
+;; `:append-command', `:prepend-command',
+;; `:visible' and `:button';
+;; For the precise value-type for each property, see documentation of
+;; the function `toolbarx-install-toolbar'.
+;; (ps: properties that are particular to an editor are just ignored
+;; the other editor flavour.)
+
+;; * Properties can have value specified by function (with no
+;; argument) or variables that evaluate to an object of the correct
+;; type for a particular property. The evaluation is done when the
+;; roolbar is refresh (a call of `toolbarx-refresh'.)
+;; (ps: this is valid only for properties that *not* have \`form\' as
+;; value type.)
+
+;; * On `refresh time' (a call `toolbarx-refresh', necessary when the
+;; toolbar should change), the `:insert' property (if present) is
+;; evaluated to decide if button will be displayed.
+
+;; Properties can be distributed to several buttons, using \`groups\'.
+;; Example: (foo (bar baz :enable (mytest)) :help "please")
+;; means that `foo', `bar' and `baz' have `:help "please"' and `bar' and
+;; `baz' have the property `:enable (mytest)'.
+
+;; * (Part of) the toolbar definition can be stored in a variable,
+;; evaluated in `installation time'. See `:eval-group' on the
+;; documentation of the function `toolbarx-install-toolbar'.
+
+;; * It is possible to define sets of buttons that appear according to
+;; an option selected in a dropdown menu. See `:dropdown-group' on
+;; the documentation of the function `toolbarx-install-toolbar'.
+
+;;; Rough description of the implementation
+;; There are 2 \`engines\' implemented:
+
+;; == the 1st one (parsing) parses the toolbar definition
+;; independently of editor flavour and store the parsed buttons with
+;; their properties, in the same order that they appear in the
+;; definitions, in a variable `toolbarx-internal-button-switches';
+
+;; == the 2nd one (refresh for Emacs) inserts buttons in the Emacs
+;; toolbar in the same order that they appear in the definitions;
+;; if a (real) button does not have at least (valid) image
+;; and command properties, they are silently ignored;
+
+;;; History:
+
+;; This program was motivated by the intention of implementation of a
+;; good toolbar for AUCTeX, that would work in both Emacs and XEmacs.
+;; Since toolbars were very different in behaviour and implementation
+;; (for instance, in Emacs one can display as many toolbar buttons as
+;; wanted, because it becomes mult-line, and in XEmacs, there is one
+;; line, but toolbars and all sides of a frame.)
+
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl-lib))
+
+;; Note that this just gives a useful default. Icons are expected to
+;; be in subdirectory "images" or "toolbar" relative to the load-path.
+;; Packages loading toolbarx are advised to explicitly add their own
+;; searchpath with add-to-list here even when they fulfill that
+;; criterion: another package might have loaded toolbar-x previously
+;; when load-path was not yet correctly set. The default setting
+;; really caters only for toolbar-x' stock icons.
+
+(defvar toolbarx-image-path
+ (nconc
+ (delq nil (mapcar #'(lambda(x)
+ (and x
+ (member
+ (file-name-nondirectory
+ (directory-file-name x))
+ '("toolbar" "images"))
+ ;;(file-directory-p x)
+ x))
+ load-path))
+ (list data-directory))
+ "List of directories where toolbarx finds its images.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; First engine: Parsing buttons
+
+;; it obtains button information, process it and stores result in
+;; `toolbarx-internal-button-switches', which is a list with 1st
+;; element the symbol `:switches', the 2nd element as a list of
+;; processed buttons, and the 3rd element is used for Emacs to store
+;; the keys used in ``constant'' buttons.
+
+;; The 2nd element of `toolbarx-internal-button-switches' is a list
+;; where each element is either:
+;; * a button-list, that is, a list with elements to define a button.
+;; * a list where 1st elem is `:insert' and 2nd is a form, and the
+;; following elements are in the same format of the 2nd element of
+;; `toolbarx-internal-button-switches'.
+
+(defun toolbarx-make-string-from-symbol (symbol)
+ "Return a string from the name of a SYMBOL.
+Upcase initials and replace dashes by spaces."
+ (let* ((str (upcase-initials (symbol-name symbol)))
+ (str2))
+ (dolist (i (append str nil))
+ (if (eq i 45) ; if dash, push space
+ (push 32 str2)
+ (push i str2))) ; else push identical
+ (concat (nreverse str2))))
+
+(defun toolbarx-make-symbol-from-string (string)
+ "Return a (intern) symbol from STRING.
+Downcase string and replace spaces by dashes."
+ (let* ((str1 (append (downcase string) nil))
+ (str2))
+ (dolist (i str1)
+ (if (eq i 32) ; if dash, push space
+ (push 45 str2)
+ (push i str2)))
+ (intern (concat (nreverse str2)))))
+
+(defun toolbarx-good-option-list-p (option-list valid-options)
+ "Non-nil means the OPTION-LIST is of form (OPT FORM ... OPT FORM).
+Each OPT is member of VALID-OPTIONS and OPT are pairwise
+different. OPTION-LIST equal to nil is a good option list."
+ (let ((elt-in-valid t)
+ (temp-opt-list option-list)
+ (list-diff)
+ (n (/ (length option-list) 2)))
+ (dotimes (i n)
+ (when (> i 0)
+ (setq temp-opt-list (cddr temp-opt-list)))
+ (cl-pushnew (car temp-opt-list) list-diff :test #'equal)
+ (setq elt-in-valid (and elt-in-valid
+ (memq (car temp-opt-list)
+ valid-options))))
+ (and elt-in-valid ; options are on VALID-OPTOPNS
+ ;; OPTION-LIST has all option different from each other
+ (eq (length list-diff) n)
+ ;; OPTION-LIST has even number of elements
+ (eq (% (length option-list) 2) 0))))
+
+(defun toolbarx-separate-options (group-list valid-options &optional check)
+ "Return a cons cell with non-options and options of GROUP-LIST.
+The options-part is the largest tail of the list GROUP-LIST that
+has an element of VALID-OPTIONS (the comparation is made with
+`memq'.) The non-options-part is the beginning of GROUP-LIST
+less its tail. Return a cons cell which `car' is the
+non-options-part and the `cdr' is the options-part.
+
+If CHECK is non-nil, the tail is the largest that yield non-nil
+when applied to `toolbarx-good-option-list-p'."
+ (let ((maximal)
+ (temp))
+ (dolist (i valid-options)
+ (setq temp (memq i group-list))
+ (when (and (> (length temp) (length maximal))
+ (if check
+ (toolbarx-good-option-list-p temp valid-options)
+ t))
+ (setq maximal (memq i group-list))))
+ (cons (butlast group-list (length maximal)) maximal)))
+
+
+(defun toolbarx-merge-props (inner-props outer-props override add)
+ "Merge property lists INNER-PROPS and OUTER-PROPS.
+INNER-PROPS and OUTER-PROPS are two lists in the format
+ (PROP VAL PROP VAL ... PROP VAL).
+Returns a list with properties and values merged.
+
+OVERRIDE and ADD are supposed to be lists of symbols. The value
+of a property in OVERRIDE is the one on OUTER-PROPS or
+INNER-PROPS, but if the property is in both, the value in
+INNER-PROPS is used. The value of a property in ADD will be a
+list with first element the symbol `:add-value-list' and the rest
+are the properties, inner properties first."
+ (let* ((merged)
+ (inner-prop)
+ (outer-prop))
+ (dolist (prop override)
+ (if (memq prop inner-props)
+ (setq merged (append merged
+ (list prop (cadr (memq prop inner-props)))))
+ (when (memq prop outer-props)
+ (setq merged (append merged
+ (list prop (cadr (memq prop outer-props))))))))
+ (dolist (prop add merged)
+ (setq inner-prop (memq prop inner-props))
+ (when inner-prop
+ (if (and (listp (cadr inner-prop))
+ (eq (car (cadr inner-prop)) :add-value-list))
+ (setq inner-prop (cdr (cadr inner-prop)))
+ (setq inner-prop (list (cadr inner-prop)))))
+ (setq outer-prop (memq prop outer-props))
+ (when outer-prop
+ (if (and (listp (cadr outer-prop))
+ (eq (car (cadr outer-prop)) :add-value-list))
+ (setq outer-prop (cdr (cadr outer-prop)))
+ (setq outer-prop (list (cadr outer-prop)))))
+ (when (append inner-prop outer-prop)
+ (setq merged (append merged
+ (list prop (cons :add-value-list
+ (append inner-prop
+ outer-prop)))))))))
+
+(defun toolbarx-make-command (comm prep app)
+ "Return a command made from COMM, PREP and APP.
+COMM is a command or a form. PREP and APP are forms. If PREP or
+APP are non-nil, they are added to the resulting command at the
+beginning and end, respectively. If both are nil and COMM is a
+command, COMM is returned."
+ (let ((comm-is-command (commandp comm)))
+ (if (and (not prep)
+ (not app)
+ comm-is-command)
+ comm
+ (lambda () (interactive)
+ (let (result)
+ (when prep (setq result (eval prep t)))
+ (when comm (setq result
+ (if comm-is-command
+ (call-interactively comm)
+ (eval comm t))))
+ (when app (setq result (eval app t)))
+ result)))))
+
+(defun toolbarx-emacs-mount-popup-menu
+ (strings var type &optional title save)
+ "Return an interactive `lambda'-expression that shows a popup menu.
+This function is the action of `toolbarx-mount-popup-menu' if
+inside Emacs. See documentation of that function for more."
+ ;; making the menu keymap by adding each menu-item definition
+ ;; see (info "(elisp)Menu keymaps")
+ (let* ((keymap (make-sparse-keymap title))
+ (count 1)
+ (used-symbols '(nil))
+ (key)
+ (real-type
+ (pcase type
+ ((or `toggle `radio) type)
+ ;; Warn if type is not `radio' or `toggle'.
+ (_ (display-warning 'toolbarx
+ (format "TYPE should be symbols `radio' or `toggle', but %s found; using `radio'"
+ type))
+ ;; Use `radio' if incorrect.
+ 'radio)))
+ (real-save
+ (pcase save
+ ((or `nil `offer `always) save)
+ ;; Warn if save is not `nil', `offer' or ;; `always'.
+ (_ (display-warning 'toolbarx
+ (format "SAVE should be symbols `nil', `offer' or `always', but %s found; using `nil'"
+ save))
+ ;; Use nil when incorrect.
+ nil))))
+ (dolist (i strings)
+ ;; finding a new symbol
+ (let* ((aux-count 0)
+ (i-symb (toolbarx-make-symbol-from-string i)))
+ (setq key i-symb)
+ (while (memq key used-symbols)
+ (setq aux-count (1+ aux-count))
+ (setq key (intern (format "%s-%d" i-symb aux-count))))
+ (setq used-symbols (cons key used-symbols)))
+ (define-key-after keymap (vector key)
+ `(menu-item ,i
+ ,(let ((count count))
+ (lambda () (interactive)
+ (set var
+ (if (eq real-type 'radio)
+ count
+ (if (memq count (symbol-value var))
+ (delete count (symbol-value var))
+ (sort (cons count (symbol-value var)) #'<))))
+ (toolbarx-refresh)
+ (when (eq real-save 'always)
+ (customize-save-variable var (symbol-value var)))
+ (symbol-value var)))
+ :button ,(if (eq real-type 'radio)
+ `(:radio eq ,var ,count)
+ `(:toggle memq ,count ,var))))
+ (setq count (1+ count)))
+ (when (eq real-save 'offer)
+ (define-key-after keymap [sep] '(menu-item "--shadow-etched-in-dash"))
+ (let* ((aux-count 0)
+ (i-symb 'custom-save))
+ (setq key i-symb)
+ (while (memq key used-symbols)
+ (setq aux-count (1+ aux-count))
+ (setq key (intern (format "%s-%d" i-symb aux-count))))
+ (setq used-symbols (cons key used-symbols)))
+ (define-key-after keymap (vector key)
+ `(menu-item "Save state of this menu"
+ (lambda nil (interactive)
+ (customize-save-variable (quote ,var) ,var)))))
+ ;; returns a `lambda'-expression
+ (lambda () (interactive) (popup-menu keymap))))
+
+(defun toolbarx-mount-popup-menu (strings var type &optional title save)
+ "Return a command that show a popup menu.
+The return is a `lambda'-expression with a interactive declaration.
+
+STRINGS is a list of strings which will be the itens of the menu.
+
+VAR is a symbol that is set when an item is clicked. TYPE should
+be one of the symbols `radio' or `toggle': `radio' means that the
+nth item is selected if VAR is `n' and this item sets VAR to `n';
+`toggle' means that VAR should be a list of integers and the nth
+item is selected if `n' belongs to VAR. The item inserts or
+deletes `n' from VAR.
+
+TITLE is a string (the title of the popup menu) or nil for no
+title.
+
+SAVE is one of the symbols nil, `offer' or `always'. If value
+is nil, do not try to save anything. If it is `offer', a menu
+item is added offering the user the possibiity to save state of
+that dropdown menu for future sesseions (using `custom'). If it
+is `always', state is saved every time that a item is clicked."
+ (toolbarx-emacs-mount-popup-menu strings var type title save))
+
+(defun toolbarx-option-value (opt)
+ "If OPT is a vector, return first element, otherwise, return OPT.
+If OPT is vector and length is smaller than the necessary, then
+nil is returned."
+ ;; FIXME: This is backward compatibility for when we supported XEmacs
+ ;; and entries could take the shape [FOO BAR] where FOO was the
+ ;; value to use for Emacs and BAR the value to use for XEmacs.
+ ;; This is unused since Mar 2021.
+ (if (vectorp opt)
+ (when (> (length opt) 0)
+ (aref opt 0))
+ opt))
+
+(defun toolbarx-eval-function-or-symbol (object type-test-func)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ non-nil means that VAL is a valid value, according to
+the car of the result of TYPE-TEST-FUNCTION, that should return a
+cons cell in the same format as the return of this function.
+
+If OBJECT applied to TYPE-TEST-FUNC return (GOOD-OBJ . VAL), and
+GOOD-OBJ is non-nil, return that. Else, check if OBJECT is a
+function. If so, evaluate and test again with TYPE-TEST-FUNC. If
+not a function or if GOOD-OBJ is again nil, test if OBJECT is a
+bound symbol, evaluate that and return the result of
+TYPE-TEST-FUNC."
+ (let* ((ret (funcall type-test-func object)))
+ (unless (car ret)
+ (if (functionp object)
+ (progn
+ (setq ret (funcall type-test-func (funcall object)))
+ (unless (car ret)
+ (when (and (symbolp object) (boundp object))
+ (setq ret (funcall type-test-func (symbol-value object))))))
+ ;; ok, obj is not function; try symbol
+ (when (and (symbolp object) (boundp object))
+ (setq ret (funcall type-test-func (symbol-value object))))))
+ ret))
+
+(defun toolbarx-test-image-type (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid image object VAL (see
+documentation of function `toolbarx-process-symbol')."
+ (let ((toolbarx-test-image-type-simple
+ (lambda (img)
+ (let* ((val (toolbarx-option-value img))
+ (all-obj-ok t)
+ (good-obj
+ (or (stringp val) ; string
+ (eq (car-safe val) 'image) ; or image descriptor
+ (and (symbolp val) ; or a symbol bound to a
+ (boundp val) ; image descriptor
+ ; (defined with `defimage')
+ (consp (symbol-value val))
+ (eq (car (symbol-value val)) 'image))
+ (and (listp val) ; or list with 4 strings or
+ ; image descriptors
+ (= (length val) 4)
+ (dolist (i val all-obj-ok)
+ (setq all-obj-ok
+ (and all-obj-ok
+ (or (stringp i)
+ (eq (car-safe i) 'image)))))))))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-image-type-simple)))
+
+(defun toolbarx-test-button-type (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid button object VAL (see
+documentation of function `toolbarx-process-symbol')."
+ (let ((toolbarx-test-button-type-simple
+ (lambda (but)
+ (let* ((val (toolbarx-option-value but))
+ (good-obj
+ (and (consp val)
+ (memq (car val) '(:toggle :radio)))))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-button-type-simple)))
+
+(defun toolbarx-test-any-type (obj)
+ "Return a cons cell (t . VAL).
+If OBJ is vector, return VAL according to editor. Else, return
+OBJ, because it is a form anyway."
+ (cons t (toolbarx-option-value obj)))
+
+(defun toolbarx-test-string-or-nil (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid help object VAL (see
+documentation of function `toolbarx-process-symbol')."
+ (let ((toolbarx-test-string-or-nil-simple
+ (lambda (obj)
+ (let* ((val (toolbarx-option-value obj))
+ (good-obj (or (stringp val)
+ (not val))))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-string-or-nil-simple)))
+
+(defun toolbarx-test-toolbar-type (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid toolbar property object
+VAL (see documentation of function `toolbarx-process-symbol')."
+ (let ((toolbarx-test-toolbar-type-simple
+ (lambda (obj)
+ (let* ((val (toolbarx-option-value obj))
+ ;; (all-but-def-opts '(top bottom left right))
+ ;; (all-opts '(default top bottom left right))
+ ;; (good-obj t)
+ )
+ (cons t val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-toolbar-type-simple)))
+
+(defun toolbarx-test-dropdown-type (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid `:type' property object
+VAL of a dropdown group (see documentation of function
+`toolbarx-process-dropdown-group'."
+ (let ((toolbarx-test-dropdown-type-simple
+ (lambda (obj)
+ (let* ((val (toolbarx-option-value obj))
+ (good-obj (memq val '(radio toggle))))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-dropdown-type-simple)))
+
+(defun toolbarx-test-symbol (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid `:variable' property
+object VAL of a dropdown group (see documentation of function
+`toolbarx-process-dropdown-group'."
+ (let ((toolbarx-test-symbol-simple
+ (lambda (obj)
+ (let* ((val (toolbarx-option-value obj))
+ (good-obj (symbolp val)))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-symbol-simple)))
+
+(defun toolbarx-test-dropdown-default (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid `:default' property
+object VAL of a dropdown group (see documentation of function
+`toolbarx-process-dropdown-group'."
+ (let ((toolbarx-test-dropdown-default-simple
+ (lambda (obj)
+ (let* ((val (toolbarx-option-value obj))
+ (good-obj (or (integerp val)
+ (and (listp val)
+ (let ((ok t))
+ (dolist (i val ok)
+ (setq ok (and ok (integerp i)))))))))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj
+ toolbarx-test-dropdown-default-simple)))
+
+(defun toolbarx-test-dropdown-save (obj)
+ "Return a cons cell (GOOD-OBJ . VAL).
+GOOD-OBJ is non-nil if OBJ yields a valid `:save' property
+object VAL of a dropdown group (see documentation of function
+`toolbarx-process-dropdown-group'."
+ (let ((toolbarx-test-dropdown-save-simple
+ (lambda (obj)
+ (let* ((val (toolbarx-option-value obj))
+ (good-obj (memq val '(nil offer always))))
+ (cons good-obj val)))))
+ (toolbarx-eval-function-or-symbol obj toolbarx-test-dropdown-save-simple)))
+
+(defconst toolbarx-button-props
+ (let* ((props-types-alist
+ '((:image toolbarx-test-image-type)
+ (:command toolbarx-test-any-type)
+ (:enable toolbarx-test-any-type)
+ (:visible toolbarx-test-any-type)
+ (:help toolbarx-test-string-or-nil)
+ (:insert toolbarx-test-any-type . and)
+ ;; (:toolbar toolbarx-test-toolbar-type)
+ (:button toolbarx-test-button-type)
+ (:append-command toolbarx-test-any-type . progn)
+ (:prepend-command toolbarx-test-any-type . progn)))
+ (possible-props (nreverse (let* ((props ()))
+ (dolist (p props-types-alist props)
+ (setq props (cons (car p) props))))))
+ (props-override (nreverse (let* ((props ()))
+ (dolist (p props-types-alist props)
+ (unless (cddr p)
+ (setq props (cons (car p) props)))))))
+ (props-add (nreverse (let* ((props ()))
+ (dolist (p props-types-alist props)
+ (when (cddr p)
+ (setq props (cons (car p) props))))))))
+ (list props-types-alist possible-props props-override props-add))
+ "List yielding all encarnations of properties of a button.
+First element: alist, where each element is of form
+ (PROP . (TYPE-TEST-FUNCTION . ADD-OR-NIL))
+Second is a list with all properties.
+Third, a list with properties that override when merging.
+Fourth, a list of lists, each in the format (PROP ADD).")
+
+(defconst toolbarx-dropdown-props
+ ;; for naming dropdown properties see `Convention' in the doc string
+ (let* ((props-types-alist
+ '((:type toolbarx-test-dropdown-type)
+ (:variable toolbarx-test-symbol)
+ (:default toolbarx-test-dropdown-default)
+ (:save toolbarx-test-dropdown-save)
+ (:title toolbarx-test-string-or-nil)
+ (:dropdown-image toolbarx-test-image-type)
+ (:dropdown-enable toolbarx-test-any-type)
+ (:dropdown-visible toolbarx-test-any-type)
+ (:dropdown-insert toolbarx-test-any-type . and)
+ (:dropdown-help toolbarx-test-string-or-nil)
+ ;; (:dropdown-toolbar toolbarx-test-toolbar-type)
+ (:dropdown-append-command toolbarx-test-any-type . progn)
+ (:dropdown-prepend-command toolbarx-test-any-type . progn)))
+ (possible-props (nreverse (let* ((props ()))
+ (dolist (p props-types-alist props)
+ (setq props (cons (car p) props))))))
+ (props-override (nreverse (let* ((props ()))
+ (dolist (p props-types-alist props)
+ (unless (cddr p)
+ (setq props (cons (car p) props)))))))
+ (props-add (nreverse (let* ((props ()))
+ (dolist (p props-types-alist props)
+ (when (cddr p)
+ (setq props (cons (car p) props))))))))
+ (list props-types-alist possible-props props-override props-add))
+ "List yielding all encarnations of properties of a dropdown group.
+First element: alist, where each element is of form
+ (PROP . (TYPE-TEST-FUNCTION . ADD-OR-NIL))
+Second is a list with all properties.
+Third, a list with properties that override when merging.
+Fourth, a list of lists, each in the format (PROP ADD).
+
+Convention: properties for the dropdown button should be formed
+with the strings \":dropdown-\" with the button property name
+without `:'. This is used on the implementation.")
+
+(defun toolbarx-process-group-without-insert (group-without-props
+ merged-props-without-insert
+ meaning-alist switches)
+ "Return an updated version of SWITCHES.
+GROUP-WITHOUT-PROPS and MERGED-PROPS-WITHOUT-INSERT are
+preprocessed variables in `toolbarx-process-group'."
+ (let ((current-switches switches))
+ (dolist (i group-without-props current-switches)
+ (setq i (toolbarx-option-value i))
+ (if (symbolp i)
+ (setq current-switches
+ (toolbarx-process-symbol i meaning-alist
+ merged-props-without-insert
+ current-switches))
+ (when (listp i)
+ (setq current-switches
+ (toolbarx-process-group i meaning-alist
+ merged-props-without-insert
+ current-switches)))))))
+
+(defun toolbarx-process-group (group meaning-alist props switches)
+ "Return an updated version of SWITCHES.
+Append to already processed buttons (stored in SWITCHES) a
+processed version of GROUP. Groups are useful to distribute
+properties. External properties are given in PROPS, and merged
+with the internal properties that are in the end of GROUP. If
+properties (after merge) contain a `:insert' property, return a
+list where the first and second elements are `:insert' and its
+value, and after that a list in the same format as SWITCHES."
+ (cond
+ ;; if DROPDOWN group
+ ((eq (car group) :dropdown-group)
+ (toolbarx-process-dropdown-group group meaning-alist props switches))
+ ;; if EVAL group
+ ((eq (car group) :eval-group)
+ (let ((current-switches switches))
+ (dolist (elt (cdr group) current-switches)
+ (let ((eval-elt (eval elt t)))
+ (setq current-switches
+ (toolbarx-process-group (if (listp eval-elt)
+ eval-elt
+ (list eval-elt))
+ meaning-alist props
+ current-switches))))))
+ ;; if normal group
+ (t
+ (let* ((splited-props
+ (toolbarx-separate-options
+ group (append (nth 1 toolbarx-button-props)
+ (nth 1 toolbarx-dropdown-props))))
+ (intern-props (cdr splited-props))
+ (group-without-props (car splited-props))
+ (merged-props
+ (toolbarx-merge-props intern-props props
+ (append (nth 2 toolbarx-button-props)
+ (nth 2 toolbarx-dropdown-props))
+ (append (nth 3 toolbarx-button-props)
+ (nth 3 toolbarx-dropdown-props)))))
+ ;; check whether merged props have an `:insert'
+ (if (memq :insert merged-props)
+ ;; if yes, prepend switches with a (:insert cond elements)
+ (let* ((memq-ins (memq :insert merged-props))
+ (ins-val (if (and (listp (cadr memq-ins))
+ (eq :add-value-list
+ (car (cadr memq-ins))))
+ ;; if property is add-value property
+ (let* ((p (assq
+ :insert
+ (nth 0 toolbarx-button-props)))
+ (add-list (list (cddr p)))
+ (prop-good-val))
+ (dolist (val (cdr (cadr memq-ins)))
+ (setq prop-good-val (funcall (cadr p) val))
+ (when (car prop-good-val)
+ (setq add-list (cons (cdr prop-good-val)
+ add-list))))
+ ;; return: (nreverse add-list)
+ (setq add-list (nreverse add-list))
+ (if (eq 2 (length add-list))
+ (cadr add-list) ; just 1 value, no
+ add-list)) ; add-function
+ ;; if property is not add-value
+ (cadr memq-ins)))
+ (merged-props-without-insert
+ (append (butlast merged-props (length memq-ins))
+ (cddr memq-ins)))
+ (group-switches
+ (toolbarx-process-group-without-insert
+ group-without-props merged-props-without-insert
+ meaning-alist nil)))
+ ;; return
+ (nreverse (cons (append (list :insert ins-val)
+ group-switches)
+ (nreverse switches))))
+ ;; if not, just append what is processed to switches
+ (toolbarx-process-group-without-insert group-without-props
+ merged-props meaning-alist
+ switches))))))
+
+(defun toolbarx-process-symbol (symbol meaning-alist props switches)
+ "Process a button given by SYMBOL in MEANING-ALIST.
+The processed button is appended in SWITCHES, which is returned.
+Look for a association of SYMBOL in MEANING-ALIST for collecting
+properties. Such association is a list that represents either a
+normal button (a description of the button) or an alias
+group (the symbol is an alias for a group of buttons). PROPS is
+a externel list of properties that are merged and then applied to
+the button. Scope is given by GLOBAL-FLAG."
+ ;; there are 3 situations: symbol is :new-line, there is an alias group
+ ;; or a normal button
+ (let ((button-assq (cdr (assq symbol meaning-alist))))
+ (cond
+ ((eq (car button-assq) :alias)
+ ;; button association is ALIAS GROUP is passed to
+ ;; `toolbarx-process-group' as is but without the car.
+ ;; return: (toolbarx-process-group... returns updates switch
+ (toolbarx-process-group (cdr button-assq) meaning-alist props switches))
+ (t
+ ;; NORMAL BUTTON (association is a list of properties)
+ ;;
+ ;; properties need to be processed, that is, merge internal
+ ;; and external (given by PROPS) properties
+ (let* (;; button properties defined in `toolbarx-button-props'
+ (props-override (nth 2 toolbarx-button-props))
+ (props-add (nth 3 toolbarx-button-props))
+ ;; split considering also dropdown-group properties
+ (button-assq-split
+ (toolbarx-separate-options
+ button-assq
+ (append (nth 1 toolbarx-button-props)
+ (nth 1 toolbarx-dropdown-props))))
+ (button-split-no-props (car button-assq-split))
+ (button-split-props (cdr button-assq-split))
+ ;; if there is no :image or :command in the props,
+ ;; try to get them from no-props part
+ (button-image-no-prop
+ (unless (memq :image button-split-props)
+ (when (> (length button-split-no-props) 0)
+ (list :image (nth 0 button-split-no-props)))))
+ (button-command-no-prop
+ (unless (memq :command button-split-props)
+ (when (> (length button-split-no-props) 1)
+ (list :command (nth 1 button-split-no-props)))))
+ (button-props (append button-split-props
+ button-image-no-prop
+ button-command-no-prop))
+ ;; merge props
+ (merged-props (toolbarx-merge-props button-props props
+ props-override
+ props-add)))
+ ;; return:
+ (nreverse (cons (cons symbol merged-props) (nreverse switches))))))))
+
+(defun toolbarx-process-dropdown-group (dropdown meaning-alist props switches)
+ "Process buttons that appear according to dropdown menu.
+Process a dropdown group DROPDOWN with meaning alist
+MEANING-ALIST, external property list PROP and GLOBAL-FLAG
+specifying scope. For a complete description, see documentation
+of `toolbarx-install-toolbar'. The processed buttons are stored
+in the end of SWITCHES, which is returned."
+ (let* ((dropdown-group (if (eq (car dropdown) :dropdown-group)
+ (cdr dropdown)
+ dropdown))
+ (dropdown-list-splited
+ (toolbarx-separate-options dropdown-group
+ (append
+ (nth 1 toolbarx-button-props)
+ (nth 1 toolbarx-dropdown-props))))
+ (dropdown-list (car dropdown-list-splited))
+ (dropdown-props (cdr dropdown-list-splited))
+ (merged-props
+ (toolbarx-merge-props dropdown-props props
+ (append (nth 2 toolbarx-button-props)
+ (nth 2 toolbarx-dropdown-props))
+ (append (nth 3 toolbarx-button-props)
+ (nth 3 toolbarx-dropdown-props))))
+ (merged-props-button-only
+ (let* ((props-button-only)
+ (prop))
+ (dolist (p (nth 1 toolbarx-button-props) props-button-only)
+ (setq prop (memq p merged-props))
+ (when prop
+ (setq props-button-only
+ (append (list p (cadr prop))
+ props-button-only))))))
+ (merged-props-dropdown-only
+ (let* ((props-dropdown-only)
+ (prop))
+ (dolist (p (nth 1 toolbarx-dropdown-props) props-dropdown-only)
+ (setq prop (memq p merged-props))
+ (when prop
+ (setq props-dropdown-only
+ (append (list p (cadr prop))
+ props-dropdown-only))))))
+ ;; get value for each property and check type ONLY for props that do
+ ;; not concern the dropdown button, like `:type', `:save', etc. The
+ ;; props that concern the button are going to be handled in refresh
+ ;; time.
+ (filtered-dropdown-group-props-only
+ (let* ((filtered-props-temp)
+ (prop-good-val)
+ (prop))
+ (save-match-data
+ (dolist (p (nth 0 toolbarx-dropdown-props) filtered-props-temp)
+ (unless (string-match "^:dropdown-.*$"
+ (symbol-name (car p)))
+ ;; property -> (car p)
+ ;; test type function -> (cadr p)
+ (setq prop (memq (car p) merged-props-dropdown-only))
+ ;; if so, check if value is of correct type
+ (when prop
+ (setq prop-good-val (funcall (cadr p) (cadr prop)))
+ (if (car prop-good-val)
+ (setq filtered-props-temp
+ (append filtered-props-temp
+ (list (car p) (cdr prop-good-val))))
+ (display-warning
+ 'toolbarx
+ (format (concat "Wrong type for value in "
+ "property `%s' in dropdown group")
+ (car p))))))))))
+ ;; properties for the dropdown button from dropdown merged properties
+ (dropdown-button-props
+ (let* ((props))
+ (save-match-data
+ (dolist (pr (nth 1 toolbarx-dropdown-props))
+ (when (and (memq pr merged-props-dropdown-only)
+ (string-match "^:dropdown-\\(.*\\)$"
+ (symbol-name pr)))
+ (let* ((new-pr (intern (concat ":"
+ (substring (symbol-name pr)
+ (match-beginning 1)
+ (match-end 1)))))
+ (val (cadr (memq pr merged-props-dropdown-only))))
+ (setq props (append (list new-pr val) props))))))
+ (unless (memq :image props)
+ (setq props (append (list :image "dropdown") props)))
+ props))
+ (dropdown-button-without-command
+ (cons 'dropdown dropdown-button-props))
+ ;; `:type' defaults to `radio'
+ (type (if (memq :type filtered-dropdown-group-props-only)
+ (cadr (memq :type filtered-dropdown-group-props-only))
+ 'radio))
+ ;; `:default' defaults to 1 or nil depending on `type'
+ ;; if type is toggle and default is not a list, but a
+ ;; integer, set as the list with integer
+ (default
+ (let* ((memq-default (memq :default
+ filtered-dropdown-group-props-only))
+ (def-temp (cadr memq-default))
+ (default-temp (if memq-default
+ def-temp
+ (if (eq type 'radio) 1 (list 1)))))
+ default-temp))
+ ;; `:save' defaults to nil and require `:variable'
+ (save (let* ((save-temp
+ (when (memq :save filtered-dropdown-group-props-only)
+ (cadr (memq :save
+ filtered-dropdown-group-props-only)))))
+ (if (and save-temp
+ (not (memq :variable
+ filtered-dropdown-group-props-only)))
+ (progn
+ (display-warning
+ 'toolbarx
+ (concat "`:save' property with non-nil value should "
+ "be used only with the `:variable' property; "
+ "using value nil for `:save'."))
+ nil)
+ save-temp)))
+ ;; `:title' defaults to nil
+ (title (when (memq :title filtered-dropdown-group-props-only)
+ (cadr (memq :title filtered-dropdown-group-props-only))))
+ ;; the menu variable is buildt from the `:variable' option or
+ ;; make a symbol not used
+ (variable (if (memq :variable filtered-dropdown-group-props-only)
+ (cadr (memq :variable
+ filtered-dropdown-group-props-only))
+ (let* ((count 0)
+ (symb (intern (format
+ "toolbarx-internal-menu-var-%d"
+ count))))
+ (while (boundp symb)
+ (setq count (1+ count))
+ (setq symb
+ (intern (format "toolbarx-internal-menu-var-%d"
+ count))))
+ symb)))
+ ;; auxiliary variables
+ (list-strings)
+ (list-buttons))
+ ;; setting `variable'
+ (if save
+ (custom-declare-variable
+ variable default
+ "Used as variable of dropdown menu defined with `toolbarx'.")
+ (when (not (boundp variable))
+ (set variable default)))
+ ;; now check `variable' content
+ (set variable
+ (let ((val (symbol-value variable)))
+ (if (eq type 'toggle)
+ (if (listp val)
+ val
+ (if (integerp val)
+ (list val)
+ (list 1)))
+ ;; then, type is radio
+ (if (integerp val)
+ val
+ (if (and val
+ (listp val)
+ (integerp (car val)))
+ (car val)
+ 1)))))
+ ;; === buiding `list-strings' and `list-buttons' ===
+ ;; if only symbols, build `list-strings' and `list-buttons' from symbols
+ (if (let ((only-symbols-flag t))
+ (dolist (i dropdown-list only-symbols-flag)
+ (setq only-symbols-flag (and only-symbols-flag (symbolp i)))))
+ (let ((count 0))
+ (dolist (i dropdown-list)
+ ;; list-strings and list-buttons are built reversed
+ (setq list-strings (cons (toolbarx-make-string-from-symbol i)
+ list-strings))
+ (setq count (1+ count))
+ (setq list-buttons (cons (list i
+ :insert
+ (if (eq type 'radio)
+ (list 'eq count variable)
+ (list 'memq count variable)))
+ list-buttons))))
+ ;; if not, the it must start with string
+ (unless (stringp (car dropdown-list))
+ (error "%s %s %s"
+ "If not all items on dropdown are symbols, then a string"
+ "must come before each set of buttons; no string found"
+ "in first position"))
+ (let ((count 0)
+ (elem)
+ (temp-list-buttons))
+ (while dropdown-list
+ (setq elem (car dropdown-list))
+ (setq dropdown-list (cdr dropdown-list))
+ (if (stringp elem)
+ ;; if string, output `temp-list-buttons' and prepair it again
+ (progn
+ ;; list-strings and list-buttons are buildt reversed
+ (setq list-strings (cons elem list-strings))
+ (when temp-list-buttons
+ (setq list-buttons (cons (append (nreverse temp-list-buttons)
+ (list :insert
+ (if (eq type 'radio)
+ (list 'eq count
+ variable)
+ (list 'memq count
+ variable))))
+ list-buttons)))
+ (setq temp-list-buttons nil)
+ (setq count (1+ count)))
+ ;; else, if not string, just insert it to `temp-list-buttons'
+ ;; which is also buildt reversed
+ (setq temp-list-buttons (cons elem temp-list-buttons))))
+ ;; output last temp list, left behind
+ (when temp-list-buttons
+ (setq list-buttons (cons (append (nreverse
+ temp-list-buttons)
+ (list
+ :insert (if (eq type 'radio)
+ (list 'eq count
+ variable)
+ (list 'memq count
+ variable))))
+ list-buttons)))))
+ ;; lists were made reversed (elements inserted at the beginning)
+ (setq list-strings (nreverse list-strings))
+ (setq list-buttons (nreverse list-buttons))
+ ;; now, pass `list-buttons' as a group to `toolbarx-process-group'
+ (let ((current-switches switches))
+ (setq current-switches
+ (toolbarx-process-group list-buttons meaning-alist
+ merged-props ; pass non-processed props
+ current-switches))
+ (setq current-switches
+ ;; outputing dropdown button
+ (toolbarx-process-group (append dropdown-button-without-command
+ (list :command
+ (toolbarx-mount-popup-menu
+ list-strings variable type
+ title save)))
+ meaning-alist merged-props-button-only
+ switches))
+ current-switches)))
+
+
+
+;; Still functions `toolbarx-install-toolbar' and `toolbarx-refresh'to
+;; complete the parsing engine. Since they interface with other engines,
+;; they must come in the end.
+
+;;; How a image is made, giving a string as (part of) file name.
+
+;; look at function `image-type-available-p' for Emacs !!!!
+
+(defun toolbarx-find-image (image)
+ "Return image descriptor or glyph for IMAGE.
+
+IMAGE is string. Usually IMAGE neither contains a directory nor
+an extension. If the extension is omitted, `xpm', `xbm' and
+`pbm' are tried. If the directory is omitted,
+`toolbarx-image-path' is searched."
+ (let ((file))
+ (dolist (i '("" ".xpm" ".xbm" ".pbm"))
+ (unless file
+ (setq file (locate-library (concat image i) t toolbarx-image-path))))
+ (if file
+ (create-image file)
+ (find-image `((:type xpm :file ,(concat image ".xpm"))
+ (:type xbm :file ,(concat image ".xbm"))
+ (:type pbm :file ,(concat image ".pbm")))))))
+
+;; next variable interfaces between parsing and display engines
+(defvar toolbarx-internal-button-switches nil
+ "Store the list of processed buttons, used by `toolbarx-refresh'.
+This variable can store different values for the different buffers.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Second engine: display parsed buttons in Emacs
+
+(defun toolbarx-emacs-add-button (button used-keys keymap)
+ "Insert a button where BUTTON is its description.
+USED-KEYS should be a list of symbols, where the first element is
+`:used-symbols'. This list should store the symbols of the
+buttons already inserted. This list is changed by side effect.
+KEYMAP is the keymap where the menu-item corresponding to the
+tool-bal button is going to be inserted. Insertion is made in
+the end of KEYMAP.
+
+BUTTON should be a list of form (SYMBOL . PROP-LIST). SYMBOL is
+a symbol that \"names\" this button. PROP-LIST is a list in the
+format (PROP VAL ... PROP VAL). The supported properties are
+`:image', `:command', `:append-command', `:prepend-command',
+`:help', `:enable', `:visible', `:button', and `:insert'.
+For a description of properties, see documentation of
+function `toolbar-install-toolbar'."
+ (let* ((symbol (nth 0 button))
+ (used-keys-list (when used-keys
+ (cdr used-keys)))
+ (filtered-props
+ (let* ((filtered-props-temp)
+ (prop-good-val)
+ (prop))
+ (dolist (p (nth 0 toolbarx-button-props) filtered-props-temp)
+ ;; property -> (car p)
+ ;; test type function -> (cadr p)
+ ;; add-function -> (cddr p)
+ (setq prop (memq (car p) button))
+ ;; if so, check if value is of correct type
+ (when prop
+ ;; if property is of add-type, them the value is a list
+ ;; (:add-value-list VAL VAL). Each VAL should be checked.
+ (if (and (cddr p) (eq :add-value-list (car (cadr prop))))
+ (let* ((add-list (list (cddr p))))
+ (dolist (val (cdr (cadr prop)))
+ (setq prop-good-val (funcall (cadr p) val))
+ (when (car prop-good-val)
+ (setq add-list (cons (cdr prop-good-val) add-list))))
+ (setq add-list (nreverse add-list))
+ (when (eq 2 (length add-list)) ; just 1 value, no
+ ; add-function
+ (setq add-list (cadr add-list)))
+ (setq filtered-props-temp (append
+ (list (car p) add-list)
+ filtered-props-temp)))
+ ;; if override-property
+ (setq prop-good-val (funcall (cadr p) (cadr prop)))
+ (when (car prop-good-val)
+ (setq filtered-props-temp (append
+ (list (car p)
+ (cdr prop-good-val))
+ filtered-props-temp))))))))
+ (insert (or (not (memq :insert filtered-props))
+ ;; (memq :insert filtered-props)
+ (eval (nth 1 (memq :insert filtered-props)) t))))
+ (when insert
+ (cond
+ (t
+ ;; symbol is not :new-line, therefore a normal button
+ (let* ((image (cadr (memq :image filtered-props)))
+ (image-descriptor
+ (when (memq :image filtered-props)
+ (cond
+ ((stringp image) ; string
+ (toolbarx-find-image image))
+ ((and (consp image) ; or image descriptor
+ (eq (car image) 'image))
+ image)
+ ((and (symbolp image) ; or a symbol bound to a
+ (boundp image) ; image descriptor (defined
+ ; with `defimage')g
+ (consp (symbol-value image))
+ (eq (car (symbol-value image)) 'image))
+ (symbol-value image))
+ (t ; otherwise, must be a list
+ ; with 4 strings or image
+ ; descriptors
+ (apply #'vector (mapcar (lambda (img)
+ (if (stringp img)
+ (toolbarx-find-image img)
+ img))
+ image))))))
+ (command
+ (let* ((com (nth 1 (memq :command filtered-props)))
+ (app (nth 1 (memq :append-command filtered-props)))
+ (prep (nth 1 (memq :prepend-command filtered-props))))
+ (when (or com app prep)
+ (toolbarx-make-command com prep app))))
+ (help (cons (memq :help filtered-props)
+ (cadr (memq :help filtered-props))))
+ (enable (cons (memq :enable filtered-props)
+ (cadr (memq :enable filtered-props))))
+ (visible (cons (memq :visible filtered-props)
+ (cadr (memq :visible filtered-props))))
+ (button (cons (memq :button filtered-props)
+ (cadr (memq :button filtered-props))))
+ (menuitem (if (eq symbol 'separator)
+ '(menu-item "--")
+ (append
+ (list 'menu-item
+ (toolbarx-make-string-from-symbol symbol)
+ command
+ :image image-descriptor)
+ (when (car help)
+ (list :help (cdr help)))
+ (when (car enable)
+ (list :enable (cdr enable)))
+ (when (car visible)
+ (list :visible (cdr visible)))
+ (when (car button)
+ (list :button (cdr button)))
+ '(:vert-only t))))
+ (key-not-used
+ (let* ((count 0)
+ (symb symbol))
+ (while (memq symb used-keys-list)
+ (setq count (1+ count))
+ (setq symb (intern (format "%s-%d" symbol count))))
+ symb)))
+ (when (and image-descriptor command)
+ (setq used-keys-list (cons key-not-used used-keys-list))
+ (define-key-after keymap
+ (vector key-not-used) menuitem))))))
+ (when used-keys (setcdr used-keys used-keys-list))))
+
+
+(defun toolbarx-emacs-refresh-process-button-or-insert-list (switches
+ used-keys
+ keymap)
+ "Process SWITCHES, inserting buttons in `tool-bar-map'.
+If a button is actually a `:insert' clause group (if `car' is
+`:insert') and evaluation of `cdr' yields non-nil, process `cddr'
+recursively as SWITCHES. USED-KEYS is a list which `car' is
+`:used-symbols' and which `cdr' is a list of symbols that have already
+been used as keys in the keymap `tool-bar-map'."
+ (dolist (button switches)
+ (if (eq (car button) :insert)
+ (when (eval (cadr button) t)
+ (toolbarx-emacs-refresh-process-button-or-insert-list (cddr button)
+ used-keys
+ keymap))
+ (toolbarx-emacs-add-button button used-keys keymap))))
+
+
+
+(defun toolbarx-emacs-refresh (&optional global-flag)
+ "Refresh and redraw the toolbar in Emacs.
+If GLOBAL-FLAG is non-nil, the default value of toolbar switches
+is used and the default value of `toolbarx-map' is changed."
+ (let* ((switches (if global-flag
+ (if (default-boundp 'toolbarx-internal-button-switches)
+ (default-value 'toolbarx-internal-button-switches)
+ toolbarx-internal-button-switches)
+ toolbarx-internal-button-switches))
+ (used-keys (list :used-symbols nil))
+ (tool-bar-map-temp (make-sparse-keymap)))
+ (toolbarx-emacs-refresh-process-button-or-insert-list switches used-keys
+ tool-bar-map-temp)
+ (if global-flag
+ (setq-default tool-bar-map tool-bar-map-temp)
+ (setq tool-bar-map tool-bar-map-temp))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; finishing parsing engine
+
+(defun toolbarx-refresh (&optional global-flag)
+ "Redraw the toolbar, peviously installed with `toolbarx'.
+Force global refresh if GLOBAL-FLAG is non-nil."
+ (interactive "P")
+ (toolbarx-emacs-refresh global-flag))
+
+;;;###autoload (autoload 'toolbarx-install-toolbar "toolbar-x")
+
+(defun toolbarx-install-toolbar (buttons &optional meaning-alist global-flag)
+ "Install toolbar buttons given in BUTTONS.
+Button properties are optionally given in MEANING-ALIST. If
+GLOBAL-FLAG is non-nil, toolbar is installed globally (on every
+buffer that does not have a toolbar set locally). BUTTONS is a
+list of format
+ (ELEM ... ELEM . PROPS),
+where each ELEM is either
+
+ - a list in the same format od BUTTONS, which is going to be
+ refered as a *group*; groups are used to distribute properties
+ recursively to its elements; there are groups with special
+ format for special purpose: *dropdown groups* and also *eval
+ groups*.
+
+ - a symbol, which could be associated in MEANING-ALIST with a
+ list of button properties (symbol + properties = a *button*)
+ or associated to a special kind of group (an *alias group*).
+
+Meaning alist
+=============
+
+MEANING-ALIST is a list where each element is in one of the
+formats (SYMB . BUTTON-PROPS-LIST) or (SYMB . ALIAS-GROUP).
+BUTTON-PROPS-LIST is a list in one of the formats
+ (IMAGE COMMAND PROP VAL PROP VAL ... PROP VAL) or
+ (PROP VAL PROP VAL ... PROP VAL).
+The IMAGE is going to be used as the `:image' property of the
+button (see button properties bellow), and COMMAND shall be used
+as the `:command' property of the button. Each PROP is one of
+the button properties, and VAL is its respective value.
+ALIAS-GROUP is a list which first element is the symbol `:alias'
+and the cdr shall be processed as a group.
+
+However, a symbol is not required to have an association in
+MEANING-ALIST, which is only a way to specify properties to a
+button. One can use groups to specify properties. Nil is a good
+MEANING-ALIST.
+
+Buttons
+=======
+
+A toolbar button in `toolbarx' is the set with a symbol and
+properties used to display the button, like a image and a command
+to call when the button is pressed (which are the minimal
+elements that a button should have.) The supported properties
+for buttons and their `basic types' (see note on how values of
+properties are obtained!) are:
+
+ :image -- either a string or image descriptor (see
+ info for a definition), or a variable bound to a image
+ descriptor (like those defined with `defimage') or a list of 4
+ strings or image descriptors;
+ defines the image file displayed by the button. If
+ it is a string, the image file found with that name (always
+ using the function `toolbarx-find-image' to make the
+ \`internal\' image descriptor) is used as button image. For
+ the other formats, the button image is handled in the same way
+ as it is treated by the editors; see info nodes bellow for a
+ description of the capabilities:
+ info file \"elisp\", node \"Tool Bar\" (see `:image' property);
+ PS: a *vector* of four strings is used in the Emacs
+ Lisp documentation as the `more ellaborated' image
+ property format, but here we reserve vectors to
+ provide editor-dependent values; this motivates our
+ choice for a list instead of vector (however,
+ internally the list becomes a vector when displaying
+ the button).
+
+ :command -- a form; if the form happens to be a command, it will
+ be called with `call-interactively'.
+
+ :append-command -- a form added to the end of the value of
+ `:command'.
+
+ :prepend-command -- a form added at the beginning of the value
+ of `:command'.
+
+ :help -- either a string or nil; defined the help string of the
+ button;
+
+ :enable -- a form, evaluated constantly by both editors to
+ determine if a button is active (enabled) or not.
+
+ :visible -- a form that is evaluated constantly to
+ determine if a button is visible.
+
+ :button -- a cons cell (TYPE . SELECTED) where the
+ TYPE should be `:toggle' or `:radio' and the cdr should be a
+ form. SELECTED is evaluated to determine when the button is
+ selected.
+
+ :insert -- a form that is evaluated every time that the toolbar
+ is refresh (a call of `toolbarx-refresh') to determine if the
+ button is inserted or just ignored (until next refresh).
+
+How to specify a button
+=======================
+
+One can specify a button by its symbol or by a group to specify
+properties. For example,
+ BUTTON =
+ ( foo
+ (bar :image \"bar\"
+ :command bar-function :help \"Bar help string\")
+ :insert foo-bar )
+ MEANING-ALIST = ( (foo :image \"foo\" :command foo-function) )
+specifiy two buttons `foo' and `bar', each one with its necessary
+:image and :command properties, and both use the :insert property
+specified ate the end of BUTTONS (because groups distribute
+properties to all its elements). `foo' and `bar' will be
+inserted only if `foo-bar' evaluation yields non-nil.
+
+Note on how values of properties are obtained
+=============================================
+
+For each property PROP, its value should be either:
+ i) a vector of 2 elements; then each element should be of the
+ basic type of PROP.
+ ii) an element on the basic type of PROP.
+ iii) a function (that does not need arguments); it is evaluated
+ and the return should be ot type i) or ii) above
+ iv) a symbol bound to a element of type i) or ii).
+
+The type is cheched in the order i), ii) iii) and iv). This
+evaluations are done every time that the oolbar is refresh.
+
+Ps.: in order to specify a vector as value of a property (like
+the :image in Emacs), it is necessary to provide the vector as
+element of another vector.
+
+Special groups
+==============
+
+Eval groups
+-----------
+
+If the first element of a group is the symbol `:eval-group', each
+element is evaluated (with `eval'), put inside a list and
+processed like a group. Eval groups are useful to store
+definition of buttons in a variable.
+
+Dropdown groups
+---------------
+
+The idea is to specify a set of buttons that appear when a
+determined menu item of a dropdown menu is active. The dropdown
+menu appears when a button (by default with a triangle pointing
+down) is clicked. This button is called `dropdown button'. The
+dropdown button appears on the left of the currently visible
+buttons of the dropdown group.
+
+A dropdown group is a list which first element is the symbol
+`:dropdown-group' and in one of the following formats
+ (:dropdown-group SYMBOL-1 ... SYMBOL-n PROP-1 VAL-1 ... PROP-k VAL-k)
+or
+ (:dropdown-group
+ STRING-1 ITEM-11 ... ITEM-1n
+ STRING-2 ITEM-21 ... ITEM-2m
+ . . .
+ STRING-n ITEM-n1 ... ITEM-np
+ PROP-1 VAL-1 ... PROP-j VAL-j)
+where
+ SYMBOL-* is a symbol that defines a button in MEANING-ALIST;
+ STRING-* is a string that will appear in the dropdown menu;
+ ITEM-* is any format that define buttons or groups.
+
+\(a dropdown group of first format is internally converted to the
+second by making strings from the symbols and each symbol is the
+item)
+
+The same rules for obtaining property values, described above,
+apply here. Properties are also distributed by groups. The
+supported properties and their basic type are:
+
+ :type -- one of the symbols `radio' (default) or `toggle'; if
+ type is radio, only one of the itens may be active, and if
+ type is toggle, any item number of itens can be active.
+
+ :variable -- a symbol; it is the variable that govern the
+ dropdown button; every time the value should be an integer
+ starting from 1 (if type is radio) or a list of integers (if
+ type is toggle). The Nth set of buttons is :insert'ed.
+
+ :default -- determines the default value when the menu is
+ installed; it is ignored if a value was saved with custom; it
+ defaults to 1 if type is radio or nil if type is toggle. If
+ value is a integer and type is `toggle', value used is a list
+ with that integer.
+
+ :save -- one of the symbols nil (default), `offer' or
+ `always'; determined if it is possible for the user to save
+ the which menu itens are active, for a next session. If value
+ is `offer', a item (offering to save) is added to the
+ popup menu. If the value is `always', every time that a item
+ is selected, the variable is saved. If value is nil, variable
+ shall not be saved. If value is non-nil then `:variable' is
+ mandatory.
+
+ :title -- a string or nil; if a string, the popup menu will show
+ is as menu title; if nil, no title is shown.
+
+ :dropdown-help -- a string or nil; the help string of the
+ dropdown button.
+
+ :dropdown-image -- either a string or a vector of 4 strings;
+ defines the image file displayed by the dropdown button;
+ by default, it is the string \"dropdown\".
+
+ :dropdown-append-command,
+ :dropdownprepend-command -- a form; append or prepend forms to
+ the command that shows the dropdown menu, allowing extra code
+ to run before or after the menu appears (remember that every
+ menu item clicked refresh the toolbar.)
+
+ :dropdown-enable -- a form; evaluated constantly by both editors
+ to determine if the dropdown button is active (enabled) or
+ not.
+
+ :dropdown-visible -- a form; it is evaluated
+ constantly to determine if the dropdown button is visible.
+
+Also, if the symbol `dropdown' is associted in MEANING-ALIST
+with some properties, these properties override (or add) with
+higher precedence.
+
+Special buttons
+===============
+
+If the symbol of a button is `:new-line', it is inserted
+a (faked) return, and the next button will be displayed a next
+line of buttons. The only property supported for this button is
+`:insert'."
+ (let ((switches (toolbarx-process-group buttons meaning-alist nil nil)))
+ (if global-flag
+ (setq-default toolbarx-internal-button-switches
+ switches)
+ (set (make-local-variable 'toolbarx-internal-button-switches)
+ switches)
+ (make-local-variable 'tool-bar-map)))
+ (toolbarx-refresh global-flag))
+
+
+(defconst toolbarx-default-toolbar-meaning-alist
+ '((separator :image "sep" :command t :enable nil :help "")
+
+ (new-file
+ :image "new"
+ :command find-file
+ :enable (not (window-minibuffer-p
+ (frame-selected-window menu-updating-frame)))
+ :help "Specify a new file's name, to edit the file")
+
+ (open-file :image "open"
+ :command menu-find-file-existing
+ :enable (not (window-minibuffer-p
+ (frame-selected-window menu-updating-frame)))
+ :help "Read a file into an Emacs buffer")
+
+ (dired :image "diropen"
+ :command dired
+ :help "Read a directory, operate on its files")
+
+ (save-buffer :image "save"
+ :command save-buffer
+ :enable (and
+ (buffer-modified-p)
+ (buffer-file-name)
+ (not (window-minibuffer-p
+ (frame-selected-window menu-updating-frame))))
+ :help "Save current buffer to its file"
+ :visible (or buffer-file-name
+ (not (eq 'special
+ (get major-mode 'mode-class)))))
+
+ (write-file :image "saveas"
+ :command write-file
+ :enable (not
+ (window-minibuffer-p
+ (frame-selected-window menu-updating-frame)))
+ :help "Write current buffer to another file"
+ :visible (or buffer-file-name
+ (not (eq 'special (get major-mode 'mode-class)))))
+
+ (undo :image "undo"
+ :command undo
+ :enable (and (not buffer-read-only)
+ (not (eq t buffer-undo-list))
+ (if (eq last-command #'undo)
+ pending-undo-list
+ (consp buffer-undo-list)))
+ :help "Undo last operation"
+ :visible (not (eq 'special (get major-mode 'mode-class))))
+
+ (cut :image "cut"
+ :help "Delete text in region and copy it to the clipboard"
+ :command clipboard-kill-region
+ :visible (not (eq 'special (get major-mode 'mode-class))))
+
+ (copy :image "copy"
+ :help "Copy text in region to the clipboard"
+ :command clipboard-kill-ring-save)
+
+ (paste :image "paste"
+ :help "Paste text from clipboard"
+ :command clipboard-yank
+ :visible (not (eq 'special (get major-mode 'mode-class))))
+
+ (search-forward :command nonincremental-search-forward
+ :help "Search forward for a string"
+ :image "search")
+
+ (search-replace
+ :image "search-replace"
+ :command query-replace
+ :help "Replace string interactively, ask about each occurrence")
+
+ (print-buffer :image "print"
+ :command print-buffer
+ :help "Print current buffer with page headings")
+
+ (customize :image "preferences"
+ :command customize
+ :help "Edit preferences (customize)")
+
+ (help :image "help"
+ :command (lambda () (interactive) (popup-menu menu-bar-help-menu))
+ :help "Pop up the Help menu")
+
+ (kill-buffer :command kill-this-buffer
+ :enable (kill-this-buffer-enabled-p)
+ :help "Discard current buffer"
+ :image "close")
+
+ (exit-emacs :image "exit"
+ :command save-buffers-kill-emacs
+ :help "Offer to save unsaved buffers, then exit Emacs")
+
+ (spell-buffer :image "spell"
+ :command ispell-buffer
+ :help "Check spelling of selected buffer")
+
+ (info :image "info"
+ :command info
+ :help "Enter Info, the documentation browser"))
+ "A meaning alist with definition of the default buttons.
+The following buttons are available:
+
+ `open-file', `dired', `save-buffer',
+ `undo', `cut', `copy', `paste', `search-replace', `print-buffer',
+ `spell-buffer', `info'.
+ `new-file', `write-file', `search-forward',
+ `customize', `help', `kill-buffer', `exit-emacs'.
+
+To reproduce the default toolbar with use as BUTTON
+in `toolbarx-install-toolbar':
+
+\(toolbarx-install-toolbar
+ \\='((open-file dired kill-buffer save-buffer write-file undo cut
+ copy paste search-forward print-buffer customize help))
+ toolbarx-default-toolbar-meaning-alist)
+
+Ps.: there are more buttons available than suggested in the
+expression above.")
+
+(provide 'toolbar-x)
+
+;;; toolbar-x.el ends here