mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-31 20:02:42 +00:00
[ Merge Gnome tool bars from Gnus trunk ]
* message.el (message-tool-bar-zap-list, message-tool-bar) (message-tool-bar-gnome, message-tool-bar-retro): New variables. (message-tool-bar-local-item-from-menu): Remove. (message-tool-bar-map): Replace by `message-make-tool-bar'. (message-make-tool-bar): New function. (message-mode): Use `message-make-tool-bar'. * gnus-sum.el (gnus-summary-tool-bar) (gnus-summary-tool-bar-gnome, gnus-summary-tool-bar-retro) (gnus-summary-tool-bar-zap-list): New variables. (gnus-summary-make-tool-bar): Complete rewrite using `gmm-tool-bar-from-list'. * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome) (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): New variables. (gnus-group-make-tool-bar): Complete rewrite using `gmm-tool-bar-from-list'. (gnus-group-tool-bar-update): New function. * gmm-utils.el: New file.
This commit is contained in:
Reiner Steib
parent
43c50d22bc
commit
18c06a99aa
@ -1,3 +1,27 @@
|
||||
2006-04-17 Reiner Steib <Reiner.Steib@gmx.de>
|
||||
|
||||
* message.el (message-tool-bar-zap-list, message-tool-bar)
|
||||
(message-tool-bar-gnome, message-tool-bar-retro): New variables.
|
||||
(message-tool-bar-local-item-from-menu): Remove.
|
||||
(message-tool-bar-map): Replace by `message-make-tool-bar'.
|
||||
(message-make-tool-bar): New function.
|
||||
(message-mode): Use `message-make-tool-bar'.
|
||||
|
||||
* gnus-sum.el (gnus-summary-tool-bar)
|
||||
(gnus-summary-tool-bar-gnome, gnus-summary-tool-bar-retro)
|
||||
(gnus-summary-tool-bar-zap-list): New variables.
|
||||
(gnus-summary-make-tool-bar): Complete rewrite using
|
||||
`gmm-tool-bar-from-list'.
|
||||
|
||||
* gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome)
|
||||
(gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): New
|
||||
variables.
|
||||
(gnus-group-make-tool-bar): Complete rewrite using
|
||||
`gmm-tool-bar-from-list'.
|
||||
(gnus-group-tool-bar-update): New function.
|
||||
|
||||
* gmm-utils.el: New file.
|
||||
|
||||
2006-04-12 Ralf Angeli <angeli@iwi.uni-sb.de>
|
||||
|
||||
* flow-fill.el (fill-flowed): Remove trailing space from blank
|
||||
|
||||
413
lisp/gnus/gmm-utils.el
Normal file
413
lisp/gnus/gmm-utils.el
Normal file
@ -0,0 +1,413 @@
|
||||
;;; gmm-utils.el --- Utility functions for Gnus, Message and MML
|
||||
|
||||
;; Copyright (C) 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Reiner Steib <reiner.steib@gmx.de>
|
||||
;; Keywords: news
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This library provides self-contained utility functions. The functions are
|
||||
;; used in Gnus, Message and MML, but within this library there are no
|
||||
;; dependencies on Gnus, Message, or MML or Gnus.
|
||||
|
||||
;;; Code:
|
||||
|
||||
;; (require 'wid-edit)
|
||||
|
||||
(defgroup gmm nil
|
||||
"Utility functions for Gnus, Message and MML"
|
||||
:prefix "gmm-"
|
||||
:version "23.0" ;; No Gnus
|
||||
:group 'lisp)
|
||||
|
||||
;; Helper functions from `gnus-utils.el': gmm-verbose, gmm-message, gmm-error
|
||||
|
||||
(defcustom gmm-verbose 7
|
||||
"Integer that says how verbose gmm should be.
|
||||
The higher the number, the more messages will flash to say what
|
||||
it done. At zero, it will be totally mute; at five, it will
|
||||
display most important messages; and at ten, it will keep on
|
||||
jabbering all the time."
|
||||
:type 'integer
|
||||
:group 'gmm)
|
||||
|
||||
;;;###autoload
|
||||
(defun gmm-message (level &rest args)
|
||||
"If LEVEL is lower than `gmm-verbose' print ARGS using `message'.
|
||||
|
||||
Guideline for numbers:
|
||||
1 - error messages, 3 - non-serious error messages, 5 - messages for things
|
||||
that take a long time, 7 - not very important messages on stuff, 9 - messages
|
||||
inside loops."
|
||||
(if (<= level gmm-verbose)
|
||||
(apply 'message args)
|
||||
;; We have to do this format thingy here even if the result isn't
|
||||
;; shown - the return value has to be the same as the return value
|
||||
;; from `message'.
|
||||
(apply 'format args)))
|
||||
|
||||
;;;###autoload
|
||||
(defun gmm-error (level &rest args)
|
||||
"Beep an error if LEVEL is equal to or less than `gmm-verbose'.
|
||||
ARGS are passed to `message'."
|
||||
(when (<= (floor level) gmm-verbose)
|
||||
(apply 'message args)
|
||||
(ding)
|
||||
(let (duration)
|
||||
(when (and (floatp level)
|
||||
(not (zerop (setq duration (* 10 (- level (floor level)))))))
|
||||
(sit-for duration))))
|
||||
nil)
|
||||
|
||||
;;;###autoload
|
||||
(defun gmm-widget-p (symbol)
|
||||
"Non-nil iff SYMBOL is a widget."
|
||||
(get symbol 'widget-type))
|
||||
|
||||
;; Copy of the `nnmail-lazy' code from `nnmail.el':
|
||||
(define-widget 'gmm-lazy 'default
|
||||
"Base widget for recursive datastructures.
|
||||
|
||||
This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
|
||||
:format "%{%t%}: %v"
|
||||
:convert-widget 'widget-value-convert-widget
|
||||
:value-create (lambda (widget)
|
||||
(let ((value (widget-get widget :value))
|
||||
(type (widget-get widget :type)))
|
||||
(widget-put widget :children
|
||||
(list (widget-create-child-value
|
||||
widget (widget-convert type) value)))))
|
||||
:value-delete 'widget-children-value-delete
|
||||
:value-get (lambda (widget)
|
||||
(widget-value (car (widget-get widget :children))))
|
||||
:value-inline (lambda (widget)
|
||||
(widget-apply (car (widget-get widget :children))
|
||||
:value-inline))
|
||||
:default-get (lambda (widget)
|
||||
(widget-default-get
|
||||
(widget-convert (widget-get widget :type))))
|
||||
:match (lambda (widget value)
|
||||
(widget-apply (widget-convert (widget-get widget :type))
|
||||
:match value))
|
||||
:validate (lambda (widget)
|
||||
(widget-apply (car (widget-get widget :children)) :validate)))
|
||||
|
||||
;; Note: The format of `gmm-tool-bar-item' may change if some future Emacs
|
||||
;; version will provide customizable tool bar buttons using a different
|
||||
;; interface.
|
||||
|
||||
;; TODO: Extend API so that the "Command" entry can be a function or a plist.
|
||||
;; In case of a list it should have the format...
|
||||
;;
|
||||
;; (:none command-without-modifier
|
||||
;; :shift command-with-shift-pressed
|
||||
;; :control command-with-ctrl-pressed
|
||||
;; :control-shift command-with-control-and-shift-pressed
|
||||
;; ;; mouse-2 and mouse-3 can't be used in Emacs yet.
|
||||
;; :mouse-2 command-on-mouse-2-press
|
||||
;; :mouse-3 command-on-mouse-3-press) ;; typically a menu of related commands
|
||||
;;
|
||||
;; Combinations of mouse-[23] plus shift and/or controll might be overkill.
|
||||
;;
|
||||
;; Then use (plist-get rs-command :none), (plist-get rs-command :shift)
|
||||
|
||||
(define-widget 'gmm-tool-bar-item (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy)
|
||||
"Tool bar list item."
|
||||
:tag "Tool bar item"
|
||||
:type '(choice
|
||||
(list :tag "Command and Icon"
|
||||
(function :tag "Command")
|
||||
(string :tag "Icon file")
|
||||
(choice
|
||||
(const :tag "Default map" nil)
|
||||
;; Note: Usually we need non-nil attributes if map is t.
|
||||
(const :tag "No menu" t)
|
||||
(sexp :tag "Other map"))
|
||||
(plist :inline t :tag "Properties"))
|
||||
(list :tag "Separator"
|
||||
(const :tag "No command" gmm-ignore)
|
||||
(string :tag "Icon file")
|
||||
(const :tag "No map")
|
||||
(plist :inline t :tag "Properties"))))
|
||||
|
||||
(define-widget 'gmm-tool-bar-zap-list (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy)
|
||||
"Tool bar zap list."
|
||||
:tag "Tool bar zap list"
|
||||
:type '(choice (const :tag "Zap all" t)
|
||||
(const :tag "Keep all" nil)
|
||||
(list
|
||||
;; :value
|
||||
;; Work around (bug in customize?), see
|
||||
;; <news:v9is48jrj1.fsf@marauder.physik.uni-ulm.de>
|
||||
;; (new-file open-file dired kill-buffer write-file
|
||||
;; print-buffer customize help)
|
||||
(set :inline t
|
||||
(const new-file)
|
||||
(const open-file)
|
||||
(const dired)
|
||||
(const kill-buffer)
|
||||
(const save-buffer)
|
||||
(const write-file)
|
||||
(const undo)
|
||||
(const cut)
|
||||
(const copy)
|
||||
(const paste)
|
||||
(const search-forward)
|
||||
(const print-buffer)
|
||||
(const customize)
|
||||
(const help))
|
||||
(repeat :inline t
|
||||
:tag "Other"
|
||||
(symbol :tag "Icon item")))))
|
||||
|
||||
;; (defun gmm-color-cells (&optional display)
|
||||
;; "Return the number of color cells supported by DISPLAY.
|
||||
;; Compatibility function."
|
||||
;; ;; `display-color-cells' doesn't return more than 256 even if color depth is
|
||||
;; ;; > 8 in Emacs 21.
|
||||
;; ;;
|
||||
;; ;; Feel free to add proper XEmacs support.
|
||||
;; (let* ((cells (and (fboundp 'display-color-cells)
|
||||
;; (display-color-cells display)))
|
||||
;; (plane (and (fboundp 'x-display-planes)
|
||||
;; (ash 1 (x-display-planes))))
|
||||
;; (none -1))
|
||||
;; (max (if (integerp cells) cells none)
|
||||
;; (if (integerp plane) plane none))))
|
||||
|
||||
(defcustom gmm-tool-bar-style
|
||||
(if (and (boundp 'tool-bar-mode)
|
||||
tool-bar-mode
|
||||
(and (fboundp 'display-visual-class)
|
||||
(not (memq (display-visual-class)
|
||||
(list 'static-gray 'gray-scale
|
||||
'static-color 'pseudo-color)))))
|
||||
'gnome
|
||||
'retro)
|
||||
"Prefered tool bar style."
|
||||
:type '(choice (const :tag "GNOME style" 'gnome)
|
||||
(const :tag "Retro look" 'retro))
|
||||
:group 'gmm)
|
||||
|
||||
(defvar tool-bar-map)
|
||||
|
||||
;;;###autoload
|
||||
(defun gmm-tool-bar-from-list (icon-list zap-list default-map)
|
||||
"Make a tool bar from ICON-LIST.
|
||||
|
||||
Within each entry of ICON-LIST, the first element is a menu
|
||||
command, the second element is an icon file name and the third
|
||||
element is a test function. You can use \\[describe-key]
|
||||
<menu-entry> to find out the name of a menu command. The fourth
|
||||
and all following elements are passed a the PROPS argument to the
|
||||
function `tool-bar-local-item'.
|
||||
|
||||
If ZAP-LIST is a list, remove those item from the default
|
||||
`tool-bar-map'. If it is t, start with a new sparse map. You
|
||||
can use \\[describe-key] <icon> to find out the name of an icon
|
||||
item. When \\[describe-key] <icon> shows \"<tool-bar> <new-file>
|
||||
runs the command find-file\", then use `new-file' in ZAP-LIST.
|
||||
|
||||
DEFAULT-MAP specifies the default key map for ICON-LIST."
|
||||
(let (;; For Emacs 21, we must let-bind `tool-bar-map'. In Emacs 22, we
|
||||
;; could use some other local variable.
|
||||
(tool-bar-map (if (eq zap-list t)
|
||||
(make-sparse-keymap)
|
||||
(copy-keymap tool-bar-map))))
|
||||
(when (listp zap-list)
|
||||
;; Zap some items which aren't relevant for this mode and take up space.
|
||||
(dolist (key zap-list)
|
||||
(define-key tool-bar-map (vector key) nil)))
|
||||
(mapc (lambda (el)
|
||||
(let ((command (car el))
|
||||
(icon (nth 1 el))
|
||||
(fmap (or (nth 2 el) default-map))
|
||||
(props (cdr (cdr (cdr el)))) )
|
||||
;; command may stem from different from-maps:
|
||||
(cond ((eq command 'gmm-ignore)
|
||||
;; The dummy `gmm-ignore', see `gmm-tool-bar-item'
|
||||
;; widget. Suppress tooltip by adding `:enable nil'.
|
||||
(if (fboundp 'tool-bar-local-item)
|
||||
(apply 'tool-bar-local-item icon nil nil
|
||||
tool-bar-map :enable nil props)
|
||||
;; (tool-bar-local-item ICON DEF KEY MAP &rest PROPS)
|
||||
;; (tool-bar-add-item ICON DEF KEY &rest PROPS)
|
||||
(apply 'tool-bar-add-item icon nil nil :enable nil props)))
|
||||
((equal fmap t) ;; Not a menu command
|
||||
(if (fboundp 'tool-bar-local-item)
|
||||
(apply 'tool-bar-local-item
|
||||
icon command
|
||||
(intern icon) ;; reuse icon or fmap here?
|
||||
tool-bar-map props)
|
||||
;; Emacs 21 compatibility:
|
||||
(apply 'tool-bar-add-item
|
||||
icon command
|
||||
(intern icon)
|
||||
props)))
|
||||
(t ;; A menu command
|
||||
(if (fboundp 'tool-bar-local-item-from-menu)
|
||||
(apply 'tool-bar-local-item-from-menu
|
||||
;; (apply 'tool-bar-local-item icon def key
|
||||
;; tool-bar-map props)
|
||||
command icon tool-bar-map (symbol-value fmap)
|
||||
props)
|
||||
;; Emacs 21 compatibility:
|
||||
(apply 'tool-bar-add-item-from-menu
|
||||
command icon (symbol-value fmap)
|
||||
props))))
|
||||
t))
|
||||
(if (symbolp icon-list)
|
||||
(eval icon-list)
|
||||
icon-list))
|
||||
tool-bar-map))
|
||||
|
||||
;; WARNING: The following is subject to change. Don't rely on it yet.
|
||||
|
||||
;; From MH-E without modifications:
|
||||
|
||||
(defmacro gmm-defun-compat (name function arg-list &rest body)
|
||||
"Create function NAME.
|
||||
If FUNCTION exists, then NAME becomes an alias for FUNCTION.
|
||||
Otherwise, create function NAME with ARG-LIST and BODY."
|
||||
(let ((defined-p (fboundp function)))
|
||||
(if defined-p
|
||||
`(defalias ',name ',function)
|
||||
`(defun ,name ,arg-list ,@body))))
|
||||
|
||||
(gmm-defun-compat gmm-image-search-load-path
|
||||
image-search-load-path (file &optional path)
|
||||
"Emacs 21 and XEmacs don't have `image-search-load-path'.
|
||||
This function returns nil on those systems."
|
||||
nil)
|
||||
|
||||
;; From MH-E with modifications:
|
||||
|
||||
;; Don't use `gmm-defun-compat' until API changes in
|
||||
;; `image-load-path-for-library' in Emacs CVS are completed.
|
||||
|
||||
(defun gmm-image-load-path-for-library (library image &optional path no-error)
|
||||
"Return a suitable search path for images relative to LIBRARY.
|
||||
|
||||
First it searches for IMAGE in `image-load-path' (excluding
|
||||
\"`data-directory'/images\") and `load-path', followed by a path
|
||||
suitable for LIBRARY, which includes \"../../etc/images\" and
|
||||
\"../etc/images\" relative to the library file itself, and then
|
||||
in \"`data-directory'/images\".
|
||||
|
||||
Then this function returns a list of directories which contains
|
||||
first the directory in which IMAGE was found, followed by the
|
||||
value of `load-path'. If PATH is given, it is used instead of
|
||||
`load-path'.
|
||||
|
||||
If NO-ERROR is non-nil and a suitable path can't be found, don't
|
||||
signal an error. Instead, return a list of directories as before,
|
||||
except that nil appears in place of the image directory.
|
||||
|
||||
Here is an example that uses a common idiom to provide
|
||||
compatibility with versions of Emacs that lack the variable
|
||||
`image-load-path':
|
||||
|
||||
;; Shush compiler.
|
||||
(defvar image-load-path)
|
||||
|
||||
(let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
|
||||
(image-load-path (cons (car load-path)
|
||||
(when (boundp 'image-load-path)
|
||||
image-load-path))))
|
||||
(mh-tool-bar-folder-buttons-init))"
|
||||
(unless library (error "No library specified"))
|
||||
(unless image (error "No image specified"))
|
||||
(let (image-directory image-directory-load-path)
|
||||
;; Check for images in image-load-path or load-path.
|
||||
(let ((img image)
|
||||
(dir (or
|
||||
;; Images in image-load-path.
|
||||
(gmm-image-search-load-path image) ;; "gmm-" prefix!
|
||||
;; Images in load-path.
|
||||
(locate-library image)))
|
||||
parent)
|
||||
;; Since the image might be in a nested directory (for
|
||||
;; example, mail/attach.pbm), adjust `image-directory'
|
||||
;; accordingly.
|
||||
(when dir
|
||||
(setq dir (file-name-directory dir))
|
||||
(while (setq parent (file-name-directory img))
|
||||
(setq img (directory-file-name parent)
|
||||
dir (expand-file-name "../" dir))))
|
||||
(setq image-directory-load-path dir))
|
||||
|
||||
;; If `image-directory-load-path' isn't Emacs' image directory,
|
||||
;; it's probably a user preference, so use it. Then use a
|
||||
;; relative setting if possible; otherwise, use
|
||||
;; `image-directory-load-path'.
|
||||
(cond
|
||||
;; User-modified image-load-path?
|
||||
((and image-directory-load-path
|
||||
(not (equal image-directory-load-path
|
||||
(file-name-as-directory
|
||||
(expand-file-name "images" data-directory)))))
|
||||
(setq image-directory image-directory-load-path))
|
||||
;; Try relative setting.
|
||||
((let (library-name d1ei d2ei)
|
||||
;; First, find library in the load-path.
|
||||
(setq library-name (locate-library library))
|
||||
(if (not library-name)
|
||||
(error "Cannot find library %s in load-path" library))
|
||||
;; And then set image-directory relative to that.
|
||||
(setq
|
||||
;; Go down 2 levels.
|
||||
d2ei (file-name-as-directory
|
||||
(expand-file-name
|
||||
(concat (file-name-directory library-name) "../../etc/images")))
|
||||
;; Go down 1 level.
|
||||
d1ei (file-name-as-directory
|
||||
(expand-file-name
|
||||
(concat (file-name-directory library-name) "../etc/images"))))
|
||||
(setq image-directory
|
||||
;; Set it to nil if image is not found.
|
||||
(cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
|
||||
((file-exists-p (expand-file-name image d1ei)) d1ei)))))
|
||||
;; Use Emacs' image directory.
|
||||
(image-directory-load-path
|
||||
(setq image-directory image-directory-load-path))
|
||||
(no-error
|
||||
(message "Could not find image %s for library %s" image library))
|
||||
(t
|
||||
(error "Could not find image %s for library %s" image library)))
|
||||
|
||||
;; Return an augmented `path' or `load-path'.
|
||||
(nconc (list image-directory)
|
||||
(delete image-directory (copy-sequence (or path load-path))))))
|
||||
|
||||
(defun gmm-customize-mode (&optional mode)
|
||||
"Customize customization group for MODE.
|
||||
If mode is nil, use `major-mode' of the curent buffer."
|
||||
(interactive)
|
||||
(customize-group
|
||||
(or mode
|
||||
(intern (let ((mode (symbol-name major-mode)))
|
||||
(string-match "^\\(.+\\)-mode$" mode)
|
||||
(match-string 1 mode))))))
|
||||
|
||||
(provide 'gmm-utils)
|
||||
|
||||
;; arch-tag: e0b60920-2ce6-40c1-bfc0-cadbbe26b602
|
||||
;;; gmm-utils.el ends here
|
||||
@ -39,6 +39,7 @@
|
||||
(require 'gnus-range)
|
||||
(require 'gnus-win)
|
||||
(require 'gnus-undo)
|
||||
(require 'gmm-utils)
|
||||
(require 'time-date)
|
||||
(require 'gnus-ems)
|
||||
|
||||
@ -979,36 +980,135 @@ simple manner.")
|
||||
|
||||
(gnus-run-hooks 'gnus-group-menu-hook)))
|
||||
|
||||
(defvar gnus-group-toolbar-map nil)
|
||||
|
||||
;; Emacs 21 tool bar. Should be no-op otherwise.
|
||||
(defun gnus-group-make-tool-bar ()
|
||||
(if (and
|
||||
(condition-case nil (require 'tool-bar) (error nil))
|
||||
(fboundp 'tool-bar-add-item-from-menu)
|
||||
(default-value 'tool-bar-mode)
|
||||
(not gnus-group-toolbar-map))
|
||||
(setq gnus-group-toolbar-map
|
||||
(let ((tool-bar-map (make-sparse-keymap))
|
||||
(load-path (mm-image-load-path)))
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-group-get-new-news "get-news" gnus-group-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-group-catchup-current "catchup" gnus-group-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-group-describe-group "describe-group" gnus-group-mode-map)
|
||||
(tool-bar-add-item "subscribe" 'gnus-group-subscribe 'subscribe
|
||||
:help "Subscribe to the current group")
|
||||
(tool-bar-add-item "unsubscribe" 'gnus-group-unsubscribe
|
||||
'unsubscribe
|
||||
:help "Unsubscribe from the current group")
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-group-exit "exit-gnus" gnus-group-mode-map)
|
||||
tool-bar-map)))
|
||||
(if gnus-group-toolbar-map
|
||||
(set (make-local-variable 'tool-bar-map) gnus-group-toolbar-map)))
|
||||
(defvar gnus-group-tool-bar-map nil)
|
||||
|
||||
(defun gnus-group-tool-bar-update (&optional symbol value)
|
||||
"Update group buffer toolbar.
|
||||
Setter function for custom variables."
|
||||
(when symbol
|
||||
(set-default symbol value))
|
||||
;; (setq-default gnus-group-tool-bar-map nil)
|
||||
;; (use-local-map gnus-group-mode-map)
|
||||
(when (gnus-alive-p)
|
||||
(with-current-buffer gnus-group-buffer
|
||||
(gnus-group-make-tool-bar t))))
|
||||
|
||||
(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome)
|
||||
'gnus-group-tool-bar-gnome
|
||||
'gnus-group-tool-bar-retro)
|
||||
"Specifies the Gnus group tool bar.
|
||||
|
||||
It can be either a list or a symbol refering to a list. See
|
||||
`gmm-tool-bar-from-list' for the format of the list. The
|
||||
default key map is `gnus-group-mode-map'.
|
||||
|
||||
Pre-defined symbols include `gnus-group-tool-bar-gnome' and
|
||||
`gnus-group-tool-bar-retro'."
|
||||
:type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome)
|
||||
(const :tag "Retro look" gnus-group-tool-bar-retro)
|
||||
(repeat :tag "User defined list" gmm-tool-bar-item)
|
||||
(symbol))
|
||||
:version "23.0" ;; No Gnus
|
||||
:initialize 'custom-initialize-default
|
||||
:set 'gnus-group-tool-bar-update
|
||||
:group 'gnus-group)
|
||||
|
||||
(defcustom gnus-group-tool-bar-gnome
|
||||
'((gnus-group-post-news "mail/compose")
|
||||
;; Some useful agent icons? I don't use the agent so agent users should
|
||||
;; suggest useful commands:
|
||||
(gnus-agent-toggle-plugged "connect" t
|
||||
:visible (and gnus-agent (not gnus-plugged)))
|
||||
(gnus-agent-toggle-plugged "disconnect" t
|
||||
:visible (and gnus-agent gnus-plugged))
|
||||
;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
|
||||
;; should have a better help text.
|
||||
(gnus-group-send-queue "mail/outbox" t
|
||||
:visible (and gnus-agent gnus-plugged)
|
||||
:help "Send articles from the queue group")
|
||||
(gnus-group-get-new-news "mail/inbox" nil
|
||||
:visible (or (not gnus-agent)
|
||||
gnus-plugged))
|
||||
;; FIXME: gnus-*-read-group should have a better help text.
|
||||
(gnus-topic-read-group "open" nil
|
||||
:visible (and (boundp 'gnus-topic-mode)
|
||||
gnus-topic-mode))
|
||||
(gnus-group-read-group "open" nil
|
||||
:visible (not (and (boundp 'gnus-topic-mode)
|
||||
gnus-topic-mode)))
|
||||
;; (gnus-group-find-new-groups "???" nil)
|
||||
(gnus-group-save-newsrc "save")
|
||||
(gnus-group-describe-group "describe")
|
||||
(gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
|
||||
(gnus-group-prev-unread-group "left-arrow")
|
||||
(gnus-group-next-unread-group "right-arrow")
|
||||
(gnus-group-exit "exit")
|
||||
(gmm-customize-mode "preferences" t :help "Edit mode preferences")
|
||||
(gnus-info-find-node "help"))
|
||||
"List of functions for the group tool bar (GNOME style).
|
||||
|
||||
See `gmm-tool-bar-from-list' for the format of the list."
|
||||
:type '(repeat gmm-tool-bar-item)
|
||||
:version "23.0" ;; No Gnus
|
||||
:initialize 'custom-initialize-default
|
||||
:set 'gnus-group-tool-bar-update
|
||||
:group 'gnus-group)
|
||||
|
||||
(defcustom gnus-group-tool-bar-retro
|
||||
'((gnus-group-get-new-news "gnus/get-news")
|
||||
(gnus-group-get-new-news-this-group "gnus/gnntg")
|
||||
(gnus-group-catchup-current "gnus/catchup")
|
||||
(gnus-group-describe-group "gnus/describe-group")
|
||||
(gnus-group-subscribe "gnus/subscribe" t
|
||||
:help "Subscribe to the current group")
|
||||
(gnus-group-unsubscribe "gnus/unsubscribe" t
|
||||
:help "Unsubscribe from the current group")
|
||||
(gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map))
|
||||
"List of functions for the group tool bar (retro look).
|
||||
|
||||
See `gmm-tool-bar-from-list' for the format of the list."
|
||||
:type '(repeat gmm-tool-bar-item)
|
||||
:version "23.0" ;; No Gnus
|
||||
:initialize 'custom-initialize-default
|
||||
:set 'gnus-group-tool-bar-update
|
||||
:group 'gnus-group)
|
||||
|
||||
(defcustom gnus-group-tool-bar-zap-list t
|
||||
"List of icon items from the global tool bar.
|
||||
These items are not displayed in the Gnus group mode tool bar.
|
||||
|
||||
See `gmm-tool-bar-from-list' for the format of the list."
|
||||
:type 'gmm-tool-bar-zap-list
|
||||
:version "23.0" ;; No Gnus
|
||||
:initialize 'custom-initialize-default
|
||||
:set 'gnus-group-tool-bar-update
|
||||
:group 'gnus-group)
|
||||
|
||||
(defvar image-load-path)
|
||||
|
||||
(defun gnus-group-make-tool-bar (&optional force)
|
||||
"Make a group mode tool bar from `gnus-group-tool-bar'.
|
||||
When FORCE, rebuild the tool bar."
|
||||
(when (and (not (featurep 'xemacs))
|
||||
(boundp 'tool-bar-mode)
|
||||
tool-bar-mode
|
||||
;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode).
|
||||
;; Why? --rsteib
|
||||
(or (not gnus-group-tool-bar-map) force))
|
||||
(let* ((load-path
|
||||
(gmm-image-load-path-for-library "gnus"
|
||||
"gnus/toggle-subscription.xpm"
|
||||
nil t))
|
||||
(image-load-path (cons (car load-path)
|
||||
(when (boundp 'image-load-path)
|
||||
image-load-path)))
|
||||
(map (gmm-tool-bar-from-list gnus-group-tool-bar
|
||||
gnus-group-tool-bar-zap-list
|
||||
'gnus-group-mode-map)))
|
||||
(if map
|
||||
(set (make-local-variable 'tool-bar-map) map))))
|
||||
gnus-group-tool-bar-map)
|
||||
|
||||
(defun gnus-group-mode ()
|
||||
"Major mode for reading news.
|
||||
@ -1379,6 +1479,18 @@ if it is a string, only list groups matching REGEXP."
|
||||
(gnus-range-difference (list active) (gnus-info-read info))
|
||||
seen))))))
|
||||
|
||||
;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't
|
||||
;; update the state (enabled/disabled) of the icon
|
||||
;; `gnus-group-describe-group'. After `C-l' the state is correct. See the
|
||||
;; following report on emacs-devel
|
||||
;; <http://thread.gmane.org/v9acdmrcse.fsf@marauder.physik.uni-ulm.de>:
|
||||
|
||||
;; From: Reiner Steib
|
||||
;; Subject: tool bar icons not updated according to :active condition
|
||||
;; Newsgroups: gmane.emacs.devel
|
||||
;; Date: Mon, 23 Jan 2006 19:59:13 +0100
|
||||
;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de>
|
||||
|
||||
(defcustom gnus-group-update-tool-bar
|
||||
(and (not (featurep 'xemacs))
|
||||
(boundp 'tool-bar-mode)
|
||||
|
||||
@ -38,6 +38,7 @@
|
||||
(require 'gnus-int)
|
||||
(require 'gnus-undo)
|
||||
(require 'gnus-util)
|
||||
(require 'gmm-utils)
|
||||
(require 'mm-decode)
|
||||
(require 'nnoo)
|
||||
|
||||
@ -2546,47 +2547,161 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
|
||||
|
||||
(defvar gnus-summary-tool-bar-map nil)
|
||||
|
||||
;; Emacs 21 tool bar. Should be no-op otherwise.
|
||||
(defun gnus-summary-make-tool-bar ()
|
||||
(if (and (fboundp 'tool-bar-add-item-from-menu)
|
||||
(default-value 'tool-bar-mode)
|
||||
(not gnus-summary-tool-bar-map))
|
||||
(setq gnus-summary-tool-bar-map
|
||||
(let ((tool-bar-map (make-sparse-keymap))
|
||||
(load-path (mm-image-load-path)))
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-next-unread "next-ur" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-post-news "post" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-followup-with-original "fuwo" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-followup "followup" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-reply-with-original "reply-wo" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-reply "reply" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-caesar-message "rot13" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-uu-decode-uu "uu-decode" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-save-article-file "save-aif" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-save-article "save-art" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-uu-post-news "uu-post" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-catchup "catchup" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-catchup-and-exit "cu-exit" gnus-summary-mode-map)
|
||||
(tool-bar-add-item-from-menu
|
||||
'gnus-summary-exit "exit-summ" gnus-summary-mode-map)
|
||||
tool-bar-map)))
|
||||
(if gnus-summary-tool-bar-map
|
||||
(set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
|
||||
;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only
|
||||
;; affect _new_ message buffers. We might add a function that walks thru all
|
||||
;; summary-mode buffers and force the update.
|
||||
(defun gnus-summary-tool-bar-update (&optional symbol value)
|
||||
"Update summary mode toolbar.
|
||||
Setter function for custom variables."
|
||||
(setq-default gnus-summary-tool-bar-map nil)
|
||||
(when symbol
|
||||
;; When used as ":set" function:
|
||||
(set-default symbol value))
|
||||
(when (gnus-buffer-live-p gnus-summary-buffer)
|
||||
(with-current-buffer gnus-summary-buffer
|
||||
(gnus-summary-make-tool-bar))))
|
||||
|
||||
(defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome)
|
||||
'gnus-summary-tool-bar-gnome
|
||||
'gnus-summary-tool-bar-retro)
|
||||
"Specifies the Gnus summary tool bar.
|
||||
|
||||
It can be either a list or a symbol refering to a list. See
|
||||
`gmm-tool-bar-from-list' for the format of the list. The
|
||||
default key map is `gnus-summary-mode-map'.
|
||||
|
||||
Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
|
||||
`gnus-summary-tool-bar-retro'."
|
||||
:type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome)
|
||||
(const :tag "Retro look" gnus-summary-tool-bar-retro)
|
||||
(repeat :tag "User defined list" gmm-tool-bar-item)
|
||||
(symbol))
|
||||
:version "23.0" ;; No Gnus
|
||||
:initialize 'custom-initialize-default
|
||||
:set 'gnus-summary-tool-bar-update
|
||||
:group 'gnus-summary)
|
||||
|
||||
(defcustom gnus-summary-tool-bar-gnome
|
||||
'((gnus-summary-post-news "mail/compose" nil)
|
||||
(gnus-summary-insert-new-articles "mail/inbox" nil
|
||||
:visible (or (not gnus-agent)
|
||||
gnus-plugged))
|
||||
(gnus-summary-reply-with-original "mail/reply")
|
||||
(gnus-summary-reply "mail/reply" nil :visible nil)
|
||||
(gnus-summary-followup-with-original "mail/reply-all")
|
||||
(gnus-summary-followup "mail/reply-all" nil :visible nil)
|
||||
(gnus-summary-mail-forward "mail/forward")
|
||||
(gnus-summary-save-article "mail/save")
|
||||
(gnus-summary-search-article-forward "search" nil :visible nil)
|
||||
(gnus-summary-print-article "print")
|
||||
(gnus-summary-tick-article-forward "flag-followup" nil :visible nil)
|
||||
;; Some new commands that may need more suitable icons:
|
||||
(gnus-summary-save-newsrc "save" nil :visible nil)
|
||||
;; (gnus-summary-show-article "stock_message-display" nil :visible nil)
|
||||
(gnus-summary-prev-article "left-arrow")
|
||||
(gnus-summary-next-article "right-arrow")
|
||||
(gnus-summary-next-page "next-page")
|
||||
;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil)
|
||||
;;
|
||||
;; Maybe some sort-by-... could be added:
|
||||
;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil)
|
||||
;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil)
|
||||
(gnus-summary-mark-as-expirable
|
||||
"delete" nil
|
||||
:visible (gnus-check-backend-function 'request-expire-articles
|
||||
gnus-newsgroup-name))
|
||||
(gnus-summary-mark-as-spam
|
||||
"mail/spam" t
|
||||
:visible (and (fboundp 'spam-group-ham-contents-p)
|
||||
(spam-group-ham-contents-p gnus-newsgroup-name))
|
||||
:help "Mark as spam")
|
||||
(gnus-summary-mark-as-read-forward
|
||||
"mail/not-spam" nil
|
||||
:visible (and (fboundp 'spam-group-spam-contents-p)
|
||||
(spam-group-spam-contents-p gnus-newsgroup-name)))
|
||||
;;
|
||||
(gnus-summary-exit "exit")
|
||||
(gmm-customize-mode "preferences" t :help "Edit mode preferences")
|
||||
(gnus-info-find-node "help"))
|
||||
"List of functions for the summary tool bar (GNOME style).
|
||||
|
||||
See `gmm-tool-bar-from-list' for the format of the list."
|
||||
:type '(repeat gmm-tool-bar-item)
|
||||
:version "23.0" ;; No Gnus
|
||||
:initialize 'custom-initialize-default
|
||||
:set 'gnus-summary-tool-bar-update
|
||||
:group 'gnus-summary)
|
||||
|
||||
(defcustom gnus-summary-tool-bar-retro
|
||||
'((gnus-summary-prev-unread-article "gnus/prev-ur")
|
||||
(gnus-summary-next-unread-article "gnus/next-ur")
|
||||
(gnus-summary-post-news "gnus/post")
|
||||
(gnus-summary-followup-with-original "gnus/fuwo")
|
||||
(gnus-summary-followup "gnus/followup")
|
||||
(gnus-summary-reply-with-original "gnus/reply-wo")
|
||||
(gnus-summary-reply "gnus/reply")
|
||||
(gnus-summary-caesar-message "gnus/rot13")
|
||||
(gnus-uu-decode-uu "gnus/uu-decode")
|
||||
(gnus-summary-save-article-file "gnus/save-aif")
|
||||
(gnus-summary-save-article "gnus/save-art")
|
||||
(gnus-uu-post-news "gnus/uu-post")
|
||||
(gnus-summary-catchup "gnus/catchup")
|
||||
(gnus-summary-catchup-and-exit "gnus/cu-exit")
|
||||
(gnus-summary-exit "gnus/exit-summ")
|
||||
;; Some new command that may need more suitable icons:
|
||||
(gnus-summary-print-article "gnus/print" nil :visible nil)
|
||||
(gnus-summary-mark-as-expirable "gnus/close" nil :visible nil)
|
||||
(gnus-summary-save-newsrc "gnus/save" nil :visible nil)
|
||||
;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil)
|
||||
(gnus-summary-search-article-forward "gnus/search" nil :visible nil)
|
||||
;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil)
|
||||
;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil)
|
||||
;;
|
||||
(gnus-info-find-node "gnus/help" nil :visible nil))
|
||||
"List of functions for the summary tool bar (retro look).
|
||||
|
||||
See `gmm-tool-bar-from-list' for the format of the list."
|
||||
:type '(repeat gmm-tool-bar-item)
|
||||
:version "23.0" ;; No Gnus
|
||||
:initialize 'custom-initialize-default
|
||||
:set 'gnus-summary-tool-bar-update
|
||||
:group 'gnus-summary)
|
||||
|
||||
(defcustom gnus-summary-tool-bar-zap-list t
|
||||
"List of icon items from the global tool bar.
|
||||
These items are not displayed in the Gnus summary mode tool bar.
|
||||
|
||||
See `gmm-tool-bar-from-list' for the format of the list."
|
||||
:type 'gmm-tool-bar-zap-list
|
||||
:version "23.0" ;; No Gnus
|
||||
:initialize 'custom-initialize-default
|
||||
:set 'gnus-summary-tool-bar-update
|
||||
:group 'gnus-summary)
|
||||
|
||||
(defvar image-load-path)
|
||||
|
||||
(defun gnus-summary-make-tool-bar (&optional force)
|
||||
"Make a summary mode tool bar from `gnus-summary-tool-bar'.
|
||||
When FORCE, rebuild the tool bar."
|
||||
(when (and (not (featurep 'xemacs))
|
||||
(boundp 'tool-bar-mode)
|
||||
tool-bar-mode
|
||||
(or (not gnus-summary-tool-bar-map) force))
|
||||
(let* ((load-path
|
||||
(gmm-image-load-path-for-library "gnus"
|
||||
"mail/save.xpm"
|
||||
nil t))
|
||||
(image-load-path (cons (car load-path)
|
||||
(when (boundp 'image-load-path)
|
||||
image-load-path)))
|
||||
(map (gmm-tool-bar-from-list gnus-summary-tool-bar
|
||||
gnus-summary-tool-bar-zap-list
|
||||
'gnus-summary-mode-map)))
|
||||
(when map
|
||||
;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode'
|
||||
;; uses it's value.
|
||||
(setq gnus-summary-tool-bar-map map))))
|
||||
(set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
|
||||
|
||||
(defun gnus-score-set-default (var value)
|
||||
"A version of set that updates the GNU Emacs menu-bar."
|
||||
|
||||
@ -37,6 +37,7 @@
|
||||
(defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
|
||||
(require 'canlock)
|
||||
(require 'mailheader)
|
||||
(require 'gmm-utils)
|
||||
(require 'nnheader)
|
||||
;; This is apparently necessary even though things are autoloaded.
|
||||
;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
|
||||
@ -2529,7 +2530,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
|
||||
(set (make-local-variable 'font-lock-defaults)
|
||||
'(message-font-lock-keywords t))
|
||||
(if (boundp 'tool-bar-map)
|
||||
(set (make-local-variable 'tool-bar-map) (message-tool-bar-map))))
|
||||
(set (make-local-variable 'tool-bar-map) (message-make-tool-bar))))
|
||||
(easy-menu-add message-mode-menu message-mode-map)
|
||||
(easy-menu-add message-mode-field-menu message-mode-map)
|
||||
(gnus-make-local-hook 'after-change-functions)
|
||||
@ -6586,53 +6587,123 @@ which specify the range to operate on."
|
||||
|
||||
;; Support for toolbar
|
||||
(eval-when-compile
|
||||
(defvar tool-bar-map)
|
||||
(defvar tool-bar-mode))
|
||||
|
||||
(defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props)
|
||||
;; We need to make tool bar entries in local keymaps with
|
||||
;; `tool-bar-local-item-from-menu' in Emacs >= 22
|
||||
(if (fboundp 'tool-bar-local-item-from-menu)
|
||||
(tool-bar-local-item-from-menu command icon in-map from-map props)
|
||||
(tool-bar-add-item-from-menu command icon from-map props)))
|
||||
;; Note: The :set function in the `message-tool-bar*' variables will only
|
||||
;; affect _new_ message buffers. We might add a function that walks thru all
|
||||
;; message-mode buffers and force the update.
|
||||
(defun message-tool-bar-update (&optional symbol value)
|
||||
"Update message mode toolbar.
|
||||
Setter function for custom variables."
|
||||
(setq-default message-tool-bar-map nil)
|
||||
(when symbol
|
||||
;; When used as ":set" function:
|
||||
(set-default symbol value)))
|
||||
|
||||
(defun message-tool-bar-map ()
|
||||
(or message-tool-bar-map
|
||||
(setq message-tool-bar-map
|
||||
(and
|
||||
(condition-case nil (require 'tool-bar) (error nil))
|
||||
(fboundp 'tool-bar-add-item-from-menu)
|
||||
(defcustom message-tool-bar (if (eq gmm-tool-bar-style 'gnome)
|
||||
'message-tool-bar-gnome
|
||||
'message-tool-bar-retro)
|
||||
"Specifies the message mode tool bar.
|
||||
|
||||
It can be either a list or a symbol refering to a list. See
|
||||
`gmm-tool-bar-from-list' for the format of the list. The
|
||||
default key map is `message-mode-map'.
|
||||
|
||||
Pre-defined symbols include `message-tool-bar-gnome' and
|
||||
`message-tool-bar-retro'."
|
||||
:type '(repeat gmm-tool-bar-list-item)
|
||||
:type '(choice (const :tag "GNOME style" message-tool-bar-gnome)
|
||||
(const :tag "Retro look" message-tool-bar-retro)
|
||||
(repeat :tag "User defined list" gmm-tool-bar-item)
|
||||
(symbol))
|
||||
:version "22.1" ;; Gnus 5.10.9
|
||||
:initialize 'custom-initialize-default
|
||||
:set 'message-tool-bar-update
|
||||
:group 'message)
|
||||
|
||||
(defcustom message-tool-bar-gnome
|
||||
'((ispell-message "spell" nil
|
||||
:visible (or (not (boundp 'flyspell-mode))
|
||||
(not flyspell-mode)))
|
||||
(flyspell-buffer "spell" t
|
||||
:visible (and (boundp 'flyspell-mode)
|
||||
flyspell-mode)
|
||||
:help "Flyspell whole buffer")
|
||||
(gmm-ignore "separator")
|
||||
(message-send-and-exit "mail/send")
|
||||
(message-dont-send "mail/save-draft")
|
||||
(message-kill-buffer "close") ;; stock_cancel
|
||||
(mml-attach-file "attach" mml-mode-map)
|
||||
(mml-preview "mail/preview" mml-mode-map)
|
||||
;; (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil)
|
||||
(message-insert-importance-high "important" nil :visible nil)
|
||||
(message-insert-importance-low "unimportant" nil :visible nil)
|
||||
(message-insert-disposition-notification-to "receipt" nil :visible nil)
|
||||
(gmm-customize-mode "preferences" t :help "Edit mode preferences")
|
||||
(message-info "help" t :help "Message manual"))
|
||||
"List of items for the message tool bar (GNOME style).
|
||||
|
||||
See `gmm-tool-bar-from-list' for details on the format of the list."
|
||||
:type '(repeat gmm-tool-bar-item)
|
||||
:version "22.1" ;; Gnus 5.10.9
|
||||
:initialize 'custom-initialize-default
|
||||
:set 'message-tool-bar-update
|
||||
:group 'message)
|
||||
|
||||
(defcustom message-tool-bar-retro
|
||||
'(;; Old Emacs 21 icon for consistency.
|
||||
(message-send-and-exit "gnus/mail_send")
|
||||
(message-kill-buffer "close")
|
||||
(message-dont-send "cancel")
|
||||
(mml-attach-file "attach" mml-mode-map)
|
||||
(ispell-message "spell")
|
||||
(mml-preview "preview" mml-mode-map)
|
||||
(message-insert-importance-high "gnus/important")
|
||||
(message-insert-importance-low "gnus/unimportant")
|
||||
(message-insert-disposition-notification-to "gnus/receipt"))
|
||||
"List of items for the message tool bar (retro style).
|
||||
|
||||
See `gmm-tool-bar-from-list' for details on the format of the list."
|
||||
:type '(repeat gmm-tool-bar-item)
|
||||
:version "22.1" ;; Gnus 5.10.9
|
||||
:initialize 'custom-initialize-default
|
||||
:set 'message-tool-bar-update
|
||||
:group 'message)
|
||||
|
||||
(defcustom message-tool-bar-zap-list
|
||||
'(new-file open-file dired kill-buffer write-file
|
||||
print-buffer customize help)
|
||||
"List of icon items from the global tool bar.
|
||||
These items are not displayed on the message mode tool bar.
|
||||
|
||||
See `gmm-tool-bar-from-list' for the format of the list."
|
||||
:type 'gmm-tool-bar-zap-list
|
||||
:version "22.1" ;; Gnus 5.10.9
|
||||
:initialize 'custom-initialize-default
|
||||
:set 'message-tool-bar-update
|
||||
:group 'message)
|
||||
|
||||
(defvar image-load-path)
|
||||
|
||||
(defun message-make-tool-bar (&optional force)
|
||||
"Make a message mode tool bar from `message-tool-bar-list'.
|
||||
When FORCE, rebuild the tool bar."
|
||||
(when (and (not (featurep 'xemacs))
|
||||
(boundp 'tool-bar-mode)
|
||||
tool-bar-mode
|
||||
(let ((tool-bar-map (copy-keymap tool-bar-map))
|
||||
(load-path (mm-image-load-path)))
|
||||
;; Zap some items which aren't so relevant and take
|
||||
;; up space.
|
||||
(dolist (key '(print-buffer kill-buffer save-buffer
|
||||
write-file dired open-file))
|
||||
(define-key tool-bar-map (vector key) nil))
|
||||
(message-tool-bar-local-item-from-menu
|
||||
'message-send-and-exit "mail/send" tool-bar-map message-mode-map)
|
||||
(message-tool-bar-local-item-from-menu
|
||||
'message-kill-buffer "close" tool-bar-map message-mode-map)
|
||||
(message-tool-bar-local-item-from-menu
|
||||
'message-dont-send "cancel" tool-bar-map message-mode-map)
|
||||
(message-tool-bar-local-item-from-menu
|
||||
'mml-attach-file "attach" tool-bar-map mml-mode-map)
|
||||
(message-tool-bar-local-item-from-menu
|
||||
'ispell-message "spell" tool-bar-map message-mode-map)
|
||||
(message-tool-bar-local-item-from-menu
|
||||
'mml-preview "preview"
|
||||
tool-bar-map mml-mode-map)
|
||||
(message-tool-bar-local-item-from-menu
|
||||
'message-insert-importance-high "important"
|
||||
tool-bar-map message-mode-map)
|
||||
(message-tool-bar-local-item-from-menu
|
||||
'message-insert-importance-low "unimportant"
|
||||
tool-bar-map message-mode-map)
|
||||
(message-tool-bar-local-item-from-menu
|
||||
'message-insert-disposition-notification-to "receipt"
|
||||
tool-bar-map message-mode-map)
|
||||
tool-bar-map)))))
|
||||
(or (not message-tool-bar-map) force))
|
||||
(setq message-tool-bar-map
|
||||
(let* ((load-path
|
||||
(gmm-image-load-path-for-library "message"
|
||||
"mail/save-draft.xpm"
|
||||
nil t))
|
||||
(image-load-path (cons (car load-path)
|
||||
(when (boundp 'image-load-path)
|
||||
image-load-path))))
|
||||
(gmm-tool-bar-from-list message-tool-bar
|
||||
message-tool-bar-zap-list
|
||||
'message-mode-map))))
|
||||
message-tool-bar-map)
|
||||
|
||||
;;; Group name completion.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user