From: yamaoka Date: Fri, 20 Jan 2006 21:55:13 +0000 (+0000) Subject: Synch to No Gnus 200601202131. X-Git-Tag: t-gnus-6_17_4-quimby-~145 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=dccf1134186cb74f033257c5ea025e59eb4fd65c;p=elisp%2Fgnus.git- Synch to No Gnus 200601202131. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0ae7460..269d8a8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,23 @@ +2006-01-20 Reiner Steib + + * gmm-utils.el: New file. + (gmm-verbose, gmm-message, gmm-error): From gnus-utils.el. + (gmm-lazy): New widget copied from `nnmail.el'. + (gmm-tool-bar-from-list): New function for creating customizable + tool bars. + (gmm-tool-bar-from-list): Fix typos in doc string. Remove debug + output. + (gmm): Add :prefix to defgroup. + +2006-01-20 Per Abrahamsen + + * gmm-utils.el (gmm-widget-p): New function. + +2006-01-20 Reiner Steib + + * mml.el (mml-attach-file): Describe `description' in doc string. + (mml-menu): Add Emacs MIME manual and PGG manual. + 2005-12-12 Richard M. Stallman * mm-url.el (mm-url-load-url): Require url-parse and url-vars. diff --git a/lisp/gmm-utils.el b/lisp/gmm-utils.el new file mode 100644 index 0000000..efe8fa0 --- /dev/null +++ b/lisp/gmm-utils.el @@ -0,0 +1,195 @@ +;;; gmm-utils.el --- Utility functions for Gnus, Message and MML + +;; Copyright (C) 2006 Free Software Foundation, Inc. + +;; Author: Reiner Steib +;; 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: + +(defgroup gmm nil + "Utility functions for Gnus, Message and MML" + :prefix "gmm-" + :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) + +;;;###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'." + (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. + +;;;###autoload +(define-widget 'gmm-tool-bar-item (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy) + "Tool bar list item." + :tag "Tool bar item" + :type '(list (function :tag "Menu 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"))) + +(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] + 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. + +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 'ignore) + ;; FIXME: How to get no tool tip at all? + (if (fboundp 'tool-bar-local-item) + (apply 'tool-bar-local-item icon nil nil + tool-bar-map 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 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)) + +(provide 'gmm-utils) + +;;; gmm-utils.el ends here diff --git a/lisp/mml.el b/lisp/mml.el index 93f5dfb..13df698 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -38,6 +38,7 @@ (autoload 'gnus-make-local-hook "gnus-util") (autoload 'message-fetch-field "message") (autoload 'message-mark-active-p "message") + (autoload 'message-info "message") (autoload 'fill-flowed-encode "flow-fill") (autoload 'message-posting-charset "message")) @@ -961,7 +962,14 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ,@(if (featurep 'xemacs) nil '(:help "Quote MML tags in region"))] ["Validate MML" mml-validate t] - ["Preview" mml-preview t])) + ["Preview" mml-preview t] + "----" + ["Emacs MIME manual" (lambda () (interactive) (message-info 4)) + ,@(if (featurep 'xemacs) '(t) + '(:help "Display the Emacs MIME manual"))] + ["PGG manual" (lambda () (interactive) (message-info 16)) + ,@(if (featurep 'xemacs) '(t) + '(:help "Display the PGG manual"))])) (defvar mml-mode nil "Minor mode for editing MML.") @@ -1114,9 +1122,12 @@ to specify options." The file is not inserted or encoded until you send the message with `\\[message-send-and-exit]' or `\\[message-send]'. -FILE is the name of the file to attach. TYPE is its content-type, a -string of the form \"type/subtype\". DESCRIPTION is a one-line -description of the attachment." +FILE is the name of the file to attach. TYPE is its +content-type, a string of the form \"type/subtype\". DESCRIPTION +is a one-line description of the attachment. The DISPOSITION +specifies how the attachment is intended to be displayed. It can +be either \"inline\" (displayed automatically within the message +body) or \"attachment\" (separate from the body)." (interactive (let* ((file (mml-minibuffer-read-file "Attach file: ")) (type (mml-minibuffer-read-type file))