diff lisp/tool-bar.el @ 66168:28718fa5d988

Moved all remaining images from lisp/toolbar to etc/images, moved lisp/toolbar/tool-bar to lisp and "deleted" lisp/toolbar. The low resolution images were placed in their own directory (low-color). Replaced underscore (_) in filenames with dash (-) per convention * make-dist: Create and populate etc/images/low-color. * admin/FOR-RELEASE (DOCUMENTATION): Removed lisp/toolbar from list since it's gone. Also marked mh-e as done. * lisp/toolbar/attach.*, lisp/toolbar/cancel.*, lisp/toolbar/close.*: * lisp/toolbar/copy.*, lisp/toolbar/cut.*, lisp/toolbar/diropen.*: * lisp/toolbar/exit.*, lisp/toolbar/help.*, lisp/toolbar/home.*: * lisp/toolbar/index.*, lisp/toolbar/info.*, lisp/toolbar/mail.*: * lisp/toolbar/new.*, lisp/toolbar/open.*, lisp/toolbar/paste.*, * * lisp/toolbar/preferences.*, lisp/toolbar/print.*, lisp/toolbar/save.*: * lisp/toolbar/saveas.*, lisp/toolbar/search.*: * lisp/toolbar/search-replace.*: lisp/toolbar/spell.*: * lisp/toolbar/undo.*: Moved to etc/images. * lisp/toolbar/lc-copy.*: Moved to etc/images/low-color/copy.*. * lisp/toolbar/lc-cut.*: Moved to etc/images/low-color/cut.*. * lisp/toolbar/lc-help.*: Moved to etc/images/low-color/help.*. * lisp/toolbar/lc-home.*: Moved to etc/images/low-color/home.*. * lisp/toolbar/lc-index.*: Moved to etc/images/low-color/index.*. * lisp/toolbar/lc-new.*: Moved to etc/images/low-color/new.*. * lisp/toolbar/lc-open.*: Moved to etc/images/low-color/open.*. * lisp/toolbar/lc-paste.*: Moved to etc/images/low-color/paste.*. * lisp/toolbar/lc-preferences.*: Moved to etc/images/low-color/preferences.*. * lisp/toolbar/lc-print.*: Moved to etc/images/low-color/print.*. * lisp/toolbar/lc-save.*: Moved to etc/images/low-color/save.*. * lisp/toolbar/lc-saveas.*: Moved to etc/images/low-color/saveas.*. * lisp/toolbar/lc-search.*: Moved to etc/images/low-color/search.*. * lisp/toolbar/lc-spell.*: Moved to etc/images/low-color/spell.*. * lisp/toolbar/lc-undo.*: Moved to etc/images/low-color/undo.*. To conform with convention, the underscore (_) in the following image names were replaced with dash (-) or (/) as appropriate. * lisp/toolbar/back_arrow.*: Moved to etc/images/back-arrow.*. * lisp/toolbar/fld_open.*: Moved to etc/images/fld-open.*. * lisp/toolbar/fwd_arrow.*: Moved to etc/images/fwd-arrow.*. * lisp/toolbar/jump_to.*: Moved to etc/images/jump-to.*. * lisp/toolbar/left_arrow.*: Moved to etc/images/left-arrow.*. * lisp/toolbar/right_arrow.*: Moved to etc/images/right-arrow.*. * lisp/toolbar/up_arrow.*: Moved to etc/images/up-arrow.*. * lisp/toolbar/lc-back_arrow.*.: Moved to etc/images/low-color/back-arrow.*. * lisp/toolbar/lc-fwd_arrow.*.: Moved to etc/images/low-color/fwd-arrow.*. * lisp/toolbar/lc-jump_to.*: Moved to etc/images/low-color/jump-to.*. * lisp/toolbar/lc-left_arrow.*.: Moved to etc/images/low-color/left-arrow.*. * lisp/toolbar/lc-right_arrow.*.: Moved to etc/images/low-color/right-arrow.*. * lisp/toolbar/lc-up_arrow.*: Moved to etc/images/low-color/up-arrow.*. * lisp/toolbar/mail_compose.*.: Moved to etc/images/mail/compose.*. * lisp/toolbar/mail_send.*: Moved to etc/images/mail/send.*. * lisp/info.el (info-tool-bar-map): Replaced underscores in image names with dashes. * lisp/makefile.w32-in (WINS): Removed toolbar. * lisp/menu-bar.el: Replaced toolbar/tool-bar.el with tool-bar.el in comment. * lisp/tool-bar.el: Moved to lisp from lisp/toolbar. Now that lisp/toolbar is empty, it should be deleted when folks run "cvs up -P". * etc/images/README: Incorporated the content of lisp/toolbar/README now that all of the images are here.

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/tool-bar.el	Mon Oct 17 22:21:06 2005 +0000
@@ -0,0 +1,280 @@
+;;; tool-bar.el --- setting up the tool bar
+;;
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
+;;
+;; Author: Dave Love <[e-mail]>
+;; 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., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, 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'
+;; property.)
+
+;; 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 <[e-mail]> 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 low-color/ICON.xpm if display-color-cells
+is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally
+ICON.xbm, using `find-image'.
+
+Use this function only to make bindings in the global value of `tool-bar-map'.
+To define items in any other map, use `tool-bar-local-item'."
+  (apply 'tool-bar-local-item icon def key tool-bar-map props))
+
+;;;###autoload
+(defun tool-bar-local-item (icon def key map &rest props)
+  "Add an item to the tool bar in map MAP.
+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 low-color/ICON.xpm if display-color-cells
+is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally
+ICON.xbm, using `find-image'."
+  (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))))
+	 (xpm-spec (list :type 'xpm :file (concat icon ".xpm")))
+	 (xpm-lo-spec (if (> (display-color-cells) 256)
+			  nil
+			(list :type 'xpm :file
+                              (concat "low-color/" icon ".xpm"))))
+	 (pbm-spec (append (list :type 'pbm :file
+                                 (concat icon ".pbm")) colors))
+	 (xbm-spec (append (list :type 'xbm :file
+                                 (concat icon ".xbm")) colors))
+	 (image (find-image
+		(if (display-color-p)
+		    (list xpm-lo-spec xpm-spec pbm-spec xbm-spec)
+		  (list pbm-spec xbm-spec xpm-lo-spec xpm-spec)))))
+
+    (when (and (display-images-p) image)
+      (unless (image-mask-p image)
+	(setq image (append image '(:mask heuristic))))
+      (define-key-after 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.
+This makes a binding for COMMAND in `tool-bar-map', copying its
+binding from the menu bar in MAP (which defaults to `global-map'), but
+modifies the binding by adding an image specification for ICON.  It
+finds ICON just like `tool-bar-add-item'.  PROPS are additional
+properties to add to the binding.
+
+MAP must contain appropriate binding for `[menu-bar]' which holds a keymap.
+
+Use this function only to make bindings in the global value of `tool-bar-map'.
+To define items in any other map, use `tool-bar-local-item'."
+  (apply 'tool-bar-local-item-from-menu command icon
+	 (default-value 'tool-bar-map) map props))
+
+;;;###autoload
+(defun tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props)
+  "Define tool bar binding for COMMAND using the given ICON in keymap MAP.
+This makes a binding for COMMAND in IN-MAP, copying its binding from
+the menu bar in FROM-MAP (which defaults to `global-map'), but
+modifies the binding by adding an image specification for ICON.  It
+finds ICON just like `tool-bar-add-item'.  PROPS are additional
+properties to add to the binding.
+
+MAP must contain appropriate binding for `[menu-bar]' which holds a keymap."
+  (unless from-map
+    (setq from-map global-map))
+  (let* ((menu-bar-map (lookup-key from-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))))
+	 (xpm-spec (list :type 'xpm :file (concat icon ".xpm")))
+	 (xpm-lo-spec (if (> (display-color-cells) 256)
+			  nil
+			(list :type 'xpm :file
+                              (concat "low-color/" icon ".xpm"))))
+	 (pbm-spec (append (list :type 'pbm :file
+                                 (concat icon ".pbm")) colors))
+	 (xbm-spec (append (list :type 'xbm :file
+                                 (concat icon ".xbm")) colors))
+	 (spec (if (display-color-p)
+		   (list xpm-lo-spec xpm-spec pbm-spec xbm-spec)
+		 (list pbm-spec xbm-spec xpm-lo-spec xpm-spec)))
+	 (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 in-map (vector key)
+	      (append (cdr defn) (list :image image) props))
+	  (setq defn (cdr defn))
+	  (define-key-after in-map (vector key)
+	    (let ((rest (cdr defn)))
+	      ;; If the rest of the definition starts
+	      ;; with a list of menu cache info, get rid of that.
+	      (if (and (consp rest) (consp (car rest)))
+		  (setq rest (cdr rest)))
+	      (append `(menu-item ,(car defn) ,rest)
+		      (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 'find-file-existing "open")
+  (tool-bar-add-item-from-menu 'dired "diropen")
+  (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 (lookup-key menu-bar-edit-menu [cut])
+			       "cut" nil
+			       :visible '(not (eq 'special (get major-mode
+								'mode-class))))
+  (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy])
+			       "copy")
+  (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste])
+			       "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)
+
+;;; arch-tag: 15f30f0a-d0d7-4d50-bbb7-f48fd0c8582f
+;;; tool-bar.el ends here