X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7ad8fe5e2876518a8f33b80050f98dab4ff78398..29bbcfa7054e69db0dbe8250af2c809b39ecb54d:/lisp/tool-bar.el diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 14cbc57f02..ddaf16043a 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -1,7 +1,7 @@ ;;; tool-bar.el --- setting up the tool bar ;; ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; ;; Author: Dave Love ;; Keywords: mouse frames @@ -52,12 +52,17 @@ conveniently adding tool bar items." :global t :group 'mouse :group 'frames - (and (display-images-p) - (modify-all-frames-parameters (list (cons 'tool-bar-lines - (if tool-bar-mode 1 0)))) - (if (and tool-bar-mode - (display-graphic-p)) - (tool-bar-setup)))) + (if tool-bar-mode + (progn + ;; Make one tool-bar-line for any - including non-graphical - + ;; terminal, see Bug#1754. If this causes problems, we should + ;; handle the problem in `modify-frame-parameters' or do not + ;; call `modify-all-frames-parameters' when toggling the tool + ;; bar off either. + (modify-all-frames-parameters (list (cons 'tool-bar-lines 1))) + (if (= 1 (length (default-value 'tool-bar-map))) ; not yet setup + (tool-bar-setup))) + (modify-all-frames-parameters (list (cons 'tool-bar-lines 0))))) ;;;###autoload ;; Used in the Show/Hide menu, to have the toggle reflect the current frame. @@ -85,15 +90,23 @@ See `tool-bar-mode' for more information." Define this locally to override the global tool bar.") (global-set-key [tool-bar] - '(menu-item "tool bar" ignore + `(menu-item ,(purecopy "tool bar") ignore :filter tool-bar-make-keymap)) (declare-function image-mask-p "image.c" (spec &optional frame)) +(defconst tool-bar-keymap-cache (make-hash-table :weakness t :test 'equal)) + (defun tool-bar-make-keymap (&optional ignore) "Generate an actual keymap from `tool-bar-map'. Its main job is to figure out which images to use based on the display's color capability and based on the available image libraries." + (let ((key (cons (frame-terminal) tool-bar-map))) + (or (gethash key tool-bar-keymap-cache) + (puthash key (tool-bar-make-keymap-1) tool-bar-keymap-cache)))) + +(defun tool-bar-make-keymap-1 () + "Generate an actual keymap from `tool-bar-map', without caching." (mapcar (lambda (bind) (let (image-exp plist) (when (and (eq (car-safe (cdr-safe bind)) 'menu-item) @@ -117,13 +130,6 @@ color capability and based on the available image libraries." bind)) tool-bar-map)) -(defconst tool-bar-find-image-cache (make-hash-table :weakness t :test 'equal)) - -(defun tool-bar-find-image (specs) - "Like `find-image' but with caching." - (or (gethash specs tool-bar-find-image-cache) - (puthash specs (find-image specs) tool-bar-find-image-cache))) - ;;;###autoload (defun tool-bar-add-item (icon def key &rest props) "Add an item to the tool bar. @@ -133,7 +139,7 @@ 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 +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'. @@ -158,19 +164,19 @@ ICON.xbm, using `find-image'." (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")))) + (xpm-lo-spec (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-exp `(tool-bar-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))))) - + (image-exp `(find-image + (cond ((not (display-color-p)) + ',(list pbm-spec xbm-spec xpm-lo-spec xpm-spec)) + ((< (display-color-cells) 256) + ',(list xpm-lo-spec xpm-spec pbm-spec xbm-spec)) + (t + ',(list xpm-spec pbm-spec xbm-spec)))))) (define-key-after map (vector key) `(menu-item ,(symbol-name key) ,def :image ,image-exp ,@props)))) @@ -210,18 +216,19 @@ holds a keymap." (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")))) + (xpm-lo-spec (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-exp `(tool-bar-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)))) + (image-exp `(find-image + (cond ((not (display-color-p)) + ',(list pbm-spec xbm-spec xpm-lo-spec xpm-spec)) + ((< (display-color-cells) 256) + ',(list xpm-lo-spec xpm-spec pbm-spec xbm-spec)) + (t + ',(list xpm-spec pbm-spec xbm-spec))))) submap key) ;; We'll pick up the last valid entry in the list of keys if ;; there's more than one. @@ -256,65 +263,59 @@ holds a keymap." ;;; Set up some global items. Additions/deletions up for grabs. -(defvar tool-bar-setup nil - "Set to t if the tool-bar has been set up by `tool-bar-setup'.") - -(defun tool-bar-setup (&optional frame) - (unless tool-bar-setup - (with-selected-frame (or frame (selected-frame)) - ;; 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 '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-from-menu itself operates on - ;; (default-value 'tool-bar-map), but when we don't use that function, - ;; we must explicitly operate on the default value. - - (let ((tool-bar-map (default-value 'tool-bar-map))) - (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")) - (setq tool-bar-setup t)))) +(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 '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-from-menu itself operates on + ;; (default-value 'tool-bar-map), but when we don't use that function, + ;; we must explicitly operate on the default value. + + (let ((tool-bar-map (default-value 'tool-bar-map))) + (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)