diff options
Diffstat (limited to 'elpa/auctex-13.1.3/toolbar-x.el')
| -rw-r--r-- | elpa/auctex-13.1.3/toolbar-x.el | 1565 |
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 |