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

;;; tool-bar.el --- setting up the tool bar
;;
;; Copyright (C) 2000, 2001, 2002 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."
  :init-value nil
  :global t
  :group 'mouse
  :group 'frames
  (and (display-images-p)
       (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))))

;;;###autoload
;; We want to pretend the toolbar by standard is on, as this will make
;; customize consider disabling the toolbar a customization, and save
;; that.  We could do this for real by setting :init-value above, but
;; that would turn on the toolbar in MS Windows where it is currently
;; useless, and it would overwrite disabling the tool bar from X
;; resources.  If anyone want to implement this in a cleaner way,
;; please do so.
;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-21.
(put 'tool-bar-mode 'standard-value '(t))

(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 (and (display-images-p) 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 (and (display-images-p) 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))))
      (let ((defn (assq key (cdr submap))))
	(if (eq (cadr defn) 'menu-item)
	    (define-key-after tool-bar-map (vector key)
	      (append (cdr defn) (list :image image) props))
	  (setq defn (cdr defn))
	  (define-key-after tool-bar-map (vector key)
	    (append `(menu-item ,(car defn) ,(cddr defn))
		    (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	2	;;
4f9b9060	3	;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
ec7f4585 DL	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."
929e8487	50	:init-value nil
ec7f4585 DL	51	:global t
	52	:group 'mouse
	53	:group 'frames
ef32aa02 EZ	54	(and (display-images-p)
	55	(let ((lines (if tool-bar-mode 1 0)))
	56	;; Alter existing frames...
	57	(mapc (lambda (frame)
	58	(modify-frame-parameters frame
	59	(list (cons 'tool-bar-lines lines))))
	60	(frame-list))
	61	;; ...and future ones.
	62	(let ((elt (assq 'tool-bar-lines default-frame-alist)))
	63	(if elt
	64	(setcdr elt lines)
	65	(add-to-list 'default-frame-alist (cons 'tool-bar-lines lines)))))
	66	(if (and tool-bar-mode
	67	(display-graphic-p)
	68	(= 1 (length (default-value 'tool-bar-map)))) ; not yet setup
	69	(tool-bar-setup))))
ec7f4585	70
929e8487 PA	71	;;;###autoload
	72	;; We want to pretend the toolbar by standard is on, as this will make
	73	;; customize consider disabling the toolbar a customization, and save
	74	;; that. We could do this for real by setting :init-value above, but
	75	;; that would turn on the toolbar in MS Windows where it is currently
	76	;; useless, and it would overwrite disabling the tool bar from X
	77	;; resources. If anyone want to implement this in a cleaner way,
	78	;; please do so.
	79	;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-21.
	80	(put 'tool-bar-mode 'standard-value '(t))
	81
9a4b8870 DL	82	(defvar tool-bar-map (make-sparse-keymap)
	83	"Keymap for the tool bar.
	84	Define this locally to override the global tool bar.")
	85
	86	(global-set-key [tool-bar]
	87	'(menu-item "tool bar" ignore
	88	:filter (lambda (ignore) tool-bar-map)))
ec7f4585 DL	89
ec7f4585 DL	90	;;;###autoload
9a4b8870	91	(defun tool-bar-add-item (icon def key &rest props)
ec7f4585 DL	92	"Add an item to the tool bar.
ec7f4585 DL	93	ICON names the image, DEF is the key definition and KEY is a symbol
9a4b8870 DL	94	for the fake function key in the menu keymap. Remaining arguments
	95	PROPS are additional items to add to the menu item specification. See
	96	Info node `(elisp)Tool Bar'. Items are added from left to right.
ec7f4585	97
cb4aae04 EZ	98	ICON is the base name of a file containing the image to use. The
	99	function will first try to use ICON.xpm, then ICON.pbm, and finally
	100	ICON.xbm, using `find-image'.
9a4b8870 DL	101
	102	Keybindings are made in the map `tool-bar-map'. To define items in
	103	some local map, bind `tool-bar-map' with `let' around calls of this
	104	function."
3fae165c GM	105	(let* ((fg (face-attribute 'tool-bar :foreground))
	106	(bg (face-attribute 'tool-bar :background))
	107	(colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg))
	108	(if (eq bg 'unspecified) nil (list :background bg))))
3b6d80f1	109	(image (find-image
34e86ea3	110	(if (display-color-p)
3fae165c GM	111	(list (list :type 'xpm :file (concat icon ".xpm"))
	112	(append (list :type 'pbm :file (concat icon ".pbm"))
	113	colors)
	114	(append (list :type 'xbm :file (concat icon ".xbm"))
	115	colors))
	116	(list (append (list :type 'pbm :file (concat icon ".pbm"))
	117	colors)
	118	(append (list :type 'xbm :file (concat icon ".xbm"))
	119	colors)
	120	(list :type 'xpm :file (concat icon ".xpm")))))))
196de866	121	(when (and (display-images-p) image)
ec7f4585 DL	122	(unless (image-mask-p image)
ec7f4585 DL	123	(setq image (append image '(:mask heuristic))))
9a4b8870	124	(define-key-after tool-bar-map (vector key)
ec7f4585 DL	125	`(menu-item ,(symbol-name key) ,def :image ,image ,@props)))))
ec7f4585 DL	126
c2156508	127	;;;###autoload
ec7f4585 DL	128	(defun tool-bar-add-item-from-menu (command icon &optional map &rest props)
	129	"Define tool bar binding for COMMAND using the given ICON in keymap MAP.
	130	The binding of COMMAND is looked up in the menu bar in MAP (default
	131	`global-map') and modified to add an image specification for ICON, which
	132	is looked for as by `tool-bar-add-item'.
9a4b8870 DL	133	MAP must contain an appropriate keymap bound to `[menu-bar]'.
	134	PROPS is a list of additional properties to add to the binding.
	135
	136	Keybindings are made in the map `tool-bar-map'. To define items in
	137	some local map, bind `tool-bar-map' with `let' around calls of this
	138	function."
ec7f4585 DL	139	(unless map
	140	(setq map global-map))
	141	(let* ((menu-bar-map (lookup-key map [menu-bar]))
	142	(keys (where-is-internal command menu-bar-map))
3fae165c GM	143	(fg (face-attribute 'tool-bar :foreground))
	144	(bg (face-attribute 'tool-bar :background))
	145	(colors (nconc (if (eq fg 'unspecified) nil (list :foreground fg))
	146	(if (eq bg 'unspecified) nil (list :background bg))))
7e636904 GM	147	(spec (if (display-color-p)
	148	(list (list :type 'xpm :file (concat icon ".xpm"))
	149	(append (list :type 'pbm :file (concat icon ".pbm"))
	150	colors)
	151	(append (list :type 'xbm :file (concat icon ".xbm"))
	152	colors))
	153	(list (append (list :type 'pbm :file (concat icon ".pbm"))
	154	colors)
	155	(append (list :type 'xbm :file (concat icon ".xbm"))
	156	colors)
	157	(list :type 'xpm :file (concat icon ".xpm")))))
	158	(image (find-image spec))
ec7f4585	159	submap key)
196de866	160	(when (and (display-images-p) image)
ec7f4585 DL	161	;; We'll pick up the last valid entry in the list of keys if
	162	;; there's more than one.
	163	(dolist (k keys)
	164	;; We're looking for a binding of the command in a submap of
	165	;; the menu bar map, so the key sequence must be two or more
	166	;; long.
	167	(if (and (vectorp k)
	168	(> (length k) 1))
	169	(let ((m (lookup-key menu-bar-map (substring k 0 -1)))
	170	;; Last element in the bound key sequence:
	171	(kk (aref k (1- (length k)))))
	172	(if (and (keymapp m)
	173	(symbolp kk))
	174	(setq submap m
	175	key kk)))))
	176	(when (and (symbolp submap) (boundp submap))
	177	(setq submap (eval submap)))
ddba99ad MB	178	(unless (image-mask-p image)
ddba99ad MB	179	(setq image (append image '(:mask heuristic))))
98a8938c GM	180	(let ((defn (assq key (cdr submap))))
	181	(if (eq (cadr defn) 'menu-item)
	182	(define-key-after tool-bar-map (vector key)
	183	(append (cdr defn) (list :image image) props))
	184	(setq defn (cdr defn))
	185	(define-key-after tool-bar-map (vector key)
	186	(append `(menu-item ,(car defn) ,(cddr defn))
	187	(list :image image) props)))))))
ec7f4585 DL	188
	189	;;; Set up some global items. Additions/deletions up for grabs.
	190
ebd4825d	191	(defun tool-bar-setup ()
7a03d9cd EZ	192	;; People say it's bad to have EXIT on the tool bar, since users
	193	;; might inadvertently click that button.
	194	;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit")
ebd4825d DL	195	(tool-bar-add-item-from-menu 'find-file "new")
	196	(tool-bar-add-item-from-menu 'dired "open")
	197	(tool-bar-add-item-from-menu 'kill-this-buffer "close")
	198	(tool-bar-add-item-from-menu 'save-buffer "save" nil
5ec17636 DL	199	:visible '(or buffer-file-name
	200	(not (eq 'special
	201	(get major-mode
	202	'mode-class)))))
ebd4825d	203	(tool-bar-add-item-from-menu 'write-file "saveas" nil
5ec17636 DL	204	:visible '(or buffer-file-name
	205	(not (eq 'special
	206	(get major-mode
	207	'mode-class)))))
ebd4825d DL	208	(tool-bar-add-item-from-menu 'undo "undo" nil
	209	:visible '(not (eq 'special (get major-mode
	210	'mode-class))))
	211	(tool-bar-add-item-from-menu 'kill-region "cut" nil
	212	:visible '(not (eq 'special (get major-mode
	213	'mode-class))))
	214	(tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy")
	215	(tool-bar-add-item-from-menu 'yank "paste" nil
	216	:visible '(not (eq 'special (get major-mode
	217	'mode-class))))
	218	(tool-bar-add-item-from-menu 'nonincremental-search-forward "search")
	219	;;(tool-bar-add-item-from-menu 'ispell-buffer "spell")
	220
	221	;; There's no icon appropriate for News and we need a command rather
	222	;; than a lambda for Read Mail.
	223	;;(tool-bar-add-item-from-menu 'compose-mail "mail_compose")
	224
	225	(tool-bar-add-item-from-menu 'print-buffer "print")
9a4b8870	226	(tool-bar-add-item "preferences" 'customize 'customize
ebd4825d DL	227	:help "Edit preferences (customize)")
ebd4825d DL	228
9a4b8870 DL	229	(tool-bar-add-item "help" (lambda ()
	230	(interactive)
	231	(popup-menu menu-bar-help-menu))
	232	'help
	233	:help "Pop up the Help menu")
ebd4825d	234	)
ec7f4585 DL	235
	236	(provide 'tool-bar)
	237
	238	;;; tool-bar.el ends here