;;; message.el --- composing mail and news messages
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
(require 'canlock)
(require 'mailheader)
(require 'nnheader)
+(require 'gmm-utils)
;; This is apparently necessary even though things are autoloaded.
;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
;; require mailabbrev here.
;;; End of functions adopted from `message-utils.el'.
-(defun message-remove-duplicates (list)
- (let (new)
- (while list
- (or (member (car list) new)
- (setq new (cons (car list) new)))
- (setq list (cdr list)))
- (nreverse new)))
-
(defun message-remove-header (header &optional is-regexp first reverse)
"Remove HEADER in the narrowed buffer.
If IS-REGEXP, HEADER is a regular expression.
(message-skip-to-next-address)
(kill-region start (point))))
+
+(defun message-info (&optional arg)
+ "Display the Message manual.
+
+Prefixed with one \\[universal-argument], display the Emacs MIME manual.
+Prefixed with two \\[universal-argument]'s, display the PGG manual."
+ (interactive "p")
+ (cond ((eq arg 16) (Info-goto-node "(pgg)Top"))
+ ((eq arg 4) (Info-goto-node "(emacs-mime)Top"))
+ (t (Info-goto-node "(message)Top"))))
+
\f
;;;
'(:help "Ask, then arrange to send message at that time"))]
["Kill Message" message-kill-buffer
,@(if (featurep 'xemacs) '(t)
- '(:help "Delete this message without sending"))]))
+ '(:help "Delete this message without sending"))]
+ "----"
+ ["Message manual" message-info
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Display the Message manual"))]))
(easy-menu-define
message-mode-field-menu message-mode-map ""
"----"
["Sort Headers" message-sort-headers t]
["Encode non-ASCII domain names" message-idna-to-ascii-rhs t]
+ ;; We hide `message-hidden-headers' by narrowing the buffer.
+ ["Show Hidden Headers" widen t]
["Goto Body" message-goto-body t]
["Goto Signature" message-goto-signature t]))
(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)
(message-goto-body)
(forward-line -1))
+(defun message-in-body-p ()
+ "Return t if point is in the message body."
+ (let ((body (save-excursion (message-goto-body) (point))))
+ (>= (point) body)))
+
(defun message-goto-signature ()
"Move point to the beginning of the message signature.
If there is no signature in the article, go to the end and
"Kill all text up to the signature.
If a numberic argument or prefix arg is given, leave that number
of lines before the signature intact."
- (interactive "p")
+ (interactive "P")
(save-excursion
(save-restriction
(let ((point (point)))
(defun message-insert-citation-line ()
"Insert a simple citation line."
(when message-reply-headers
- (insert (mail-header-from message-reply-headers) " writes:\n\n")))
+ (insert (mail-header-from message-reply-headers) " writes:")
+ (newline)
+ (newline)))
(defun message-position-on-field (header &rest afters)
(let ((case-fold-search t))
(when (let ((char (char-after)))
(or (< (mm-char-int char) 128)
(and (mm-multibyte-p)
- ;; Fixme: Wrong for Emacs 22 and for things
- ;; like undecable utf-8. Should at least
+ ;; FIXME: Wrong for Emacs 23 (unicode) and for
+ ;; things like undecable utf-8. Should at least
;; use find-coding-systems-region.
(memq (char-charset char)
'(eight-bit-control eight-bit-graphic
(* 25 25)))
(let ((tm (current-time)))
(concat
- (if (memq system-type '(ms-dos emx vax-vms))
+ (if (or (memq system-type '(ms-dos emx vax-vms))
+ ;; message-number-base36 doesn't handle bigints.
+ (floatp (user-uid)))
(let ((user (downcase (user-login-name))))
(while (string-match "[^a-z0-9_]" user)
(aset user (match-beginning 0) ?_))
rhs ace address)
(when field
(dolist (rhs
- (message-remove-duplicates
+ (mm-delete-duplicates
(mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
(mapcar 'downcase
(mapcar
;; The element is a symbol. We insert the value
;; of this symbol, if any.
(symbol-value header))
- ((not (message-check-element header))
+ ((not (message-check-element
+ (intern (downcase (symbol-name header)))))
;; We couldn't generate a value for this header,
;; so we just ask the user.
(read-from-minibuffer
;; totally and insert the new value.
(delete-region (point) (point-at-eol))
;; If the header is optional, and the header was
- ;; empty, we con't insert it anyway.
+ ;; empty, we can't insert it anyway.
(unless optionalp
(push header-string message-inserted-headers)
(insert value)
(prefix
(if group
(gnus-group-decoded-name group)
- (or (and from (car (gnus-extract-address-components from)))
+ (or (and from (or
+ (car (gnus-extract-address-components from))
+ (cadr (gnus-extract-address-components from))))
"(nowhere)"))))
(concat "["
(if message-forward-decoded-p
(set-buffer (get-buffer-create " *message resend*"))
(erase-buffer))
(let ((message-this-is-mail t)
+ message-generate-hashcash
message-setup-hook)
(message-setup `((To . ,address))))
;; Insert our usual headers.
;; Send it.
(let ((message-inhibit-body-encoding t)
message-required-mail-headers
+ message-generate-hashcash
rfc2047-encode-encoded-words)
(message-send-mail))
(kill-buffer (current-buffer)))
;; 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 > 21.3
- (if (fboundp 'tool-bar-local-item-from-menu)
- ;; This is for Emacs 21.3
- (tool-bar-local-item-from-menu command icon in-map from-map props)
- (tool-bar-add-item-from-menu command icon from-map props)))
-
-(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)
+;; 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)))
+
+(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 "23.0" ;; No Gnus
+ :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 "23.0" ;; No Gnus
+ :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 "23.0" ;; No Gnus
+ :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 "23.0" ;; No Gnus
+ :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.
(lookup-key global-map "\t")
'indent-relative))))
+(eval-and-compile
+ (condition-case nil
+ (with-temp-buffer
+ (let ((standard-output (current-buffer)))
+ (eval '(display-completion-list nil "")))
+ (defalias 'message-display-completion-list 'display-completion-list))
+ (error ;; Don't use `wrong-number-of-arguments' here because of XEmacs.
+ (defun message-display-completion-list (completions &optional ignore)
+ "Display the list of completions, COMPLETIONS, using `standard-output'."
+ (display-completion-list completions)))))
+
(defun message-expand-group ()
"Expand the group name under point."
(let* ((b (save-excursion
(let ((buffer-read-only nil))
(erase-buffer)
(let ((standard-output (current-buffer)))
- (display-completion-list (sort completions 'string<)))
+ (message-display-completion-list (sort completions 'string<)
+ string))
+ (setq buffer-read-only nil)
(goto-char (point-min))
(delete-region (point) (progn (forward-line 3) (point))))))))))