1 ;;; toolbar-x.el --- fancy toolbar handling in Emacs and XEmacs
3 ;; Copyright (C) 2004, 2005, 2008 Free Software Foundation, Inc.
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the GNU General Public License as
7 ;; published by the Free Software Foundation; either version 3 of
8 ;; the License, or (at your option) any later version.
10 ;; This program is distributed in the hope that it will be
11 ;; useful, but WITHOUT ANY WARRANTY; without even the implied
12 ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
13 ;; PURPOSE. See the GNU General Public License for more details.
15 ;; You should have received a copy of the GNU General Public
16 ;; License along with this program; if not, write to the Free
17 ;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
20 ;;; Author: Miguel Vinicius Santini Frasson
23 ;; This program implements a common interface to display toolbar
24 ;; buttons in both Emacs and XEmacs. A toolbar should be basicly
25 ;; defined by a image and a command to run when the button is pressed,
26 ;; and additional properties could be added. This is the idea of this
27 ;; program. See the documentation of function
28 ;; `toolbarx-install-toolbar' for a description of how to specify
33 ;; * Button properties are given in the toolbar definition (BUTTON
34 ;; paramenter in `toolbarx-install-toolbar') and/or in an alist with
35 ;; associates the symbol with properties (MEANING-ALIST paramenter in
36 ;; `toolbarx-install-toolbar').
38 ;; * Supported properties:
39 ;; - All editors: `:insert', `:image', `:command', `:help', `:enable',
40 ;; `:append-command' and `:prepend-command';
41 ;; - Emacs only: `:visible' and `:button';
42 ;; - XEmacs only: `:toolbar'.
43 ;; For the precise value-type for each property, see documentation of
44 ;; the function `toolbarx-install-toolbar'.
45 ;; (ps: properties that are particular to an editor are just ignored
46 ;; the other editor flavour.)
48 ;; * Button properties may depend on the editor flavour, if the value
49 ;; is a vector; the first element will be used for Emacs and the 2nd
50 ;; for XEmacs. Example: `:image ["new" toolbar-file-icon]'
52 ;; * Properties can have value specified by function (with no
53 ;; argument) or variables that evaluate to an object of the correct
54 ;; type for a particular property. The evaluation is done when the
55 ;; roolbar is refresh (a call of `toolbarx-refresh'.)
56 ;; (ps: this is valid only for properties that *not* have \`form\' as
59 ;; * On `refresh time' (a call `toolbarx-refresh', necessary when the
60 ;; toolbar should change), the `:insert' property (if present) is
61 ;; evaluated to decide if button will be displayed.
63 ;; Properties can be distributed to several buttons, using \`groups\'.
64 ;; Example: (for (bar baz :toolbar (bottom . top) :insert foo-form)
65 ;; means that `foo', `bar' and `baz' have `:insert foo-form' and `bar' and
66 ;; `baz' have the property `:toolbar (bottom . top)'. (ps: this type
67 ;; of value for the `:toolbar' property (XEmacs only) means that the
68 ;; buttons will be in the bottom toolbar unless the default toolbar is
69 ;; in the bottom, and in this case, this buttons go to the top
72 ;; * (Part of) the toolbar definition can be stored in a variable,
73 ;; evaluated in `installation time'. See `:eval-group' on the
74 ;; documentation of the function `toolbarx-install-toolbar'.
76 ;; * It is possible to define sets of buttons that appear according to
77 ;; an option selected in a dropdown menu. See `:dropdown-group' on
78 ;; the documentation of the function `toolbarx-install-toolbar'.
80 ;;; Rough description of the implementation
81 ;; There are 3 \`engines\' implemented:
83 ;; == the 1st one (parsing) parses the toolbar definition
84 ;; independently of editor flavour and store the parsed buttons with
85 ;; their properties, in the same order that they appear in the
86 ;; definitions, in a variable `toolbarx-internal-button-switches';
88 ;; == the 2nd one (refresh for Emacs) inserts buttons in the Emacs
89 ;; toolbar in the same order that they appear in the definitions;
90 ;; buttons with a `:insert' property value that evaluates to nil are
91 ;; ignored; if a (real) button does not have at least (valid) image
92 ;; and command properties, they are silently ignored;
94 ;; == the 3rd engine (refresh for XEmacs) is similar to the 2nd, but
95 ;; inserts buttons in XEmacs.
99 ;; This program was motivated by the intention of implementation of a
100 ;; good toolbar for AUCTeX, that would work in both Emacs and XEmacs.
101 ;; Since toolbars are very different in behaviour and implementation
102 ;; (for instance, in Emacs one can display as many toolbar buttons as
103 ;; wanted, because it becomes mult-line, and in XEmacs, there is one
104 ;; line, but toolbars and all sides of a frame.)
109 ;; Note that this just gives a useful default. Icons are expected to
110 ;; be in subdirectory "images" or "toolbar" relative to the load-path.
111 ;; Packages loading toolbarx are advised to explicitly add their own
112 ;; searchpath with add-to-list here even when they fulfill that
113 ;; criterion: another package might have loaded toolbar-x previously
114 ;; when load-path was not yet correctly set. The default setting
115 ;; really caters only for toolbar-x' stock icons.
117 (defvar toolbarx-image-path
119 (delq nil (mapcar #'(lambda(x)
122 (file-name-nondirectory
123 (directory-file-name x))
124 '("toolbar" "images"))
125 ;;(file-directory-p x)
128 (list data-directory))
129 "List of directories where toolbarx finds its images.")
131 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
132 ;;; First engine: Parsing buttons
134 ;; it obtains button information, process it and stores result in
135 ;; `toolbarx-internal-button-switches', which is a list with 1st
136 ;; element the symbol `:switches', the 2nd element as a list of
137 ;; processed buttons, and the 3rd element is used for Emacs to store
138 ;; the keys used in ``constant'' buttons.
140 ;; The 2nd element of `toolbarx-internal-button-switches' is a list
141 ;; where each element is either:
142 ;; * a button-list, that is, a list with elements to define a button.
143 ;; * a list where 1st elem is `:insert' and 2nd is a form, and the
144 ;; following elements are in the same format of the 2nd element of
145 ;; `toolbarx-internal-button-switches'.
147 (defun toolbarx-make-string-from-symbol (symbol)
148 "Return a string from the name of a SYMBOL.
149 Upcase initials and replace dashes by spaces."
150 (let* ((str (upcase-initials (symbol-name symbol)))
152 (dolist (i (append str nil))
153 (if (eq i 45) ; if dash, push space
155 (push i str2))) ; else push identical
156 (concat (nreverse str2))))
158 (defun toolbarx-make-symbol-from-string (string)
159 "Return a (intern) symbol from STRING.
160 Downcase string and replace spaces by dashes."
161 (let* ((str1 (append (downcase string) nil))
164 (if (eq i 32) ; if dash, push space
167 (intern (concat (nreverse str2)))))
169 (defun toolbarx-good-option-list-p (option-list valid-options)
170 "Non-nil means the OPTION-LIST is of form (OPT FORM ... OPT FORM).
171 Each OPT is member of VALID-OPTIONS and OPT are pairwise
172 different. OPTION-LIST equal to nil is a good option list."
173 (let ((elt-in-valid t)
174 (temp-opt-list option-list)
176 (n (/ (length option-list) 2)))
179 (setq temp-opt-list (cddr temp-opt-list)))
180 (add-to-list 'list-diff
182 (setq elt-in-valid (and elt-in-valid
183 (memq (car temp-opt-list)
185 (and elt-in-valid ; options are on VALID-OPTOPNS
186 ;; OPTION-LIST has all option different from each other
187 (eq (length list-diff) n)
188 ;; OPTION-LIST has even number of elements
189 (eq (% (length option-list) 2) 0))))
191 (defun toolbarx-separate-options (group-list valid-options &optional check)
192 "Return a cons cell with non-options and options of GROUP-LIST.
193 The options-part is the largest tail of the list GROUP-LIST that
194 has an element of VALID-OPTIONS (the comparation is made with
195 `memq'.) The non-options-part is the beginning of GROUP-LIST
196 less its tail. Return a cons cell which `car' is the
197 non-options-part and the `cdr' is the options-part.
199 If CHECK is non-nil, the tail is the largest that yield non-nil
200 when applied to `toolbarx-good-option-list-p'."
203 (dolist (i valid-options)
204 (setq temp (memq i group-list))
205 (when (and (> (length temp) (length maximal))
207 (toolbarx-good-option-list-p temp valid-options)
209 (setq maximal (memq i group-list))))
210 (cons (butlast group-list (length maximal)) maximal)))
213 (defun toolbarx-merge-props (inner-props outer-props override add)
214 "Merge property lists INNER-PROPS and OUTER-PROPS.
215 INNER-PROPS and OUTER-PROPS are two lists in the format
216 (PROP VAL PROP VAL ... PROP VAL).
217 Returns a list with properties and values merged.
219 OVERRIDE and ADD are supposed to be lists of symbols. The value
220 of a property in OVERRIDE is the one on OUTER-PROPS or
221 INNER-PROPS, but if the property is in both, the value in
222 INNER-PROPS is used. The value of a property in ADD will be a
223 list with first element the symbol `:add-value-list' and the rest
224 are the properties, inner properties first."
228 (dolist (prop override)
229 (if (memq prop inner-props)
230 (setq merged (append merged
231 (list prop (cadr (memq prop inner-props)))))
232 (when (memq prop outer-props)
233 (setq merged (append merged
234 (list prop (cadr (memq prop outer-props))))))))
235 (dolist (prop add merged)
236 (setq inner-prop (memq prop inner-props))
238 (if (and (listp (cadr inner-prop))
239 (eq (car (cadr inner-prop)) :add-value-list))
240 (setq inner-prop (cdr (cadr inner-prop)))
241 (setq inner-prop (list (cadr inner-prop)))))
242 (setq outer-prop (memq prop outer-props))
244 (if (and (listp (cadr outer-prop))
245 (eq (car (cadr outer-prop)) :add-value-list))
246 (setq outer-prop (cdr (cadr outer-prop)))
247 (setq outer-prop (list (cadr outer-prop)))))
248 (when (append inner-prop outer-prop)
249 (setq merged (append merged
250 (list prop (cons :add-value-list
254 (defun toolbarx-make-command (comm prep app)
255 "Return a command made from COMM, PREP and APP.
256 COMM is a command or a form. PREP and APP are forms. If PREP or
257 APP are non-nil, they are added to the resulting command at the
258 beginning and end, respectively. If both are nil and COMM is a
259 command, COMM is returned."
260 (let ((comm-is-command (commandp comm)))
265 (append '(lambda nil (interactive))
266 (when prep (list prep))
269 `((call-interactively (function ,comm)))
271 (when app (list app))))))
273 ;; in Emacs, menus are made of keymaps (vectors are possible, but editors
274 ;; handle `menu titles' differently) meanwhile in XEmacs, menus are lists of
277 (defun toolbarx-emacs-mount-popup-menu
278 (strings var type &optional title save)
279 "Return an interactive `lambda'-expression that shows a popup menu.
280 This function is the action of `toolbarx-mount-popup-menu' if
281 inside Emacs. See documentation of that function for more."
282 ;; making the menu keymap by adding each menu-item definition
283 ;; see (info "(elisp)Menu keymaps")
284 (let* ((keymap (make-sparse-keymap title))
286 (used-symbols '(nil))
288 (real-type (if (eq type 'toggle) 'toggle 'radio))
289 (real-save (when save (if (eq save 'offer) 'offer 'always))))
290 ;; warn if type is not `radio' ot `toggle'; use `radio' if incorrect.
291 (unless (eq type real-type)
292 (display-warning 'toolbarx
293 (format (concat "TYPE should be symbols `radio' or "
294 "`toggle', but %s found; using `radio'")
296 ;; warn if save is not `nil', `offer' or `always'; use nil when incorrect
297 (unless (eq save real-save)
299 (display-warning 'toolbarx
300 (format (concat "SAVE should be symbols `nil', "
301 "`offer' or `always', but %s found; "
305 ;; finding a new symbol
307 (i-symb (toolbarx-make-symbol-from-string i)))
309 (while (memq key used-symbols)
310 (setq aux-count (1+ aux-count))
311 (setq key (intern (format "%s-%d" i-symb aux-count))))
312 (setq used-symbols (cons key used-symbols)))
313 (define-key-after keymap (vector key)
316 `(lambda nil (interactive)
317 ,(if (eq real-type 'radio)
319 `(if (memq ,count ,var)
320 (setq ,var (delete ,count ,var))
321 (setq ,var (sort (cons ,count ,var) '<))))
323 (when (eq real-save 'always)
324 `((customize-save-variable
327 :button ,(if (eq real-type 'radio)
328 `(:radio eq ,var ,count)
329 `(:toggle memq ,count ,var))))
330 (setq count (1+ count)))
331 (when (eq real-save 'offer)
332 (define-key-after keymap [sep] '(menu-item "--shadow-etched-in-dash"))
334 (i-symb 'custom-save))
336 (while (memq key used-symbols)
337 (setq aux-count (1+ aux-count))
338 (setq key (intern (format "%s-%d" i-symb aux-count))))
339 (setq used-symbols (cons key used-symbols)))
340 (define-key-after keymap (vector key)
341 `(menu-item "Save state of this menu"
342 (lambda nil (interactive)
343 (customize-save-variable (quote ,var) ,var)))))
344 ;; returns a `lambda'-expression
345 `(lambda nil (interactive) (popup-menu (quote ,keymap)))))
347 (defun toolbarx-xemacs-mount-popup-menu
348 (strings var type &optional title save)
349 "Return an interactive `lambda'-expression that shows a popup menu.
350 This function is the action of `toolbarx-mount-popup-menu' if
351 inside XEmacs. See documentation of that function for more."
352 (let* ((menu (if (and title (stringp title))
355 (list "Dropdown menu")))
359 (real-type (if (eq type 'toggle) 'toggle 'radio))
360 (real-save (when save (if (eq save 'offer) 'offer 'always))))
361 ;; warn if type is not `radio' ot `toggle'; use `radio' if incorrect.
362 (unless (eq type real-type)
363 (warn (concat "TYPE should be symbols `radio' or `toggle', "
364 "but %s found; using `radio'") type))
365 ;; warn if save is not `nil', `offer' or `always'; use nil when incorrect
366 (unless (eq save real-save)
368 (display-warning 'toolbarx
369 (format (concat "SAVE should be symbols `nil', "
370 "`offer' or `always', but %s found; "
373 ;; making the menu list of vectors
374 (dolist (str strings)
375 (setq count (1+ count))
376 (setq menu-callback (list 'progn
377 (if (eq real-type 'radio)
379 `(if (memq ,count ,var)
380 (setq ,var (delete ,count ,var))
381 (setq ,var (sort (cons ,count ,var) '<))))
382 '(toolbarx-refresh)))
383 (when (eq real-save 'always)
384 (setq menu-callback (append menu-callback
385 (list (list 'customize-save-variable
386 (list 'quote var) var)))))
387 (setq menu-item (vector str menu-callback
389 :selected (if (eq real-type 'radio)
391 `(memq ,count ,var))))
392 (setq menu (append menu (list menu-item))))
393 (when (eq real-save 'offer)
394 (setq menu (append menu (list "--:shadowEtchedInDash")))
395 (setq menu (append menu (list
397 "Save state of this menu"
398 `(customize-save-variable (quote ,var)
400 ;; returnung the lambda-expression
401 `(lambda nil (interactive)
402 (let ((popup-menu-titles ,(if title t nil)))
403 (popup-menu (quote ,menu))))))
405 (defun toolbarx-mount-popup-menu (strings var type &optional title save)
406 "Return a command that show a popup menu.
407 The return is a `lambda'-expression with a interactive declaration.
409 STRINGS is a list of strings which will be the itens of the menu.
411 VAR is a symbol that is set when an item is clicked. TYPE should
412 be one of the symbols `radio' or `toggle': `radio' means that the
413 nth item is selected if VAR is `n' and this item sets VAR to `n';
414 `toggle' means that VAR should be a list of integers and the nth
415 item is selected if `n' belongs to VAR. The item inserts or
416 deletes `n' from VAR.
418 TITLE is a string (the title of the popup menu) or nil for no
421 SAVE is one of the symbols nil, `offer' or `always'. If value
422 is nil, do not try to save anything. If it is `offer', a menu
423 item is added offering the user the possibiity to save state of
424 that dropdown menu for future sesseions (using `custom'). If it
425 is `always', state is saved every time that a item is clicked."
426 (if (featurep 'xemacs)
427 (toolbarx-xemacs-mount-popup-menu strings var type title save)
428 (toolbarx-emacs-mount-popup-menu strings var type title save)))
430 (defun toolbarx-option-value (opt)
431 "Return option value according to Emacs flavour.
432 If OPT is a vector, return first element if in Emacs or
433 second if in XEmacs. Otherwise, return OPT.
434 If OPT is vector and length is smaller than the necessary (like
435 if in XEmacs and vector has length 1), then nil is returned."
437 (if (featurep 'xemacs)
438 (when (> (length opt) 1)
440 (when (> (length opt) 0)
444 (defun toolbarx-eval-function-or-symbol (object type-test-func)
445 "Return a cons cell (GOOD-OBJ . VAL).
446 GOOD-OBJ non-nil means that VAL is a valid value, according to
447 the car of the result of TYPE-TEST-FUNCTION, that should return a
448 cons cell in the same format as the return of this function.
450 If OBJECT applied to TYPE-TEST-FUNC return (GOOD-OBJ . VAL), and
451 GOOD-OBJ is non-nil, return that. Else, check if OBJECT is a
452 function. If so, evaluate and test again with TYPE-TEST-FUNC. If
453 not a function or if GOOD-OBJ is again nil, test if OBJECT is a
454 bound symbol, evaluate that and return the result of
456 (let* ((ret (funcall type-test-func object)))
458 (if (functionp object)
460 (setq ret (funcall type-test-func (funcall object)))
462 (when (and (symbolp object) (boundp object))
463 (setq ret (funcall type-test-func (symbol-value object))))))
464 ;; ok, obj is not function; try symbol
465 (when (and (symbolp object) (boundp object))
466 (setq ret (funcall type-test-func (symbol-value object))))))
469 (defun toolbarx-test-image-type (obj)
470 "Return a cons cell (GOOD-OBJ . VAL).
471 GOOD-OBJ is non-nil if OBJ yields a valid image object VAL (see
472 documentation of function `toolbarx-process-symbol')."
473 (let ((toolbarx-test-image-type-simple
475 (let* ((val (toolbarx-option-value img))
478 (if (featurep 'xemacs)
480 (or (stringp val) ; a string
481 (glyphp val) ; or a glyph
482 (and (symbolp val) ; or a symbol bound to a
483 (boundp val) ; glyph-list
484 (check-toolbar-button-syntax
486 (lambda nil (interactive))
488 (and (listp val) ; or a glyph-or-string list
491 (dolist (i val all-obj-ok)
498 (or (stringp val) ; string
499 (and (consp val) ; or image descriptor
500 (eq (car val) 'image))
501 (and (symbolp val) ; or a symbol bound to a
502 (boundp val) ; image descriptor
503 ; (defined with `defimage')
505 (eq (car (eval val)) 'image))
506 (and (listp val) ; or list with 4 strings or
509 (dolist (i val all-obj-ok)
516 (cons good-obj val)))))
517 (toolbarx-eval-function-or-symbol obj toolbarx-test-image-type-simple)))
519 (defun toolbarx-test-button-type (obj)
520 "Return a cons cell (GOOD-OBJ . VAL).
521 GOOD-OBJ is non-nil if OBJ yields a valid button object VAL (see
522 documentation of function `toolbarx-process-symbol')."
523 (let ((toolbarx-test-button-type-simple
525 (let* ((val (toolbarx-option-value but))
526 (good-obj (if (featurep 'xemacs)
531 (memq (car val) '(:toggle :radio))))))
532 (cons good-obj val)))))
533 (toolbarx-eval-function-or-symbol obj toolbarx-test-button-type-simple)))
535 (defun toolbarx-test-any-type (obj)
536 "Return a cons cell (t . VAL).
537 If OBJ is vector, return VAL according to editor. Else, return
538 OBJ, because it is a form anyway."
539 (cons t (toolbarx-option-value obj)))
541 (defun toolbarx-test-string-or-nil (obj)
542 "Return a cons cell (GOOD-OBJ . VAL).
543 GOOD-OBJ is non-nil if OBJ yields a valid help object VAL (see
544 documentation of function `toolbarx-process-symbol')."
545 (let ((toolbarx-test-string-or-nil-simple
547 (let* ((val (toolbarx-option-value obj))
548 (good-obj (or (stringp val)
550 (cons good-obj val)))))
551 (toolbarx-eval-function-or-symbol obj toolbarx-test-string-or-nil-simple)))
553 (defun toolbarx-test-toolbar-type (obj)
554 "Return a cons cell (GOOD-OBJ . VAL).
555 GOOD-OBJ is non-nil if OBJ yields a valid toolbar property object
556 VAL (see documentation of function `toolbarx-process-symbol')."
557 (let ((toolbarx-test-toolbar-type-simple
559 (let* ((val (toolbarx-option-value obj))
560 (all-but-def-opts '(top bottom left right))
561 (all-opts '(default top bottom left right))
563 (if (featurep 'xemacs)
568 (memq (car val) all-but-def-opts)
569 (memq (cdr val) all-but-def-opts)))
572 (cons good-obj val)))))
573 (toolbarx-eval-function-or-symbol obj toolbarx-test-toolbar-type-simple)))
575 (defun toolbarx-test-dropdown-type (obj)
576 "Return a cons cell (GOOD-OBJ . VAL).
577 GOOD-OBJ is non-nil if OBJ yields a valid `:type' property object
578 VAL of a dropdown group (see documentation of function
579 `toolbarx-process-dropdown-group'."
580 (let ((toolbarx-test-dropdown-type-simple
582 (let* ((val (toolbarx-option-value obj))
583 (good-obj (memq val '(radio toggle))))
584 (cons good-obj val)))))
585 (toolbarx-eval-function-or-symbol obj toolbarx-test-dropdown-type-simple)))
587 (defun toolbarx-test-symbol (obj)
588 "Return a cons cell (GOOD-OBJ . VAL).
589 GOOD-OBJ is non-nil if OBJ yields a valid `:variable' property
590 object VAL of a dropdown group (see documentation of function
591 `toolbarx-process-dropdown-group'."
592 (let ((toolbarx-test-symbol-simple
594 (let* ((val (toolbarx-option-value obj))
595 (good-obj (symbolp val)))
596 (cons good-obj val)))))
597 (toolbarx-eval-function-or-symbol obj toolbarx-test-symbol-simple)))
599 (defun toolbarx-test-dropdown-default (obj)
600 "Return a cons cell (GOOD-OBJ . VAL).
601 GOOD-OBJ is non-nil if OBJ yields a valid `:default' property
602 object VAL of a dropdown group (see documentation of function
603 `toolbarx-process-dropdown-group'."
604 (let ((toolbarx-test-dropdown-default-simple
606 (let* ((val (toolbarx-option-value obj))
607 (good-obj (or (integerp val)
611 (setq ok (and ok (integerp i)))))))))
612 (cons good-obj val)))))
613 (toolbarx-eval-function-or-symbol obj
614 toolbarx-test-dropdown-default-simple)))
616 (defun toolbarx-test-dropdown-save (obj)
617 "Return a cons cell (GOOD-OBJ . VAL).
618 GOOD-OBJ is non-nil if OBJ yields a valid `:save' property
619 object VAL of a dropdown group (see documentation of function
620 `toolbarx-process-dropdown-group'."
621 (let ((toolbarx-test-dropdown-save-simple
623 (let* ((val (toolbarx-option-value obj))
624 (good-obj (memq val '(nil offer always))))
625 (cons good-obj val)))))
626 (toolbarx-eval-function-or-symbol obj toolbarx-test-dropdown-save-simple)))
628 (defconst toolbarx-button-props
629 (let* ((props-types-alist
630 '((:image toolbarx-test-image-type)
631 (:command toolbarx-test-any-type)
632 (:enable toolbarx-test-any-type)
633 (:visible toolbarx-test-any-type)
634 (:help toolbarx-test-string-or-nil)
635 (:insert toolbarx-test-any-type . and)
636 (:toolbar toolbarx-test-toolbar-type)
637 (:button toolbarx-test-button-type)
638 (:append-command toolbarx-test-any-type . progn)
639 (:prepend-command toolbarx-test-any-type . progn)))
640 (possible-props (nreverse (let* ((props ()))
641 (dolist (p props-types-alist props)
642 (setq props (cons (car p) props))))))
643 (props-override (nreverse (let* ((props ()))
644 (dolist (p props-types-alist props)
646 (setq props (cons (car p) props)))))))
647 (props-add (nreverse (let* ((props ()))
648 (dolist (p props-types-alist props)
650 (setq props (cons (car p) props))))))))
651 (list props-types-alist possible-props props-override props-add))
652 "List yielding all encarnations of properties of a button.
653 First element: alist, where each element is of form
654 (PROP . (TYPE-TEST-FUNCTION . ADD-OR-NIL))
655 Second is a list with all properties.
656 Third, a list with properties that override when merging.
657 Fourth, a list of lists, each in the format (PROP ADD).")
659 (defconst toolbarx-dropdown-props
660 ;; for naming dropdown properties see `Convention' in the doc string
661 (let* ((props-types-alist
662 '((:type toolbarx-test-dropdown-type)
663 (:variable toolbarx-test-symbol)
664 (:default toolbarx-test-dropdown-default)
665 (:save toolbarx-test-dropdown-save)
666 (:title toolbarx-test-string-or-nil)
667 (:dropdown-image toolbarx-test-image-type)
668 (:dropdown-enable toolbarx-test-any-type)
669 (:dropdown-visible toolbarx-test-any-type)
670 (:dropdown-insert toolbarx-test-any-type . and)
671 (:dropdown-help toolbarx-test-string-or-nil)
672 (:dropdown-toolbar toolbarx-test-toolbar-type)
673 (:dropdown-append-command toolbarx-test-any-type . progn)
674 (:dropdown-prepend-command toolbarx-test-any-type . progn)))
675 (possible-props (nreverse (let* ((props ()))
676 (dolist (p props-types-alist props)
677 (setq props (cons (car p) props))))))
678 (props-override (nreverse (let* ((props ()))
679 (dolist (p props-types-alist props)
681 (setq props (cons (car p) props)))))))
682 (props-add (nreverse (let* ((props ()))
683 (dolist (p props-types-alist props)
685 (setq props (cons (car p) props))))))))
686 (list props-types-alist possible-props props-override props-add))
687 "List yielding all encarnations of properties of a dropdown group.
688 First element: alist, where each element is of form
689 (PROP . (TYPE-TEST-FUNCTION . ADD-OR-NIL))
690 Second is a list with all properties.
691 Third, a list with properties that override when merging.
692 Fourth, a list of lists, each in the format (PROP ADD).
694 Convention: properties for the dropdown button should be formed
695 with the strings \":dropdown-\" with the button property name
696 without `:'. This is used on the implementation.")
698 (defun toolbarx-process-group-without-insert (group-without-props
699 merged-props-without-insert
700 meaning-alist switches)
701 "Return an updated version of SWITCHES.
702 GROUP-WITHOUT-PROPS and MERGED-PROPS-WITHOUT-INSERT are
703 preprocessed variables in `toolbarx-process-group'."
704 (let ((current-switches switches))
705 (dolist (i group-without-props current-switches)
706 (setq i (toolbarx-option-value i))
708 (setq current-switches
709 (toolbarx-process-symbol i meaning-alist
710 merged-props-without-insert
713 (setq current-switches
714 (toolbarx-process-group i meaning-alist
715 merged-props-without-insert
716 current-switches)))))))
718 (defun toolbarx-process-group (group meaning-alist props switches)
719 "Return an updated version of SWITCHES.
720 Append to already processed buttons (stored in SWITCHES) a
721 processed version of GROUP. Groups are useful to distribute
722 properties. External properties are given in PROPS, and merged
723 with the internal properties that are in the end of GROUP. If
724 properties (after merge) contain a `:insert' property, return a
725 list where the first and second elements are `:insert' and its
726 value, and after that a list in the same format as SWITCHES."
729 ((eq (car group) :dropdown-group)
730 (toolbarx-process-dropdown-group group meaning-alist props switches))
732 ((eq (car group) :eval-group)
733 (let ((current-switches switches))
734 (dolist (elt (cdr group) current-switches)
735 (let ((eval-elt (eval elt)))
736 (setq current-switches
737 (toolbarx-process-group (if (listp eval-elt)
741 current-switches))))))
744 (let* ((splited-props
745 (toolbarx-separate-options
746 group (append (nth 1 toolbarx-button-props)
747 (nth 1 toolbarx-dropdown-props))))
748 (intern-props (cdr splited-props))
749 (group-without-props (car splited-props))
751 (toolbarx-merge-props intern-props props
752 (append (nth 2 toolbarx-button-props)
753 (nth 2 toolbarx-dropdown-props))
754 (append (nth 3 toolbarx-button-props)
755 (nth 3 toolbarx-dropdown-props)))))
756 ;; check whether merged props have an `:insert'
757 (if (memq :insert merged-props)
758 ;; if yes, prepend switches with a (:insert cond elements)
759 (let* ((memq-ins (memq :insert merged-props))
760 (ins-val (if (and (listp (cadr memq-ins))
762 (car (cadr memq-ins))))
763 ;; if property is add-value property
766 (nth 0 toolbarx-button-props)))
767 (add-list (list (cddr p)))
769 (dolist (val (cdr (cadr memq-ins)))
770 (setq prop-good-val (funcall (cadr p) val))
771 (when (car prop-good-val)
772 (setq add-list (cons (cdr prop-good-val)
774 ;; return: (nreverse add-list)
775 (setq add-list (nreverse add-list))
776 (if (eq 2 (length add-list))
777 (cadr add-list) ; just 1 value, no
778 add-list)) ; add-function
779 ;; if property is not add-value
781 (merged-props-without-insert
782 (append (butlast merged-props (length memq-ins))
785 (toolbarx-process-group-without-insert
786 group-without-props merged-props-without-insert
789 (nreverse (cons (append (list :insert ins-val)
791 (nreverse switches))))
792 ;; if not, just append what is processed to switches
793 (toolbarx-process-group-without-insert group-without-props
794 merged-props meaning-alist
797 (defun toolbarx-process-symbol (symbol meaning-alist props switches)
798 "Process a button given by SYMBOL in MEANING-ALIST.
799 The processed button is appended in SWITCHES, which is returned.
800 Look for a association of SYMBOL in MEANING-ALIST for collecting
801 properties. Such association is a list that represents either a
802 normal button (a description of the button) or an alias
803 group (the symbol is an alias for a group of buttons). PROPS is
804 a externel list of properties that are merged and then applied to
805 the button. Scope is given by GLOBAL-FLAG."
806 ;; there are 3 situations: symbol is :new-line, there is an alias group
807 ;; or a normal button
808 (let ((button-assq (cdr (assq symbol meaning-alist))))
810 ((eq (car button-assq) :alias)
811 ;; button association is ALIAS GROUP is passed to
812 ;; `toolbarx-process-group' as is but without the car.
813 ;; return: (toolbarx-process-group... returns updates switch
814 (toolbarx-process-group (cdr button-assq) meaning-alist props switches))
816 ;; NORMAL BUTTON (association is a list of properties)
818 ;; properties need to be processed, that is, merge internal
819 ;; and external (given by PROPS) properties
820 (let* (;; button properties defined in `toolbarx-button-props'
821 (props-override (nth 2 toolbarx-button-props))
822 (props-add (nth 3 toolbarx-button-props))
823 ;; split considering also dropdown-group properties
825 (toolbarx-separate-options
827 (append (nth 1 toolbarx-button-props)
828 (nth 1 toolbarx-dropdown-props))))
829 (button-split-no-props (car button-assq-split))
830 (button-split-props (cdr button-assq-split))
831 ;; if there is no :image or :command in the props,
832 ;; try to get them from no-props part
833 (button-image-no-prop
834 (unless (memq :image button-split-props)
835 (when (> (length button-split-no-props) 0)
836 (list :image (nth 0 button-split-no-props)))))
837 (button-command-no-prop
838 (unless (memq :command button-split-props)
839 (when (> (length button-split-no-props) 1)
840 (list :command (nth 1 button-split-no-props)))))
841 (button-props (append button-split-props
843 button-command-no-prop))
845 (merged-props (toolbarx-merge-props button-props props
849 (nreverse (cons (cons symbol merged-props) (nreverse switches))))))))
851 (defun toolbarx-process-dropdown-group (dropdown meaning-alist props switches)
852 "Process buttons that appear according to dropdown menu.
853 Process a dropdown group DROPDOWN with meaning alist
854 MEANING-ALIST, external property list PROP and GLOBAL-FLAG
855 specifying scope. For a complete description, see documentation
856 of `toolbarx-install-toolbar'. The processed buttons are stored
857 in the end of SWITCHES, which is returned."
858 (let* ((dropdown-group (if (eq (car dropdown) :dropdown-group)
861 (dropdown-list-splited
862 (toolbarx-separate-options dropdown-group
864 (nth 1 toolbarx-button-props)
865 (nth 1 toolbarx-dropdown-props))))
866 (dropdown-list (car dropdown-list-splited))
867 (dropdown-props (cdr dropdown-list-splited))
869 (toolbarx-merge-props dropdown-props props
870 (append (nth 2 toolbarx-button-props)
871 (nth 2 toolbarx-dropdown-props))
872 (append (nth 3 toolbarx-button-props)
873 (nth 3 toolbarx-dropdown-props))))
874 (merged-props-button-only
875 (let* ((props-button-only)
877 (dolist (p (nth 1 toolbarx-button-props) props-button-only)
878 (setq prop (memq p merged-props))
880 (setq props-button-only
881 (append (list p (cadr prop))
882 props-button-only))))))
883 (merged-props-dropdown-only
884 (let* ((props-dropdown-only)
886 (dolist (p (nth 1 toolbarx-dropdown-props) props-dropdown-only)
887 (setq prop (memq p merged-props))
889 (setq props-dropdown-only
890 (append (list p (cadr prop))
891 props-dropdown-only))))))
892 ;; get value for each property and check type ONLY for props that do
893 ;; not concern the dropdown button, like `:type', `:save', etc. The
894 ;; props that concern the button are going to be handled in refresh
896 (filtered-dropdown-group-props-only
897 (let* ((filtered-props-temp)
901 (dolist (p (nth 0 toolbarx-dropdown-props) filtered-props-temp)
902 (unless (string-match "^:dropdown-.*$"
903 (symbol-name (car p)))
904 ;; property -> (car p)
905 ;; test type function -> (cadr p)
906 (setq prop (memq (car p) merged-props-dropdown-only))
907 ;; if so, check if value is of correct type
909 (setq prop-good-val (funcall (cadr p) (cadr prop)))
910 (if (car prop-good-val)
911 (setq filtered-props-temp
912 (append filtered-props-temp
913 (list (car p) (cdr prop-good-val))))
916 (format (concat "Wrong type for value in "
917 "property `%s' in dropdown group")
919 ;; properties for the dropdown button from dropdown merged properties
920 (dropdown-button-props
923 (dolist (pr (nth 1 toolbarx-dropdown-props))
924 (when (and (memq pr merged-props-dropdown-only)
925 (string-match "^:dropdown-\\(.*\\)$"
927 (let* ((new-pr (intern (concat ":"
928 (substring (symbol-name pr)
931 (val (cadr (memq pr merged-props-dropdown-only))))
932 (setq props (append (list new-pr val) props))))))
933 (unless (memq :image props)
934 (setq props (append (list :image "dropdown") props)))
936 (dropdown-button-without-command
937 (cons 'dropdown dropdown-button-props))
938 ;; `:type' defaults to `radio'
939 (type (if (memq :type filtered-dropdown-group-props-only)
940 (cadr (memq :type filtered-dropdown-group-props-only))
942 ;; `:default' defaults to 1 or nil depending on `type'
943 ;; if type is toggle and default is not a list, but a
944 ;; integer, set as the list with integer
946 (let* ((memq-default (memq :default
947 filtered-dropdown-group-props-only))
948 (def-temp (cadr memq-default))
949 (default-temp (if memq-default
951 (if (eq type 'radio) 1 (list 1)))))
953 ;; `:save' defaults to nil and require `:variable'
954 (save (let* ((save-temp
955 (when (memq :save filtered-dropdown-group-props-only)
957 filtered-dropdown-group-props-only)))))
960 filtered-dropdown-group-props-only)))
964 (concat "`:save' property with non-nil value should "
965 "be used only with the `:variable' property; "
966 "using value nil for `:save'."))
969 ;; `:title' defaults to nil
970 (title (when (memq :title filtered-dropdown-group-props-only)
971 (cadr (memq :title filtered-dropdown-group-props-only))))
972 ;; the menu variable is buildt from the `:variable' option or
973 ;; make a symbol not used
974 (variable (if (memq :variable filtered-dropdown-group-props-only)
975 (cadr (memq :variable
976 filtered-dropdown-group-props-only))
978 (symb (intern (format
979 "toolbarx-internal-menu-var-%d"
982 (setq count (1+ count))
984 (intern (format "toolbarx-internal-menu-var-%d"
987 ;; auxiliary variables
990 ;; setting `variable'
992 (custom-declare-variable
994 "Used as variable of dropdown menu defined with `toolbarx'.")
995 (when (not (boundp variable))
996 (set variable default)))
997 ;; now check `variable' content
999 (let ((val (eval variable)))
1000 (if (eq type 'toggle)
1006 ;; then, type is radio
1011 (integerp (car val)))
1014 ;; === buiding `list-strings' and `list-buttons' ===
1015 ;; if only symbols, build `list-strings' and `list-buttons' from symbols
1016 (if (let ((only-symbols-flag t))
1017 (dolist (i dropdown-list only-symbols-flag)
1018 (setq only-symbols-flag (and only-symbols-flag (symbolp i)))))
1020 (dolist (i dropdown-list)
1021 ;; list-strings and list-buttons are buildt reversed
1022 (setq list-strings (cons (toolbarx-make-string-from-symbol i)
1024 (setq count (1+ count))
1025 (setq list-buttons (cons (list i
1027 (if (eq type 'radio)
1028 (list 'eq count variable)
1029 (list 'memq count variable)))
1031 ;; if not, the it must start with string
1032 (unless (stringp (car dropdown-list))
1034 "If not all itens on dropdown are symbols, then a string"
1035 "must come before each set of buttons; no string found"
1036 "in first position."))
1039 (temp-list-buttons))
1040 (while dropdown-list
1041 (setq elem (car dropdown-list))
1042 (setq dropdown-list (cdr dropdown-list))
1044 ;; if string, output `temp-list-buttons' and prepair it again
1046 ;; list-strings and list-buttons are buildt reversed
1047 (setq list-strings (cons elem list-strings))
1048 (when temp-list-buttons
1049 (setq list-buttons (cons (append (nreverse temp-list-buttons)
1051 (if (eq type 'radio)
1057 (setq temp-list-buttons nil)
1058 (setq count (1+ count)))
1059 ;; else, if not string, just insert it to `temp-list-buttons'
1060 ;; which is also buildt reversed
1061 (setq temp-list-buttons (cons elem temp-list-buttons))))
1062 ;; output last temp list, left behind
1063 (when temp-list-buttons
1064 (setq list-buttons (cons (append (nreverse
1067 :insert (if (eq type 'radio)
1073 ;; lists were made reversed (elements inserted at the beginning)
1074 (setq list-strings (nreverse list-strings))
1075 (setq list-buttons (nreverse list-buttons))
1076 ;; now, pass `list-buttons' as a group to `toolbarx-process-group'
1077 (let ((current-switches switches))
1078 (setq current-switches
1079 (toolbarx-process-group list-buttons meaning-alist
1080 merged-props ; pass non-processed props
1082 (setq current-switches
1083 ;; outputing dropdown button
1084 (toolbarx-process-group (append dropdown-button-without-command
1086 (toolbarx-mount-popup-menu
1087 list-strings variable type
1089 meaning-alist merged-props-button-only
1095 ;; Still functions `toolbarx-install-toolbar' and `toolbarx-refresh'to
1096 ;; complete the parsing engine. Since they interface with other engines,
1097 ;; they must come in the end.
1099 ;;; How a image is made, giving a string as (part of) file name.
1101 ;; look at function `image-type-available-p' for Emacs !!!!
1103 (defun toolbarx-find-image (image)
1104 "Return image descriptor or glyph for IMAGE.
1105 In Emacs, return an image descriptor for IMAGE. In XEmacs,
1108 IMAGE is string. Usually IMAGE neither contains a directory nor
1109 an extension. If the extension is omitted, `xpm', `xbm' and
1110 `pbm' are tried. If the directory is omitted,
1111 `toolbarx-image-path' is searched."
1112 ;; `find-image' in Emacs 21 looks in `load-path' and `data-directory'. In
1113 ;; Emacs 22, we have `image-load-path' which includes `load-path' and
1114 ;; `data-directory'.
1116 ;; If there's some API in XEmacs to find the images, we should use it
1117 ;; instead of locate-library.
1119 ;; Emacs 22 has locate-file, but the other Emacsen don't. The
1120 ;; following should hopefully get us to all images ultimately.
1123 (dolist (i '("" ".xpm" ".xbm" ".pbm"))
1125 (setq file (locate-library (concat image i) t toolbarx-image-path))))
1126 (if (featurep 'xemacs)
1127 (and file (make-glyph file))
1130 (find-image `((:type xpm :file ,(concat image ".xpm"))
1131 (:type xbm :file ,(concat image ".xbm"))
1132 (:type pbm :file ,(concat image ".pbm"))))))))
1134 ;; next variable interfaces between parsing and display engines
1135 (defvar toolbarx-internal-button-switches nil
1136 "Store the list of processed buttons, used by `toolbarx-refresh'.
1137 This variable can store different values for the different buffers.")
1140 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1141 ;;; Second engine: display parsed buttons in Emacs
1143 (defun toolbarx-emacs-add-button (button used-keys keymap)
1144 "Insert a button where BUTTON is its description.
1145 USED-KEYS should be a list of symbols, where the first element is
1146 `:used-symbols'. This list should store the symbols of the
1147 buttons already inserted. This list is changed by side effect.
1148 KEYMAP is the keymap where the menu-item corresponding to the
1149 tool-bal button is going to be inserted. Insertion is made in
1152 BUTTON should be a list of form (SYMBOL . PROP-LIST). SYMBOL is
1153 a symbol that \"names\" this button. PROP-LIST is a list in the
1154 format (PROP VAL ... PROP VAL). The supported properties are
1155 `:image', `:command', `:append-command', `:prepend-command',
1156 `:help', `:enable', `:visible', `:button', `:insert' and
1157 `:toolbar'. For a description of properties, see documentation of
1158 function `toolbar-install-toolbar'."
1159 (let* ((symbol (nth 0 button))
1160 (used-keys-list (when used-keys
1163 (let* ((filtered-props-temp)
1166 (dolist (p (nth 0 toolbarx-button-props) filtered-props-temp)
1167 ;; property -> (car p)
1168 ;; test type function -> (cadr p)
1169 ;; add-function -> (cddr p)
1170 (setq prop (memq (car p) button))
1171 ;; if so, check if value is of correct type
1173 ;; if property is of add-type, them the value is a list
1174 ;; (:add-value-list VAL VAL). Each VAL should be checked.
1175 (if (and (cddr p) (eq :add-value-list (car (cadr prop))))
1176 (let* ((add-list (list (cddr p))))
1177 (dolist (val (cdr (cadr prop)))
1178 (setq prop-good-val (funcall (cadr p) val))
1179 (when (car prop-good-val)
1180 (setq add-list (cons (cdr prop-good-val) add-list))))
1181 (setq add-list (nreverse add-list))
1182 (when (eq 2 (length add-list)) ; just 1 value, no
1184 (setq add-list (cadr add-list)))
1185 (setq filtered-props-temp (append
1186 (list (car p) add-list)
1187 filtered-props-temp)))
1188 ;; if override-property
1189 (setq prop-good-val (funcall (cadr p) (cadr prop)))
1190 (when (car prop-good-val)
1191 (setq filtered-props-temp (append
1193 (cdr prop-good-val))
1194 filtered-props-temp))))))))
1195 (insert (or (not (memq :insert filtered-props))
1196 ;; (memq :insert filtered-props)
1197 (eval (nth 1 (memq :insert filtered-props))))))
1201 ;; symbol is not :new-line, therefore a normal button
1202 (let* ((image (cadr (memq :image filtered-props)))
1204 (when (memq :image filtered-props)
1206 ((stringp image) ; string
1207 (toolbarx-find-image image))
1208 ((and (consp image) ; or image descriptor
1209 (eq (car image) 'image))
1211 ((and (symbolp image) ; or a symbol bound to a
1212 (boundp image) ; image descriptor (defined
1214 (consp (eval image))
1215 (eq (car (eval image)) 'image))
1217 (t ; otherwise, must be a list
1218 ; with 4 strings or image
1220 (apply 'vector (mapcar (lambda (img)
1222 (toolbarx-find-image img)
1226 (let* ((com (nth 1 (memq :command filtered-props)))
1227 (app (nth 1 (memq :append-command filtered-props)))
1228 (prep (nth 1 (memq :prepend-command filtered-props))))
1229 (when (or com app prep)
1230 (toolbarx-make-command com prep app))))
1231 (help (cons (memq :help filtered-props)
1232 (cadr (memq :help filtered-props))))
1233 (enable (cons (memq :enable filtered-props)
1234 (cadr (memq :enable filtered-props))))
1235 (visible (cons (memq :visible filtered-props)
1236 (cadr (memq :visible filtered-props))))
1237 (button (cons (memq :button filtered-props)
1238 (cadr (memq :button filtered-props))))
1241 (toolbarx-make-string-from-symbol symbol)
1243 :image image-descriptor)
1245 (list :help (cdr help)))
1247 (list :enable (cdr enable)))
1249 (list :visible (cdr visible)))
1251 (list :button (cdr button)))))
1255 (while (memq symb used-keys-list)
1256 (setq count (1+ count))
1257 (setq symb (intern (format "%s-%d" symbol count))))
1259 (when (and image-descriptor command)
1260 (setq used-keys-list (cons key-not-used used-keys-list))
1261 (define-key-after keymap
1262 (vector key-not-used) menuitem))))))
1263 (when used-keys (setcdr used-keys used-keys-list))))
1266 (defun toolbarx-emacs-refresh-process-button-or-insert-list (switches
1269 "Process SWITCHES, inserting buttons in `tool-bar-map'.
1270 If a button is actually a `:insert' clause group (if `car' is
1271 `:insert') and evaluation of `cdr' yields non-nil, process `cddr'
1272 recursively as SWITCHES. USED-KEYS is a list which `car' is
1273 `:used-symbols' and which `cdr' is a list of symbols that have already
1274 been used as keys in the keymap `tool-bar-map'."
1275 (dolist (button switches)
1276 (if (eq (car button) :insert)
1277 (when (eval (cadr button))
1278 (toolbarx-emacs-refresh-process-button-or-insert-list (cddr button)
1281 (toolbarx-emacs-add-button button used-keys keymap))))
1285 (defun toolbarx-emacs-refresh (&optional global-flag)
1286 "Refresh and redraw the toolbar in Emacs.
1287 If GLOBAL-FLAG is non-nil, the default value of toolbar switches
1288 is used and the default value of `toolbarx-map' is changed."
1289 (let* ((switches (if global-flag
1290 (if (default-boundp 'toolbarx-internal-button-switches)
1291 (default-value 'toolbarx-internal-button-switches)
1292 toolbarx-internal-button-switches)
1293 toolbarx-internal-button-switches))
1294 (used-keys (list :used-symbols nil))
1295 (tool-bar-map-temp (make-sparse-keymap)))
1296 (toolbarx-emacs-refresh-process-button-or-insert-list switches used-keys
1299 (setq-default tool-bar-map tool-bar-map-temp)
1300 (setq tool-bar-map tool-bar-map-temp))))
1303 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1304 ;;; Third engine: display parsed buttons in XEmacs
1306 (defun toolbarx-xemacs-image-properties (image)
1307 "Return a list of properties of IMAGE.
1308 IMAGE should be a string or a list of one to six strings or
1309 glyphs or nil, or a symbol bound to a list of one to six
1310 glyphs (them must be a valid image list, like one created with
1311 the function `toolbar-make-button-list'). Return a
1312 list (GLYPH-LIST HEIGHT WIDTH) where HEIGHT (resp. WIDTH) is the
1313 maximum of the heights (resp. widths) of all glyphs (or strings
1314 converted to glyphs) in GLYPH-LIST. If IMAGE is not a list, it
1315 is treated as a list with IMAGE as only element. Strings are
1316 converted to glyphs with the function `toolbarx-find-image'. If,
1317 after possible string-to-glyph convertions, the list of glyphs
1318 has nil as first element, GLYPH-LIST becomes nil."
1320 (if (symbolp image) ; if symbol, them must be a
1321 ; valid image list, like
1322 ; created by function
1323 ; `toolbar-make-button-list'
1325 (let ((img-list (if (listp image)
1330 (setq glyph-list-temp
1331 (dolist (glyph img-list (nreverse glyph-list-temp))
1333 (setq glyph-list-temp
1334 (cons (toolbarx-find-image glyph)
1336 (setq glyph-list-temp (cons glyph glyph-list-temp)))))
1337 (unless (car glyph-list-temp)
1338 (setq glyph-list-temp nil))
1341 ;; computing inheritage
1342 (let* ((usable-temp))
1343 (if toolbar-captioned-p ; problematic point :-(
1345 ;; CAP-UP: cap-up -> up
1346 (setq usable-temp (cons (cond
1347 ((nth 3 glyph-list))
1348 ((nth 0 glyph-list)))
1350 ;; CAP-DOWN: cap-down -> cap-up -> down -> up
1351 (setq usable-temp (cons (cond
1352 ((nth 4 glyph-list))
1353 ((nth 3 glyph-list))
1354 ((nth 1 glyph-list))
1355 ((nth 0 glyph-list)))
1357 ;; CAP-DISABLED: cap-disabled -> cap-up -> disabled -> up
1358 (setq usable-temp (cons (cond
1359 ((nth 5 glyph-list))
1360 ((nth 3 glyph-list))
1361 ((nth 2 glyph-list))
1362 ((nth 0 glyph-list)))
1365 (setq usable-temp (cons (nth 0 glyph-list) usable-temp))
1367 (setq usable-temp (cons (cond
1368 ((nth 1 glyph-list))
1369 ((nth 0 glyph-list)))
1371 ;; DISABLED: disabled -> up
1372 (setq usable-temp (cons (cond
1373 ((nth 2 glyph-list))
1374 ((nth 0 glyph-list)))
1377 (height (apply 'max 0 (mapcar (lambda (glyph)
1379 (glyph-height glyph)
1382 (width (apply 'max 0 (mapcar (lambda (glyph)
1387 (list (if (symbolp image) image glyph-list) height width)))
1391 (defun toolbarx-xemacs-button-properties (button)
1392 "Return a list of properties of BUTTON.
1393 The result is either nil (if not to be inserted) or a list in the format
1394 (TOOLBAR HEIGHT WIDTH BUTTON-DESCRIPTION)
1397 TOOLBAR is one of the symbols `default', `top', `right', `bottom'
1400 HEIGHT and WIDTH are the maximal dimentions of all the glyphs
1403 BUTTON-DESCRIPTION is button definition in XEmacs; see the
1404 documentation of variable `default-toolbar'."
1405 (let* ((filtered-props
1406 (let* ((filtered-props-temp)
1409 (dolist (p (nth 0 toolbarx-button-props) filtered-props-temp)
1410 ;; property -> (car p)
1411 ;; test type function -> (cadr p)
1412 ;; add-function -> (cddr p)
1413 (setq prop (memq (car p) button))
1414 ;; if so, check if value is of correct type
1416 ;; if property is of add-type, them the value is a list
1417 ;; (:add-value-list VAL VAL). Each VAL should be checked.
1418 (if (and (cddr p) (eq :add-value-list (car (cadr prop))))
1419 (let* ((add-list (list (cddr p))))
1420 (dolist (val (cdr (cadr prop)))
1421 (setq prop-good-val (funcall (cadr p) val))
1422 (when (car prop-good-val)
1423 (setq add-list (cons (cdr prop-good-val) add-list))))
1424 (setq add-list (nreverse add-list))
1425 (when (eq 2 (length add-list)) ; just 1 value, no
1427 (setq add-list (cadr add-list)))
1428 (setq filtered-props-temp (append
1429 (list (car p) add-list)
1430 filtered-props-temp)))
1431 ;; if override-property
1432 (setq prop-good-val (funcall (cadr p) (cadr prop)))
1433 (when (car prop-good-val)
1434 (setq filtered-props-temp (append
1436 (cdr prop-good-val))
1437 filtered-props-temp))))))))
1438 (insert (or (not (memq :insert filtered-props))
1439 ;; (memq :insert filtered-props) holds
1440 (eval (nth 1 (memq :insert filtered-props))))))
1442 (let* ((image-props (toolbarx-xemacs-image-properties
1443 (cadr (memq :image filtered-props))))
1444 (glyph-list (car image-props))
1445 (image-height (nth 1 image-props))
1446 (image-width (nth 2 image-props))
1448 (let* ((com (nth 1 (memq :command filtered-props)))
1449 (app (nth 1 (memq :append-command filtered-props)))
1450 (prep (nth 1 (memq :prepend-command filtered-props))))
1451 (when (or com app prep)
1452 (toolbarx-make-command com prep app))))
1453 ;; enable defaults to `t'
1454 (enable (if (memq :enable filtered-props)
1455 (cadr (memq :enable filtered-props))
1457 ;; help defaults to nil
1458 (help (when (memq :help filtered-props)
1459 (cadr (memq :help filtered-props))))
1460 ;; toolbar defaults to `default'
1461 (toolbar-prop (cons (memq :toolbar filtered-props)
1462 (cadr (memq :toolbar filtered-props))))
1463 (toolbar (if (car toolbar-prop)
1464 (if (symbolp (cdr toolbar-prop))
1466 ;; (cdr toolbar-prop) is cons cell
1467 (if (eq (cadr toolbar-prop)
1468 (default-toolbar-position))
1470 (cadr toolbar-prop)))
1473 (list toolbar image-height image-width
1474 (vector glyph-list command enable help)))))))
1476 (defun toolbarx-xemacs-refresh-process-button-or-insert-list (switches
1478 "Process SWITCHES, returning an updated version of TOOLBAR-PROPS.
1479 TOOLBAR-PROPS should be a list with 12 elements, each one representing
1480 properties (in this order) `locale', `default', `top', `right',
1481 `bottom', `left', `default-height', `default-width', `top-height',
1482 `right-width', `bottom-height' and `left-width'. The return is a list
1483 with the same properties updated.
1485 NB: Buttons (vectors) are inserted in front of the lists
1486 represented by `default', `top', `right', `bottom' and `left', so
1487 the lists are built reversed."
1488 (let ((locale (nth 0 toolbar-props))
1489 (default (nth 1 toolbar-props))
1490 (top (nth 2 toolbar-props))
1491 (right (nth 3 toolbar-props))
1492 (bottom (nth 4 toolbar-props))
1493 (left (nth 5 toolbar-props))
1494 (default-height (nth 6 toolbar-props))
1495 (default-width (nth 7 toolbar-props))
1496 (top-height (nth 8 toolbar-props))
1497 (right-width (nth 9 toolbar-props))
1498 (bottom-height (nth 10 toolbar-props))
1499 (left-width (nth 11 toolbar-props))
1500 (toolbar-props-temp))
1501 (dolist (button switches)
1502 (if (eq (car button) :insert)
1503 (when (eval (cadr button))
1504 ;; if insert group, process `cddr'
1506 (setq toolbar-props-temp
1507 (toolbarx-xemacs-refresh-process-button-or-insert-list
1509 (list locale default top right bottom left
1510 default-height default-width top-height
1511 right-width bottom-height left-width)))
1512 (setq default (nth 1 toolbar-props-temp))
1513 (setq top (nth 2 toolbar-props-temp))
1514 (setq right (nth 3 toolbar-props-temp))
1515 (setq bottom (nth 4 toolbar-props-temp))
1516 (setq left (nth 5 toolbar-props-temp))
1517 (setq default-height (nth 6 toolbar-props-temp))
1518 (setq default-width (nth 7 toolbar-props-temp))
1519 (setq top-height (nth 8 toolbar-props-temp))
1520 (setq right-width (nth 9 toolbar-props-temp))
1521 (setq bottom-height (nth 10 toolbar-props-temp))
1522 (setq left-width (nth 11 toolbar-props-temp))))
1523 ;; else, if normal button
1524 (let* ((button-props (toolbarx-xemacs-button-properties button))
1525 (toolbar (nth 0 button-props))
1526 (height (nth 1 button-props))
1527 (width (nth 2 button-props))
1528 (button-description (nth 3 button-props)))
1532 ((eq toolbar 'default)
1533 (setq default (cons button-description default))
1534 (setq default-height (max default-height height))
1535 (setq default-width (max default-width width)))
1538 (setq top (cons button-description top))
1539 (setq top-height (max top-height height)))
1541 ((eq toolbar 'right)
1542 (setq right (cons button-description right))
1543 (setq right-width (max right-width width)))
1545 ((eq toolbar 'bottom)
1546 (setq bottom (cons button-description bottom))
1547 (setq bottom-height (max bottom-height height)))
1550 (setq left (cons button-description left))
1551 (setq left-width (max left-width width))))))))
1552 ;; return a list similar to toolbar-props
1553 (list locale default top right bottom left default-height
1554 default-width top-height right-width bottom-height left-width)))
1557 (defun toolbarx-xemacs-refresh (&optional global-flag)
1558 "Refresh the toolbar in XEmacs."
1559 (let* ((switches (if global-flag
1560 (if (default-boundp 'toolbarx-internal-button-switches)
1561 (default-value 'toolbarx-internal-button-switches)
1562 toolbarx-internal-button-switches)
1563 toolbarx-internal-button-switches))
1564 (locale (if global-flag 'global (current-buffer)))
1565 (toolbar-init (list locale ; locale
1578 (toolbarx-xemacs-refresh-process-button-or-insert-list switches
1580 ;; NB: Buttons (vectors) are inserted in front of the lists
1581 ;; represented by `default', `top', `right', `bottom' and
1582 ;; `left', so the lists are built reversed.
1583 (default (nreverse (nth 1 toolbar-props)))
1584 (top (nreverse (nth 2 toolbar-props)))
1585 (right (nreverse (nth 3 toolbar-props)))
1586 (bottom (nreverse (nth 4 toolbar-props)))
1587 (left (nreverse (nth 5 toolbar-props)))
1588 (default-height (nth 6 toolbar-props))
1589 (default-width (nth 7 toolbar-props))
1590 (top-height (nth 8 toolbar-props))
1591 (right-width (nth 9 toolbar-props))
1592 (bottom-height (nth 10 toolbar-props))
1593 (left-width (nth 11 toolbar-props))
1594 (button-raised-border 2)
1595 (default-border (specifier-instance default-toolbar-border-width))
1596 (top-border (specifier-instance top-toolbar-border-width))
1597 (right-border (specifier-instance right-toolbar-border-width))
1598 (bottom-border (specifier-instance bottom-toolbar-border-width))
1599 (left-border (specifier-instance left-toolbar-border-width)))
1602 (setq default-height (+ (* 2 button-raised-border)
1603 (* 2 default-border)
1605 (setq default-width (+ (* 2 button-raised-border)
1606 (* 2 default-border)
1609 (setq top-height (+ (* 2 button-raised-border)
1613 (setq right-width (+ (* 2 button-raised-border)
1617 (setq bottom-height (+ (* 2 button-raised-border)
1621 (setq left-width (+ (* 2 button-raised-border)
1624 ;; deal with specifiers
1625 ;; - remove all specifiers for toolbars witout buttons
1628 ;; Only activate the tool bar if it is already visible.
1629 (when toolbar-visible-p
1630 (set-specifier default-toolbar-visible-p (not (not default)) locale)
1631 (if (memq (default-toolbar-position) '(top bottom))
1632 (set-specifier default-toolbar-height default-height locale)
1633 (set-specifier default-toolbar-width default-width locale)))
1634 (set-specifier default-toolbar default locale))
1635 (remove-specifier default-toolbar locale)
1636 (remove-specifier default-toolbar-visible-p locale)
1637 (remove-specifier default-toolbar-height locale)
1638 (remove-specifier default-toolbar-width locale))
1641 (set-specifier top-toolbar-visible-p (not (not top)) locale)
1642 (set-specifier top-toolbar-height top-height locale)
1643 (set-specifier top-toolbar top locale))
1644 (remove-specifier top-toolbar locale)
1645 (remove-specifier top-toolbar-visible-p locale)
1646 (remove-specifier top-toolbar-height locale))
1649 (set-specifier right-toolbar-visible-p (not (not right))
1651 (set-specifier right-toolbar-width right-width locale)
1652 (set-specifier right-toolbar right locale))
1653 (remove-specifier right-toolbar locale)
1654 (remove-specifier right-toolbar-visible-p locale)
1655 (remove-specifier right-toolbar-width locale))
1658 (set-specifier bottom-toolbar-visible-p (not (not bottom)) locale)
1659 (set-specifier bottom-toolbar-height bottom-height locale)
1660 (set-specifier bottom-toolbar bottom locale))
1661 (remove-specifier bottom-toolbar locale)
1662 (remove-specifier bottom-toolbar-visible-p locale)
1663 (remove-specifier bottom-toolbar-height locale))
1666 (set-specifier left-toolbar-visible-p (not (not left)) locale)
1667 (set-specifier left-toolbar-width left-width locale)
1668 (set-specifier left-toolbar left locale))
1669 (remove-specifier left-toolbar locale)
1670 (remove-specifier left-toolbar-visible-p locale)
1671 (remove-specifier left-toolbar-width locale))))
1674 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1675 ;;; finishing parsing engine
1677 (defun toolbarx-refresh (&optional global-flag)
1678 "Redraw the toolbar, peviously installed with `toolbarx'.
1679 Force global refresh if GLOBAL-FLAG is non-nil."
1681 (if (featurep 'xemacs)
1682 (toolbarx-xemacs-refresh global-flag)
1683 (toolbarx-emacs-refresh global-flag)))
1685 ;;;###autoload (autoload 'toolbarx-install-toolbar "toolbar-x")
1687 (defun toolbarx-install-toolbar (buttons &optional meaning-alist global-flag)
1688 "Install toolbar buttons given in BUTTONS.
1689 Button properties are optionally given in MEANING-ALIST. If
1690 GLOBAL-FLAG is non-nil, toolbar is installed globally (on every
1691 buffer that does not have a toolbar set locally). BUTTONS is a
1693 (ELEM ... ELEM . PROPS),
1694 where each ELEM is either
1696 - a list in the same format od BUTTONS, which is going to be
1697 refered as a *group*; groups are used to distribute properties
1698 recursively to its elements; there are groups with special
1699 format for special purpose: *dropdown groups* and also *eval
1702 - a symbol, which could be associated in MEANING-ALIST with a
1703 list of button properties (symbol + properties = a *button*)
1704 or associated to a special kind of group (an *alias group*).
1706 - a vector, which elements are on the previous formats (but not
1707 another vector); this is useful to specify different
1708 ingredients to the toolbar depending if editor is Emacs or
1709 XEmacs; the first element will be used in Emacs; the second
1710 element is going to be used in XEmacs.
1715 MEANING-ALIST is a list where each element is in one of the
1716 formats (SYMB . BUTTON-PROPS-LIST) or (SYMB . ALIAS-GROUP).
1717 BUTTON-PROPS-LIST is a list in one of the formats
1718 (IMAGE COMMAND PROP VAL PROP VAL ... PROP VAL) or
1719 (PROP VAL PROP VAL ... PROP VAL).
1720 The IMAGE is going to be used as the `:image' property of the
1721 button (see button properties bellow), and COMMAND shall be used
1722 as the `:command' property of the button. Each PROP is one of
1723 the button properties, and VAL is its respective value.
1724 ALIAS-GROUP is a list which first element is the symbol `:alias'
1725 and the cdr shall be processed as a group.
1727 However, a symbol is not required to have an association in
1728 MEANING-ALIST, which is only a way to specify properties to a
1729 button. One can use groups to specify properties. Nil is a good
1735 A toolbar button in `toolbarx' is the set with a symbol and
1736 properties used to display the button, like a image and a command
1737 to call when the button is pressed (which are the minimal
1738 elements that a button should have.) The supported properties
1739 for buttons and their `basic types' (see note on how values of
1740 properties are obtained!) are:
1742 :image -- in Emacs, either a string or image descriptor (see
1743 info for a definition), or a variable bound to a image
1744 descriptor (like those defined with `defimage') or a list of 4
1745 strings or image descriptors; in XEmacs, either a string or a
1746 glyph, or a symbol bount to a glyph, or a list of at least 1
1747 and at most 6 strings or glyphs or nil (not the first element
1748 though); defines the image file displayed by the button. If
1749 it is a string, the image file found with that name (always
1750 using the function `toolbarx-find-image' to make the
1751 \`internal\' image descriptor) is used as button image. For
1752 the other formats, the button image is handled in the same way
1753 as it is treated by the editors; see info nodes bellow for a
1754 description of the capabilities of each editor
1755 Emacs: info file \"elisp\", node \"Tool Bar\" (see `:image'
1757 PS: a *vector* of four strings is used in the Emacs
1758 Lisp documentation as the `more ellaborated' image
1759 property format, but here we reserve vectors to
1760 provide editor-dependent values; this motivates our
1761 choice for a list instead of vector (however,
1762 internally the list becomes a vector when displaying
1764 XEmacs: info file \"lispref\", node \"Toolbar Descriptor
1765 Format\" (see GLYPH-LIST) or the documentation of
1766 the variable `default-toolbar'; check the inheritage
1767 in case of a ommited glyph or nil instead of glyph.
1769 :command -- a form; if the form happens to be a command, it will
1770 be called with `call-interactively'.
1772 :append-command -- a form added to the end of the value of
1775 :prepend-command -- a form added at the beginning of the value
1778 :help -- either a string or nil; defined the help string of the
1781 :enable -- a form, evaluated constantly by both editors to
1782 determine if a button is active (enabled) or not.
1784 :visible -- in Emacs, a form that is evaluated constantly to
1785 determine if a button is visible; in XEmacs, this property is
1788 :button -- in Emacs, a cons cell (TYPE . SELECTED) where the
1789 TYPE should be `:toggle' or `:radio' and the cdr should be a
1790 form. SELECTED is evaluated to determine when the button is
1791 selected. This property is ignored in XEmacs.
1793 :insert -- a form that is evaluated every time that the toolbar
1794 is refresh (a call of `toolbarx-refresh') to determine if the
1795 button is inserted or just ignored (until next refresh).
1797 :toolbar -- in XEmacs, either one of the symbols `default',
1798 `top', `bottom', `left', `right', or a cons cell
1799 (POS . POS-AVOID-DEFAULT) where POS and POS-AVOID-DEFAULT
1800 should be one of the symbols `top', `bottom', `left', `right';
1801 if a symbol, the button will be inserted in one of these
1802 toolbars; if a cons cell, button will be inserted in toolbar
1803 POS unless the position of the default toolbar is POS (then,
1804 the default toolbar would override the position-specific
1805 toolbar), and in this case, button will be inserted in toolbar
1806 POS-AVOID-DEFAULT; in Emacs, this property is meaningless, and
1807 therefore ignored. Hint of use of this property: in a
1808 program, use or everything with `default' and the cons format
1809 to avoid the default toolbar, or use only the position
1810 specific buttons (symbols that are not `default'), because of
1811 the `overriding' system in XEmacs, when a position-specific
1812 toolbar overrides the default toolbar; for instance, if you
1813 put a button in the default toolbar and another in the top
1814 toolbar (and the default toolbar is in the top), then *only*
1815 the ones in the top toolbar will be visible!
1817 How to specify a button
1818 =======================
1820 One can specify a button by its symbol or by a group to specify
1821 properties. For example,
1824 (bar :image [\"bar-Emacs\" \"bar-XEmacs\"]
1825 :command bar-function :help \"Bar help string\")
1827 MEANING-ALIST = ( (foo :image \"foo\" :command foo-function) )
1828 specifiy two buttons `foo' and `bar', each one with its necessary
1829 :image and :command properties, and both use the :insert property
1830 specified ate the end of BUTTONS (because groups distribute
1831 properties to all its elements). `foo' and `bar' will be
1832 inserted only if `foo-bar' evaluation yields non-nil. `bar' used
1833 a different :image property depending if editor is Emacs or
1836 Note on how values of properties are obtained
1837 =============================================
1839 For each property PROP, its value should be either:
1840 i) a vector of 2 elements; then each element should be of the
1842 ii) an element on the basic type of PROP.
1843 iii) a function (that does not need arguments); it is evaluated
1844 and the return should be ot type i) or ii) above
1845 iv) a symbol bound to a element of type i) or ii).
1847 The type is cheched in the order i), ii) iii) and iv). This
1848 evaluations are done every time that the oolbar is refresh.
1850 Ps.: in order to specify a vector as value of a property (like
1851 the :image in Emacs), it is necessary to provide the vector as
1852 element of another vector.
1860 If the first element of a group is the symbol `:eval-group', each
1861 element is evaluated (with `eval'), put inside a list and
1862 processed like a group. Eval groups are useful to store
1863 definition of buttons in a variable.
1868 The idea is to specify a set of buttons that appear when a
1869 determined menu item of a dropdown menu is active. The dropdown
1870 menu appears when a button (by default with a triangle pointing
1871 down) is clicked. This button is called `dropdown button'. The
1872 dropdown button appears on the left of the currently visible
1873 buttons of the dropdown group.
1875 A dropdown group is a list which first element is the symbol
1876 `:dropdown-group' and in one of the following formats
1877 (:dropdown-group SYMBOL-1 ... SYMBOL-n PROP-1 VAL-1 ... PROP-k VAL-k)
1880 STRING-1 ITEM-11 ... ITEM-1n
1881 STRING-2 ITEM-21 ... ITEM-2m
1883 STRING-n ITEM-n1 ... ITEM-np
1884 PROP-1 VAL-1 ... PROP-j VAL-j)
1886 SYMBOL-* is a symbol that defines a button in MEANING-ALIST;
1887 STRING-* is a string that will appear in the dropdown menu;
1888 ITEM-* is any format that define buttons or groups.
1890 \(a dropdown group of first format is internally converted to the
1891 second by making strings from the symbols and each symbol is the
1894 The same rules for obtaining property values, described above,
1895 apply here. Properties are also distributed by groups. The
1896 supported properties and their basic type are:
1898 :type -- one of the symbols `radio' (default) or `toggle'; if
1899 type is radio, only one of the itens may be active, and if
1900 type is toggle, any item number of itens can be active.
1902 :variable -- a symbol; it is the variable that govern the
1903 dropdown button; every time the value should be an integer
1904 starting from 1 (if type is radio) or a list of integers (if
1905 type is toggle). The Nth set of buttons is :insert'ed.
1907 :default -- determines the default value when the menu is
1908 installed; it is ignored if a value was saved with custom; it
1909 defaults to 1 if type is radio or nil if type is toggle. If
1910 value is a integer and type is `toggle', value used is a list
1913 :save -- one of the symbols nil (default), `offer' or
1914 `always'; determined if it is possible for the user to save
1915 the which menu itens are active, for a next session. If value
1916 is `offer', a item (offering to save) is added to the
1917 popup menu. If the value is `always', every time that a item
1918 is selected, the variable is saved. If value is nil, variable
1919 shall not be saved. If value is non-nil then `:variable' is
1922 :title -- a string or nil; if a string, the popup menu will show
1923 is as menu title; if nil, no title is shown.
1925 :dropdown-help -- a string or nil; the help string of the
1928 :dropdown-image -- in Emacs, either a string or a vector of 4
1929 strings; in XEmacs, either a string or a glyph or a list of at
1930 least 1 and at most 6 strings or glyphs; defines the image
1931 file displayed by the dropdown button; by default, it is the
1932 string \"dropdown\".
1934 :dropdown-append-command,
1935 :dropdownprepend-command -- a form; append or prepend forms to
1936 the command that shows the dropdown menu, allowing extra code
1937 to run before or after the menu appears (remember that every
1938 menu item clicked refresh the toolbar.)
1940 :dropdown-enable -- a form; evaluated constantly by both editors
1941 to determine if the dropdown button is active (enabled) or
1944 :dropdown-visible -- a form; in Emacs, it is evaluated
1945 constantly to determine if the dropdown button is visible; in
1946 XEmacs, this property is ignored.
1948 :dropdown-toolbar -- in XEmacs, one of the symbols `default',
1949 `opposite', `top', `bottom', `left' or `right'; ignored in
1950 Emacs; in XEmacs, the toolbar where the dropdown button will
1953 Also, if the symbol `dropdown' is associted in MEANING-ALIST
1954 with some properties, these properties override (or add) with
1960 If the symbol of a button is `:new-line', it is inserted
1961 a (faked) return, and the next button will be displayed a next
1962 line of buttons. The only property supported for this button is
1963 `:insert'. This feature is available only in Emacs. In XEmacs,
1964 this button is ignored."
1965 (let ((switches (toolbarx-process-group buttons meaning-alist nil nil)))
1967 (setq-default toolbarx-internal-button-switches
1969 (set (make-local-variable 'toolbarx-internal-button-switches)
1971 (unless (featurep 'xemacs)
1972 (make-local-variable 'tool-bar-map))))
1973 (toolbarx-refresh global-flag))
1976 (defconst toolbarx-default-toolbar-meaning-alist
1977 `((separator :image "sep" :command t :enable nil :help "")
1979 (,(if (and (not (featurep 'xemacs)) (>= emacs-major-version 22))
1982 :image ["new" toolbar-file-icon]
1983 :command [find-file toolbar-open]
1984 :enable [(not (window-minibuffer-p
1985 (frame-selected-window menu-updating-frame)))
1987 :help ["Specify a new file's name, to edit the file" "Visit new file"])
1989 ,(when (and (not (featurep 'xemacs)) (>= emacs-major-version 22))
1990 '(open-file :image ["open" toolbar-file-icon]
1991 :command [menu-find-file-existing toolbar-open]
1992 :enable [(not (window-minibuffer-p
1993 (frame-selected-window menu-updating-frame)))
1995 :help ["Read a file into an Emacs buffer" "Open a file"]))
1997 (dired :image [,(if (>= emacs-major-version 22)
2000 toolbar-folder-icon]
2001 :command [dired toolbar-dired]
2002 :help ["Read a directory, operate on its files" "Edit a directory"])
2004 (save-buffer :image ["save" toolbar-disk-icon]
2005 :command [save-buffer toolbar-save]
2009 (not (window-minibuffer-p
2010 (frame-selected-window menu-updating-frame))))
2012 :help ["Save current buffer to its file" "Save buffer"]
2013 :visible (or buffer-file-name
2015 (get major-mode 'mode-class)))))
2018 (write-file :image "saveas"
2021 (window-minibuffer-p
2022 (frame-selected-window menu-updating-frame)))
2024 :help "Write current buffer to another file"
2025 :visible (or buffer-file-name
2026 (not (eq 'special (get major-mode 'mode-class)))))
2028 (undo :image ["undo" toolbar-undo-icon]
2029 :command [undo toolbar-undo]
2030 :enable [(and (not buffer-read-only)
2031 (not (eq t buffer-undo-list))
2032 (if (eq last-command 'undo)
2034 (consp buffer-undo-list)))
2036 :help ["Undo last operation" "Undo edit"]
2037 :visible (not (eq 'special (get major-mode 'mode-class))))
2039 (cut :image ["cut" toolbar-cut-icon]
2040 :help ["Delete text in region and copy it to the clipboard"
2042 :command [clipboard-kill-region toolbar-cut]
2043 :visible (not (eq 'special (get major-mode 'mode-class))))
2045 (copy :image ["copy" toolbar-copy-icon]
2046 :help ["Copy text in region to the clipboard" "Copy region"]
2047 :command [clipboard-kill-ring-save toolbar-copy])
2049 (paste :image ["paste" toolbar-paste-icon]
2050 :help ["Paste text from clipboard" "Paste from clipboard"]
2051 :command [clipboard-yank toolbar-paste]
2052 :visible (not (eq 'special (get major-mode 'mode-class))))
2055 (search-forward :command nonincremental-search-forward
2056 :help "Search forward for a string"
2061 :image ["search-replace" toolbar-replace-icon]
2062 :command [query-replace toolbar-replace]
2063 :help ["Replace string interactively, ask about each occurrence"
2064 "Search & Replace"])
2066 (print-buffer :image ["print" toolbar-printer-icon]
2067 :command [print-buffer toolbar-print]
2068 :help ["Print current buffer with page headings"
2072 (customize :image "preferences"
2074 :help "Edit preferences (customize)"
2079 :command (lambda () (interactive) (popup-menu menu-bar-help-menu))
2080 :help "Pop up the Help menu"
2084 (kill-buffer :command kill-this-buffer
2085 :enable (kill-this-buffer-enabled-p)
2086 :help "Discard current buffer"
2091 (exit-emacs :image "exit"
2092 :command save-buffers-kill-emacs
2093 :help "Offer to save unsaved buffers, then exit Emacs"
2096 (spell-buffer :image ["spell" toolbar-spell-icon]
2097 :command [ispell-buffer toolbar-ispell]
2098 :help ["Check spelling of selected buffer" "Check spelling"])
2100 (info :image ["info" toolbar-info-icon]
2101 :command [info toolbar-info]
2102 :help ["Enter Info, the documentation browser" "Info documentation"])
2105 (mail :image toolbar-mail-icon
2106 :command toolbar-mail
2111 (compile :image toolbar-compile-icon
2112 :command toolbar-compile
2113 :help "Start a compilation"
2117 (debug :image toolbar-debug-icon
2118 :command toolbar-debug
2119 :help "Start a debugger"
2123 (news :image toolbar-news-icon
2124 :command toolbar-news
2127 "A meaning alist with definition of the default buttons.
2128 The following buttons are available:
2130 * Both Emacs and XEmacs: `open-file', `dired', `save-buffer',
2131 `undo', `cut', `copy', `paste', `search-replace', `print-buffer',
2132 `spell-buffer', `info'.
2134 * Emacs only: `new-file' (Emacs 22+) `write-file', `search-forward',
2135 `customize', `help', `kill-buffer', `exit-emacs'.
2137 * XEmacs only: `mail', `compile', `debug', `news'.
2139 To reproduce the default toolbar in both editors with use as BUTTON
2140 in `toolbarx-install-toolbar':
2142 \(toolbarx-install-toolbar
2143 '([(open-file dired kill-buffer save-buffer write-file undo cut
2144 copy paste search-forward print-buffer customize help)
2145 (open-file dired save-buffer print-buffer cut copy paste undo
2146 spell-buffer search-replace mail info compile debug news)])
2147 toolbarx-default-toolbar-meaning-alist)
2149 Ps.: there are more buttons available than suggested in the
2152 (provide 'toolbar-x)
2154 ;;; toolbar-x.el ends here