;;; mh-tool-bar.el --- MH-E tool bar support
-;; Copyright (C) 2002, 2003, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2005-2012 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Tool Bar Creation
+;; Shush compiler.
+(defvar image-load-path)
+
(defmacro mh-tool-bar-define (defaults &rest buttons)
"Define a tool bar for MH-E.
DEFAULTS is the list of buttons that are present by default. It
first line is useful and complete without the rest of the string.
Optional item ENABLE-EXPR is an arbitrary lisp expression. If it
- evaluates to nil, then the button is deactivated, otherwise it is
+ evaluates to nil, then the button is inactive, otherwise it is
active. If it isn't present then the button is always active."
;; The following variable names have been carefully chosen to make code
;; generation easier. Modifying the names should be done carefully.
(name-str (symbol-name name))
(icon (nth 2 button))
(xemacs-icon (mh-do-in-xemacs
- (cdr (assoc (intern icon) mh-xemacs-icon-map))))
+ `(cdr (assoc (quote ,(intern icon)) mh-xemacs-icon-map))))
(full-doc (nth 3 button))
(doc (if (string-match "\\(.*\\)\n" full-doc)
(match-string 1 full-doc)
(t 'folder-vectors)))
(list (cond ((eq type :letter) 'mh-tool-bar-letter-buttons)
(t 'mh-tool-bar-folder-buttons)))
- (key (intern (concat "mh-" type1 "tool-bar-" name-str)))
+ (key (intern (concat "mh-" type1 "-tool-bar-" name-str)))
(setter (intern (concat type1 "-button-setter")))
(mbuttons (cond ((eq type :letter) 'letter-buttons)
((eq type :show) 'show-buttons)
(t 'folder-buttons)))
(docs (cond ((eq mbuttons 'letter-buttons) 'letter-docs)
((eq mbuttons 'folder-buttons) 'folder-docs))))
- (add-to-list vector-list `[,xemacs-icon ,function t ,full-doc])
+ (add-to-list vector-list `(vector ,xemacs-icon ',function t ,full-doc))
(add-to-list
setter `(when (member ',name ,list)
(mh-funcall-if-exists
(unless (memq x letter-buttons)
(error "Letter defaults contains unknown button %s" x)))
`(eval-when (compile load eval)
- (defun mh-buffer-exists-p (mode)
- "Test whether a buffer with major mode MODE is present."
- (loop for buf in (buffer-list)
- when (save-excursion
- (set-buffer buf)
- (eq major-mode mode))
- return t))
-
;; GNU Emacs tool bar specific code
(mh-do-in-gnu-emacs
+ (defun mh-buffer-exists-p (mode)
+ "Test whether a buffer with major mode MODE is present."
+ (loop for buf in (buffer-list)
+ when (with-current-buffer buf
+ (eq major-mode mode))
+ return t))
;; Tool bar initialization functions
(defun mh-tool-bar-folder-buttons-init ()
(when (mh-buffer-exists-p 'mh-folder-mode)
- (setq mh-folder-tool-bar-map
- (let ((tool-bar-map (make-sparse-keymap)))
- ,@(nreverse folder-button-setter)
- tool-bar-map))
- (setq mh-show-tool-bar-map
- (let ((tool-bar-map (make-sparse-keymap)))
- ,@(nreverse show-button-setter)
- tool-bar-map))
- (setq mh-show-seq-tool-bar-map
- (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map)))
- ,@(nreverse show-seq-button-setter)
- tool-bar-map))
- (setq mh-folder-seq-tool-bar-map
- (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
- ,@(nreverse sequence-button-setter)
- tool-bar-map))))
+ (let* ((load-path (mh-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))))
+ (setq mh-folder-tool-bar-map
+ (let ((tool-bar-map (make-sparse-keymap)))
+ ,@(nreverse folder-button-setter)
+ tool-bar-map))
+ (setq mh-folder-seq-tool-bar-map
+ (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
+ ,@(nreverse sequence-button-setter)
+ tool-bar-map))
+ (setq mh-show-tool-bar-map
+ (let ((tool-bar-map (make-sparse-keymap)))
+ ,@(nreverse show-button-setter)
+ tool-bar-map))
+ (setq mh-show-seq-tool-bar-map
+ (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map)))
+ ,@(nreverse show-seq-button-setter)
+ tool-bar-map)))))
(defun mh-tool-bar-letter-buttons-init ()
(when (mh-buffer-exists-p 'mh-letter-mode)
- (setq mh-letter-tool-bar-map
- (let ((tool-bar-map (make-sparse-keymap)))
- ,@(nreverse letter-button-setter)
- tool-bar-map))))
+ (let* ((load-path (mh-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))))
+ (setq mh-letter-tool-bar-map
+ (let ((tool-bar-map (make-sparse-keymap)))
+ ,@(nreverse letter-button-setter)
+ tool-bar-map)))))
;; Custom setter functions
+ (defun mh-tool-bar-update (mode default-map sequence-map)
+ "Update `tool-bar-map' in all buffers of MODE.
+Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise."
+ (loop for buf in (buffer-list)
+ do (with-current-buffer buf
+ (if (eq mode major-mode)
+ (let ((map (if mh-folder-view-stack
+ sequence-map
+ default-map)))
+ ;; Yes, make-local-variable is necessary since we
+ ;; get here during initialization when loading
+ ;; mh-e.el, after the +inbox buffer has been
+ ;; created, but before mh-folder-mode has run and
+ ;; created the local map.
+ (set (make-local-variable 'tool-bar-map) map))))))
(defun mh-tool-bar-folder-buttons-set (symbol value)
"Construct tool bar for `mh-folder-mode' and `mh-show-mode'."
(set-default symbol value)
- (mh-tool-bar-folder-buttons-init))
+ (mh-tool-bar-folder-buttons-init)
+ (mh-tool-bar-update 'mh-folder-mode mh-folder-tool-bar-map
+ mh-folder-seq-tool-bar-map)
+ (mh-tool-bar-update 'mh-show-mode mh-show-tool-bar-map
+ mh-show-seq-tool-bar-map))
(defun mh-tool-bar-letter-buttons-set (symbol value)
"Construct tool bar for `mh-letter-mode'."
(set-default symbol value)
- (mh-tool-bar-letter-buttons-init)))
+ (mh-tool-bar-letter-buttons-init)
+ (mh-tool-bar-update 'mh-letter-mode mh-letter-tool-bar-map
+ mh-letter-tool-bar-map)))
;; XEmacs specific code
(mh-do-in-xemacs
(defvar mh-tool-bar-folder-vector-map
- ',(loop for button in folder-buttons
- for vector in folder-vectors
- collect (cons button vector)))
+ (list ,@(loop for button in folder-buttons
+ for vector in folder-vectors
+ collect `(cons ',button ,vector))))
(defvar mh-tool-bar-show-vector-map
- ',(loop for button in show-buttons
- for vector in show-vectors
- collect (cons button vector)))
+ (list ,@(loop for button in show-buttons
+ for vector in show-vectors
+ collect `(cons ',button ,vector))))
(defvar mh-tool-bar-letter-vector-map
- ',(loop for button in letter-buttons
- for vector in letter-vectors
- collect (cons button vector)))
- (defvar mh-tool-bar-folder-buttons nil)
- (defvar mh-tool-bar-show-buttons nil)
- (defvar mh-tool-bar-letter-buttons nil)
+ (list ,@(loop for button in letter-buttons
+ for vector in letter-vectors
+ collect `(cons ',button ,vector))))
+ (defvar mh-tool-bar-folder-buttons)
+ (defvar mh-tool-bar-show-buttons)
+ (defvar mh-tool-bar-letter-buttons)
;; Custom setter functions
(defun mh-tool-bar-letter-buttons-set (symbol value)
(set-default symbol value)
(when mh-xemacs-has-tool-bar-flag
(setq mh-tool-bar-letter-buttons
(loop for b in value
- collect (cdr (assoc b mh-tool-bar-letter-vector-map))))))
+ collect (cdr
+ (assoc b mh-tool-bar-letter-vector-map))))))
(defun mh-tool-bar-folder-buttons-set (symbol value)
(set-default symbol value)
(when mh-xemacs-has-tool-bar-flag
collect (cdr (assoc b mh-tool-bar-show-vector-map))))))
(defun mh-tool-bar-init (mode)
"Install tool bar in MODE."
- (let ((tool-bar (cond ((eq mode :folder) mh-tool-bar-folder-buttons)
- ((eq mode :letter) mh-tool-bar-letter-buttons)
- ((eq mode :show) mh-tool-bar-show-buttons)))
- (height 37)
- (width 40)
- (buffer (current-buffer)))
- (when mh-xemacs-use-tool-bar-flag
+ (when mh-xemacs-use-tool-bar-flag
+ (let ((tool-bar (cond ((eq mode :folder)
+ mh-tool-bar-folder-buttons)
+ ((eq mode :letter)
+ mh-tool-bar-letter-buttons)
+ ((eq mode :show)
+ mh-tool-bar-show-buttons)))
+ (height 37)
+ (width 40)
+ (buffer (current-buffer)))
(cond
((eq mh-xemacs-tool-bar-position 'top)
(set-specifier top-toolbar tool-bar buffer)
for y in letter-docs
collect `(const :tag ,y ,x)))
;;:package-version '(MH-E "7.1")
- ))))
+ ))))
+;; The icon names are duplicated in the Makefile and mh-xemacs.el.
(mh-tool-bar-define
((:folder mh-inc-folder mh-mime-save-parts
mh-previous-undeleted-msg mh-page-msg
;; sentence-end-double-space: nil
;; End:
-;; arch-tag: 28c2436d-bb8d-486a-a8d7-5a4d9cae3513
;;; mh-tool-bar.el ends here