[bpt/emacs.git] / lisp / toolbar / tool-bar.el

;;; tool-bar.el --- setting up the tool bar
;;
;; Copyright (C) 2000 Free Software Foundation, Inc.
;;
;; Author: Dave Love <fx@gnu.org>
;; Keywords: mouse frames

;; This file is part of GNU Emacs.

;; GNU Emacs 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 2, or (at your option)
;; any later version.

;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Provides `tool-bar-mode' to control display of the tool -bar and
;; bindings for the global tool bar with convenience functions
;; `tool-bar-add-item' and `tool-bar-add-item-from-menu'.

;; The normal global binding for [tool-bar] (below) uses the value of
;; `tool-bar-map' as the actual keymap to define the tool bar.  Modes
;; may either bind items under the [tool-bar] prefix key of the local
;; map to add to the global bar or may set `tool-bar-map'
;; buffer-locally to override it.  (Some items are removed from the
;; global bar in modes which have `special' as their `mode-class'
;; properlty.)

;; Todo: Somehow make tool bars easily customizable by the naive?

;;; Code:

;;;###autoload
(define-minor-mode tool-bar-mode
  "Toggle use of the tool bar.
With numeric ARG, display the tool bar if and only if ARG is positive.

See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for
conveniently adding tool bar items."
  :global t
  :group 'mouse
  :group 'frames
  (let ((lines (if tool-bar-mode 1 0)))
    ;; Alter existing frames...
    (mapc (lambda (frame)
	    (modify-frame-parameters frame
				     (list (cons 'tool-bar-lines lines))))
	  (frame-list))
    ;; ...and future ones.
    (let ((elt (assq 'tool-bar-lines default-frame-alist)))
      (if elt
	  (setcdr elt lines)
	(add-to-list 'default-frame-alist (cons 'tool-bar-lines lines)))))
  (if (and tool-bar-mode
	   (display-graphic-p)
	   (= 1 (length (default-value 'tool-bar-map)))) ; not yet setup
      (tool-bar-setup)))

(defvar tool-bar-map (make-sparse-keymap)
  "Keymap for the tool bar.
Define this locally to override the global tool bar.")

(global-set-key [tool-bar]
		'(menu-item "tool bar" ignore
			    :filter (lambda (ignore) tool-bar-map)))

;;;###autoload
(defun tool-bar-add-item (icon def key &rest props)
  "Add an item to the tool bar.
ICON names the image, DEF is the key definition and KEY is a symbol
for the fake function key in the menu keymap.  Remaining arguments
PROPS are additional items to add to the menu item specification.  See
Info node `(elisp)Tool Bar'.  Items are added from left to right.

ICON is the base name of a file containing the image to use.  The
function will first try to use ICON.xpm, then ICON.pbm, and finally
ICON.xbm, using `find-image'.

Keybindings are made in the map `tool-bar-map'.  To define items in
some local map, bind `tool-bar-map' with `let' around calls of this
function."
  (let* ((fg (face-attribute 'tool-bar :foreground))
	 (bg (face-attribute 'tool-bar :background))
	 (colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg))
			(if (eq bg 'unspecified) nil (list :background bg))))
	 (image (find-image
		(if (display-color-p)
		    (list (list :type 'xpm :file (concat icon ".xpm"))
			  (append (list :type 'pbm :file (concat icon ".pbm"))
				  colors)
			  (append (list :type 'xbm :file (concat icon ".xbm"))
				  colors))
		  (list (append (list :type 'pbm :file (concat icon ".pbm"))
				colors)
			(append (list :type 'xbm :file (concat icon ".xbm"))
				colors)
			(list :type 'xpm :file (concat icon ".xpm")))))))
    (when image
      (unless (image-mask-p image)
	(setq image (append image '(:mask heuristic))))
      (define-key-after tool-bar-map (vector key)
	`(menu-item ,(symbol-name key) ,def :image ,image ,@props)))))

;;;###autoload
(defun tool-bar-add-item-from-menu (command icon &optional map &rest props)
  "Define tool bar binding for COMMAND using the given ICON in keymap MAP.
The binding of COMMAND is looked up in the menu bar in MAP (default
`global-map') and modified to add an image specification for ICON, which
is looked for as by `tool-bar-add-item'.
MAP must contain an appropriate keymap bound to `[menu-bar]'.
PROPS is a list of additional properties to add to the binding.

Keybindings are made in the map `tool-bar-map'.  To define items in
some local map, bind `tool-bar-map' with `let' around calls of this
function."
  (unless map
    (setq map global-map))
  (let* ((menu-bar-map (lookup-key map [menu-bar]))
	 (keys (where-is-internal command menu-bar-map))
	 (fg (face-attribute 'tool-bar :foreground))
	 (bg (face-attribute 'tool-bar :background))
	 (colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg))
			(if (eq bg 'unspecified) nil (list :background bg))))
	 (spec (if (display-color-p)
		   (list (list :type 'xpm :file (concat icon ".xpm"))
			 (append (list :type 'pbm :file (concat icon ".pbm"))
				       colors)
			 (append (list :type 'xbm :file (concat icon ".xbm"))
				       colors))
		 (list (append (list :type 'pbm :file (concat icon ".pbm"))
				     colors)
		       (append (list :type 'xbm :file (concat icon ".xbm"))
				     colors)
		       (list :type 'xpm :file (concat icon ".xpm")))))
	 (image (find-image spec))
	 submap key)
    (when image
      ;; We'll pick up the last valid entry in the list of keys if
      ;; there's more than one.
      (dolist (k keys)
	;; We're looking for a binding of the command in a submap of
	;; the menu bar map, so the key sequence must be two or more
	;; long.
	(if (and (vectorp k)
		 (> (length k) 1))
	    (let ((m (lookup-key menu-bar-map (substring k 0 -1)))
		  ;; Last element in the bound key sequence:
		  (kk (aref k (1- (length k)))))
	      (if (and (keymapp m)
		       (symbolp kk))
		  (setq submap m
			key kk)))))
      (when (and (symbolp submap) (boundp submap))
	(setq submap (eval submap)))
      (unless (image-mask-p image)
	(setq image (append image '(:mask heuristic))))
      (define-key-after tool-bar-map (vector key)
	(append (cdr (assq key (cdr submap))) (list :image image) props)))))

;;; Set up some global items.  Additions/deletions up for grabs.

(defun tool-bar-setup ()
  ;; People say it's bad to have EXIT on the tool bar, since users
  ;; might inadvertently click that button.
  ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit")
  (tool-bar-add-item-from-menu 'find-file "new")
  (tool-bar-add-item-from-menu 'dired "open")
  (tool-bar-add-item-from-menu 'kill-this-buffer "close")
  (tool-bar-add-item-from-menu 'save-buffer "save" nil
			       :visible '(or buffer-file-name
					     (not (eq 'special
						      (get major-mode
							   'mode-class)))))
  (tool-bar-add-item-from-menu 'write-file "saveas" nil
			       :visible '(or buffer-file-name
					     (not (eq 'special
						      (get major-mode
							   'mode-class)))))
  (tool-bar-add-item-from-menu 'undo "undo" nil
			       :visible '(not (eq 'special (get major-mode
								'mode-class))))
  (tool-bar-add-item-from-menu 'kill-region "cut" nil
			       :visible '(not (eq 'special (get major-mode
								'mode-class))))
  (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy")
  (tool-bar-add-item-from-menu 'yank "paste" nil
			       :visible '(not (eq 'special (get major-mode
								'mode-class))))
  (tool-bar-add-item-from-menu 'nonincremental-search-forward "search")
  ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell")

  ;; There's no icon appropriate for News and we need a command rather
  ;; than a lambda for Read Mail.
  ;;(tool-bar-add-item-from-menu 'compose-mail "mail_compose")

  (tool-bar-add-item-from-menu 'print-buffer "print")
  (tool-bar-add-item "preferences" 'customize 'customize
		     :help "Edit preferences (customize)")

  (tool-bar-add-item "help" (lambda ()
			      (interactive)
			      (popup-menu menu-bar-help-menu))
		     'help
		     :help "Pop up the Help menu")
  )

(provide 'tool-bar)

;;; tool-bar.el ends here
Commit	Line	Data
e8af40ee	1	;;; tool-bar.el --- setting up the tool bar
ec7f4585 DL	2	;;
	3	;; Copyright (C) 2000 Free Software Foundation, Inc.
	4	;;
	5	;; Author: Dave Love <fx@gnu.org>
	6	;; Keywords: mouse frames
	7
	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software; you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
	12	;; the Free Software Foundation; either version 2, or (at your option)
	13	;; any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
	21	;; along with GNU Emacs; see the file COPYING. If not, write to the
	22	;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	23	;; Boston, MA 02111-1307, USA.
	24
	25	;;; Commentary:
	26
	27	;; Provides `tool-bar-mode' to control display of the tool -bar and
	28	;; bindings for the global tool bar with convenience functions
	29	;; `tool-bar-add-item' and `tool-bar-add-item-from-menu'.
	30
9a4b8870	31	;; The normal global binding for [tool-bar] (below) uses the value of
c129b5ef DL	32	;; `tool-bar-map' as the actual keymap to define the tool bar. Modes
	33	;; may either bind items under the [tool-bar] prefix key of the local
	34	;; map to add to the global bar or may set `tool-bar-map'
b28e72df	35	;; buffer-locally to override it. (Some items are removed from the
9a4b8870 DL	36	;; global bar in modes which have `special' as their `mode-class'
	37	;; properlty.)
	38
adf7d3a8 DL	39	;; Todo: Somehow make tool bars easily customizable by the naive?
adf7d3a8 DL	40
ec7f4585 DL	41	;;; Code:
	42
	43	;;;###autoload
	44	(define-minor-mode tool-bar-mode
	45	"Toggle use of the tool bar.
a81fc510	46	With numeric ARG, display the tool bar if and only if ARG is positive.
ec7f4585 DL	47
	48	See `tool-bar-add-item' and `tool-bar-add-item-from-menu' for
	49	conveniently adding tool bar items."
ec7f4585 DL	50	:global t
	51	:group 'mouse
	52	:group 'frames
	53	(let ((lines (if tool-bar-mode 1 0)))
	54	;; Alter existing frames...
	55	(mapc (lambda (frame)
	56	(modify-frame-parameters frame
	57	(list (cons 'tool-bar-lines lines))))
	58	(frame-list))
	59	;; ...and future ones.
	60	(let ((elt (assq 'tool-bar-lines default-frame-alist)))
	61	(if elt
	62	(setcdr elt lines)
ebd4825d	63	(add-to-list 'default-frame-alist (cons 'tool-bar-lines lines)))))
adf7d3a8 DL	64	(if (and tool-bar-mode
	65	(display-graphic-p)
	66	(= 1 (length (default-value 'tool-bar-map)))) ; not yet setup
ebd4825d	67	(tool-bar-setup)))
ec7f4585	68
9a4b8870 DL	69	(defvar tool-bar-map (make-sparse-keymap)
	70	"Keymap for the tool bar.
	71	Define this locally to override the global tool bar.")
	72
	73	(global-set-key [tool-bar]
	74	'(menu-item "tool bar" ignore
	75	:filter (lambda (ignore) tool-bar-map)))
ec7f4585 DL	76
ec7f4585 DL	77	;;;###autoload
9a4b8870	78	(defun tool-bar-add-item (icon def key &rest props)
ec7f4585 DL	79	"Add an item to the tool bar.
ec7f4585 DL	80	ICON names the image, DEF is the key definition and KEY is a symbol
9a4b8870 DL	81	for the fake function key in the menu keymap. Remaining arguments
	82	PROPS are additional items to add to the menu item specification. See
	83	Info node `(elisp)Tool Bar'. Items are added from left to right.
ec7f4585	84
cb4aae04 EZ	85	ICON is the base name of a file containing the image to use. The
	86	function will first try to use ICON.xpm, then ICON.pbm, and finally
	87	ICON.xbm, using `find-image'.
9a4b8870 DL	88
	89	Keybindings are made in the map `tool-bar-map'. To define items in
	90	some local map, bind `tool-bar-map' with `let' around calls of this
	91	function."
3fae165c GM	92	(let* ((fg (face-attribute 'tool-bar :foreground))
	93	(bg (face-attribute 'tool-bar :background))
	94	(colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg))
	95	(if (eq bg 'unspecified) nil (list :background bg))))
3b6d80f1	96	(image (find-image
34e86ea3	97	(if (display-color-p)
3fae165c GM	98	(list (list :type 'xpm :file (concat icon ".xpm"))
	99	(append (list :type 'pbm :file (concat icon ".pbm"))
	100	colors)
	101	(append (list :type 'xbm :file (concat icon ".xbm"))
	102	colors))
	103	(list (append (list :type 'pbm :file (concat icon ".pbm"))
	104	colors)
	105	(append (list :type 'xbm :file (concat icon ".xbm"))
	106	colors)
	107	(list :type 'xpm :file (concat icon ".xpm")))))))
ec7f4585 DL	108	(when image
	109	(unless (image-mask-p image)
	110	(setq image (append image '(:mask heuristic))))
9a4b8870	111	(define-key-after tool-bar-map (vector key)
ec7f4585 DL	112	`(menu-item ,(symbol-name key) ,def :image ,image ,@props)))))
ec7f4585 DL	113
c2156508	114	;;;###autoload
ec7f4585 DL	115	(defun tool-bar-add-item-from-menu (command icon &optional map &rest props)
	116	"Define tool bar binding for COMMAND using the given ICON in keymap MAP.
	117	The binding of COMMAND is looked up in the menu bar in MAP (default
	118	`global-map') and modified to add an image specification for ICON, which
	119	is looked for as by `tool-bar-add-item'.
9a4b8870 DL	120	MAP must contain an appropriate keymap bound to `[menu-bar]'.
	121	PROPS is a list of additional properties to add to the binding.
	122
	123	Keybindings are made in the map `tool-bar-map'. To define items in
	124	some local map, bind `tool-bar-map' with `let' around calls of this
	125	function."
ec7f4585 DL	126	(unless map
	127	(setq map global-map))
	128	(let* ((menu-bar-map (lookup-key map [menu-bar]))
	129	(keys (where-is-internal command menu-bar-map))
3fae165c GM	130	(fg (face-attribute 'tool-bar :foreground))
	131	(bg (face-attribute 'tool-bar :background))
	132	(colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg))
	133	(if (eq bg 'unspecified) nil (list :background bg))))
7e636904 GM	134	(spec (if (display-color-p)
	135	(list (list :type 'xpm :file (concat icon ".xpm"))
	136	(append (list :type 'pbm :file (concat icon ".pbm"))
	137	colors)
	138	(append (list :type 'xbm :file (concat icon ".xbm"))
	139	colors))
	140	(list (append (list :type 'pbm :file (concat icon ".pbm"))
	141	colors)
	142	(append (list :type 'xbm :file (concat icon ".xbm"))
	143	colors)
	144	(list :type 'xpm :file (concat icon ".xpm")))))
	145	(image (find-image spec))
ec7f4585 DL	146	submap key)
	147	(when image
	148	;; We'll pick up the last valid entry in the list of keys if
	149	;; there's more than one.
	150	(dolist (k keys)
	151	;; We're looking for a binding of the command in a submap of
	152	;; the menu bar map, so the key sequence must be two or more
	153	;; long.
	154	(if (and (vectorp k)
	155	(> (length k) 1))
	156	(let ((m (lookup-key menu-bar-map (substring k 0 -1)))
	157	;; Last element in the bound key sequence:
	158	(kk (aref k (1- (length k)))))
	159	(if (and (keymapp m)
	160	(symbolp kk))
	161	(setq submap m
	162	key kk)))))
	163	(when (and (symbolp submap) (boundp submap))
	164	(setq submap (eval submap)))
ddba99ad MB	165	(unless (image-mask-p image)
ddba99ad MB	166	(setq image (append image '(:mask heuristic))))
9a4b8870	167	(define-key-after tool-bar-map (vector key)
ec7f4585 DL	168	(append (cdr (assq key (cdr submap))) (list :image image) props)))))
	169
	170	;;; Set up some global items. Additions/deletions up for grabs.
	171
ebd4825d	172	(defun tool-bar-setup ()
7a03d9cd EZ	173	;; People say it's bad to have EXIT on the tool bar, since users
	174	;; might inadvertently click that button.
	175	;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit")
ebd4825d DL	176	(tool-bar-add-item-from-menu 'find-file "new")
	177	(tool-bar-add-item-from-menu 'dired "open")
	178	(tool-bar-add-item-from-menu 'kill-this-buffer "close")
	179	(tool-bar-add-item-from-menu 'save-buffer "save" nil
5ec17636 DL	180	:visible '(or buffer-file-name
	181	(not (eq 'special
	182	(get major-mode
	183	'mode-class)))))
ebd4825d	184	(tool-bar-add-item-from-menu 'write-file "saveas" nil
5ec17636 DL	185	:visible '(or buffer-file-name
	186	(not (eq 'special
	187	(get major-mode
	188	'mode-class)))))
ebd4825d DL	189	(tool-bar-add-item-from-menu 'undo "undo" nil
	190	:visible '(not (eq 'special (get major-mode
	191	'mode-class))))
	192	(tool-bar-add-item-from-menu 'kill-region "cut" nil
	193	:visible '(not (eq 'special (get major-mode
	194	'mode-class))))
	195	(tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy")
	196	(tool-bar-add-item-from-menu 'yank "paste" nil
	197	:visible '(not (eq 'special (get major-mode
	198	'mode-class))))
	199	(tool-bar-add-item-from-menu 'nonincremental-search-forward "search")
	200	;;(tool-bar-add-item-from-menu 'ispell-buffer "spell")
	201
	202	;; There's no icon appropriate for News and we need a command rather
	203	;; than a lambda for Read Mail.
	204	;;(tool-bar-add-item-from-menu 'compose-mail "mail_compose")
	205
	206	(tool-bar-add-item-from-menu 'print-buffer "print")
9a4b8870	207	(tool-bar-add-item "preferences" 'customize 'customize
ebd4825d DL	208	:help "Edit preferences (customize)")
ebd4825d DL	209
9a4b8870 DL	210	(tool-bar-add-item "help" (lambda ()
	211	(interactive)
	212	(popup-menu menu-bar-help-menu))
	213	'help
	214	:help "Pop up the Help menu")
ebd4825d	215	)
ec7f4585 DL	216
	217	(provide 'tool-bar)
	218
	219	;;; tool-bar.el ends here