Mercurial > hg > xemacs-beta
comparison lisp/gnus/messagexmas.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | ac2d302a0011 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; messagexmas.el --- XEmacs extensions to message | |
| 2 ;; Copyright (C) 1996 Free Software Foundation, Inc. | |
| 3 | |
| 4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> | |
| 5 ;; Keywords: mail, news | |
| 6 | |
| 7 ;; This file is part of GNU Emacs. | |
| 8 | |
| 9 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
| 10 ;; it under the terms of the GNU General Public License as published by | |
| 11 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 12 ;; any later version. | |
| 13 | |
| 14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 17 ;; GNU General Public License for more details. | |
| 18 | |
| 19 ;; You should have received a copy of the GNU General Public License | |
| 20 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
| 21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 22 ;; Boston, MA 02111-1307, USA. | |
| 23 | |
| 24 ;;; Commentary: | |
| 25 | |
| 26 ;;; Code: | |
| 27 | |
| 28 (defvar message-xmas-dont-activate-region nil | |
| 29 "If t, don't activate region after yanking.") | |
| 30 | |
| 31 (defvar message-xmas-glyph-directory nil | |
| 32 "*Directory where Message logos and icons are located. | |
| 33 If this variable is nil, Message will try to locate the directory | |
| 34 automatically.") | |
| 35 | |
| 36 (defvar message-use-toolbar (if (featurep 'toolbar) | |
| 37 'default-toolbar | |
| 38 nil) | |
| 39 "*If nil, do not use a toolbar. | |
| 40 If it is non-nil, it must be a toolbar. The five legal values are | |
| 41 `default-toolbar', `top-toolbar', `bottom-toolbar', | |
| 42 `right-toolbar', and `left-toolbar'.") | |
| 43 | |
| 44 (defvar message-toolbar | |
| 45 '([message-spell ispell-message t "Spell"] | |
| 46 [message-help (Info-goto-node "(Message)Top") t "Message help"]) | |
| 47 "The message buffer toolbar.") | |
| 48 | |
| 49 (defun message-xmas-find-glyph-directory (&optional package) | |
| 50 (setq package (or package "message")) | |
| 51 (let ((path load-path) | |
| 52 (dir (symbol-value | |
| 53 (intern-soft (concat package "-xmas-glyph-directory")))) | |
| 54 result) | |
| 55 (if (and (stringp dir) (file-directory-p dir)) | |
| 56 dir | |
| 57 ;; We try to find the dir by looking at the load path, | |
| 58 ;; stripping away the last component and adding "etc/". | |
| 59 (while path | |
| 60 (if (and (car path) | |
| 61 (file-exists-p | |
| 62 (setq dir (concat | |
| 63 (file-name-directory | |
| 64 (directory-file-name (car path))) | |
| 65 "etc/" (or package "message") "/"))) | |
| 66 (file-directory-p dir)) | |
| 67 (setq result dir | |
| 68 path nil) | |
| 69 (setq path (cdr path)))) | |
| 70 result))) | |
| 71 | |
| 72 (defun message-xmas-setup-toolbar (bar &optional force package) | |
| 73 (let ((dir (message-xmas-find-glyph-directory package)) | |
| 74 (xpm (if (featurep 'xpm) "xpm" "xbm")) | |
| 75 icon up down disabled name) | |
| 76 (unless package | |
| 77 (setq message-xmas-glyph-directory dir)) | |
| 78 (when dir | |
| 79 (while bar | |
| 80 (setq icon (aref (car bar) 0) | |
| 81 name (symbol-name icon) | |
| 82 bar (cdr bar)) | |
| 83 (when (or force | |
| 84 (not (boundp icon))) | |
| 85 (setq up (concat dir name "-up." xpm)) | |
| 86 (setq down (concat dir name "-down." xpm)) | |
| 87 (setq disabled (concat dir name "-disabled." xpm)) | |
| 88 (if (not (file-exists-p up)) | |
| 89 (setq bar nil | |
| 90 dir nil) | |
| 91 (set icon (toolbar-make-button-list | |
| 92 up (and (file-exists-p down) down) | |
| 93 (and (file-exists-p disabled) disabled))))))) | |
| 94 dir)) | |
| 95 | |
| 96 (defun message-setup-toolbar () | |
| 97 (and message-use-toolbar | |
| 98 (message-xmas-setup-toolbar message-toolbar) | |
| 99 (set-specifier (symbol-value message-use-toolbar) | |
| 100 (cons (current-buffer) message-toolbar)))) | |
| 101 | |
| 102 (defun message-xmas-exchange-point-and-mark () | |
| 103 "Exchange point and mark, but allow for XEmacs' optional argument." | |
| 104 (exchange-point-and-mark message-xmas-dont-activate-region)) | |
| 105 | |
| 106 (fset 'message-exchange-point-and-mark 'message-xmas-exchange-point-and-mark) | |
| 107 | |
| 108 (provide 'messagexmas) | |
| 109 | |
| 110 ;;; messagexmas.el ends here |