X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmessagexmas.el;h=17463107509a5d1d25d826bc73a21c5c5ba61a02;hp=ccc420abc0b3bc8c3b550c0d71c3a76f14c9132c;hb=37b1b9ea0c7f7482525330d35a752bdd3ba43d68;hpb=0709e728b4f6f45f92649887f92e6c8ff5739033 diff --git a/lisp/messagexmas.el b/lisp/messagexmas.el index ccc420abc..174631075 100644 --- a/lisp/messagexmas.el +++ b/lisp/messagexmas.el @@ -1,7 +1,6 @@ ;;; messagexmas.el --- XEmacs extensions to message -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1996-2015 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: mail, news @@ -10,7 +9,7 @@ ;; 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) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -19,9 +18,7 @@ ;; 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 . ;;; Commentary: @@ -38,13 +35,20 @@ If this variable is nil, Message will try to locate the directory automatically.") -(defvar message-use-toolbar (if (featurep 'toolbar) - 'default-toolbar - nil) - "*If nil, do not use a toolbar. -If it is non-nil, it must be a toolbar. The five valid values are -`default-toolbar', `top-toolbar', `bottom-toolbar', -`right-toolbar', and `left-toolbar'.") +(defvar message-use-toolbar (if (featurep 'toolbar) 'default) + "*Position to display the toolbar. Nil means do not use a toolbar. +If it is non-nil, it should be one of the symbols `default', `top', +`bottom', `right', and `left'. `default' means to use the default +toolbar, the rest mean to display the toolbar on the place which those +names show.") + +(defvar message-toolbar-thickness + (if (featurep 'toolbar) + (cons (specifier-instance default-toolbar-height) + (specifier-instance default-toolbar-width))) + "*Cons of the height and the width specifying the thickness of a toolbar. +The height is used for the toolbar displayed on the top or the bottom, +the width is used for the toolbar displayed on the right or the left.") (defvar message-toolbar '([message-spell ispell-message t "Spell"] @@ -60,7 +64,8 @@ If it is non-nil, it must be a toolbar. The five valid values are (nnheader-find-etc-directory package)))) (defun message-xmas-setup-toolbar (bar &optional force package) - (let ((dir (message-xmas-find-glyph-directory package)) + (let ((dir (or (message-xmas-find-glyph-directory package) + (message-xmas-find-glyph-directory "gnus"))) (xpm (if (featurep 'xpm) "xpm" "xbm")) icon up down disabled name) (unless package @@ -84,13 +89,51 @@ If it is non-nil, it must be a toolbar. The five valid values are dir)) (defun message-setup-toolbar () - (and message-use-toolbar - (message-xmas-setup-toolbar message-toolbar) - (set-specifier (symbol-value message-use-toolbar) - (cons (current-buffer) message-toolbar)))) + (when (featurep 'toolbar) + (if (and message-use-toolbar + (message-xmas-setup-toolbar message-toolbar)) + (let ((bar (or (intern-soft (format "%s-toolbar" message-use-toolbar)) + 'default-toolbar)) + (height (car message-toolbar-thickness)) + (width (cdr message-toolbar-thickness)) + (cur (current-buffer)) + bars) + (set-specifier (symbol-value bar) message-toolbar cur) + (set-specifier default-toolbar-height height cur) + (set-specifier default-toolbar-width width cur) + (set-specifier top-toolbar-height height cur) + (set-specifier bottom-toolbar-height height cur) + (set-specifier right-toolbar-width width cur) + (set-specifier left-toolbar-width width cur) + (if (eq bar 'default-toolbar) + (progn + (remove-specifier default-toolbar-visible-p cur) + (remove-specifier top-toolbar cur) + (remove-specifier top-toolbar-visible-p cur) + (remove-specifier bottom-toolbar cur) + (remove-specifier bottom-toolbar-visible-p cur) + (remove-specifier right-toolbar cur) + (remove-specifier right-toolbar-visible-p cur) + (remove-specifier left-toolbar cur) + (remove-specifier left-toolbar-visible-p cur)) + (set-specifier (symbol-value (intern (format "%s-visible-p" bar))) + t cur) + (setq bars (delq bar (list 'default-toolbar + 'bottom-toolbar 'top-toolbar + 'right-toolbar 'left-toolbar))) + (while bars + (set-specifier (symbol-value (intern (format "%s-visible-p" + (pop bars)))) + nil cur)))) + (let ((cur (current-buffer))) + (set-specifier default-toolbar-visible-p nil cur) + (set-specifier top-toolbar-visible-p nil cur) + (set-specifier bottom-toolbar-visible-p nil cur) + (set-specifier right-toolbar-visible-p nil cur) + (set-specifier left-toolbar-visible-p nil cur))))) (defun message-xmas-exchange-point-and-mark () - "Exchange point and mark, but allow for XEmacs' optional argument." + "Exchange point and mark, but allow for XEmacs's optional argument." (exchange-point-and-mark message-xmas-dont-activate-region)) (defun message-xmas-maybe-fontify () @@ -148,5 +191,4 @@ If NOW, use that time instead." (provide 'messagexmas) -;;; arch-tag: 0ece0484-8757-4641-b2d4-17147dd5c5b5 ;;; messagexmas.el ends here