-;;; message.el --- composing mail and news messages
+;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*-
;; Copyright (C) 1996, 1997, 1998, 1999, 2000
;; Free Software Foundation, Inc.
(eval-when-compile
(require 'cl)
(defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
-
(require 'mailheader)
(require 'nnheader)
;; This is apparently necessary even though things are autoloaded:
:group 'message-buffers
:type 'boolean)
-(defvar gnus-local-organization)
+(eval-when-compile
+ (defvar gnus-local-organization))
(defcustom message-user-organization
(or (and (boundp 'gnus-local-organization)
(stringp gnus-local-organization)
(defcustom message-forward-as-mime t
"*If non-nil, forward messages as an inline/rfc822 MIME section. Otherwise, directly inline the old message in the forwarded message."
+ :version "21.1"
:group 'message-forwarding
:type 'boolean)
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
"*All headers that match this regexp will be deleted when forwarding a message."
+ :version "21.1"
:group 'message-forwarding
:type '(choice (const :tag "None" nil)
regexp))
Folding `References' makes ancient versions of INN create incorrect
NOV lines.")
-(defvar gnus-post-method)
-(defvar gnus-select-method)
+(eval-when-compile
+ (defvar gnus-post-method)
+ (defvar gnus-select-method))
(defcustom message-post-method
(cond ((and (boundp 'gnus-post-method)
(listp gnus-post-method)
(define-widget 'message-header-lines 'text
"All header lines must be LFD terminated."
- :format "%t:%n%v"
+ :format "%{%t%}:%n%v"
:valid-regexp "^\\'"
:error "All header lines must be newline terminated")
PREDICATE returns non-nil. FUNCTION is called with one parameter --
the prefix.")
-(defvar message-mail-alias-type 'abbrev
+(defcustom message-mail-alias-type 'abbrev
"*What alias expansion type to use in Message buffers.
The default is `abbrev', which uses mailabbrev. nil switches
-mail aliases off.")
+mail aliases off."
+ :group 'message
+ :link '(custom-manual "(message)Mail Aliases")
+ :type '(choice (const :tag "Use Mailabbrev" abbrev)
+ (const :tag "No expansion" nil)))
(defcustom message-auto-save-directory
- (nnheader-concat message-directory "drafts/")
+ (file-name-as-directory (nnheader-concat message-directory "drafts"))
"*Directory where Message auto-saves buffers if Gnus isn't running.
If nil, Message won't auto-save."
:group 'message-buffers
(defcustom message-buffer-naming-style 'unique
"*The way new message buffers are named.
Valid valued are `unique' and `unsent'."
+ :version "21.1"
:group 'message-buffers
:type '(choice (const :tag "unique" unique)
(const :tag "unsent" unsent)))
(and (not (mm-multibyte-p)) 'iso-8859-1)
"Default charset used in non-MULE Emacsen.
If nil, you might be asked to input the charset."
+ :version "21.1"
:group 'message
:type 'symbol)
(and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
"*A regexp specifying names to prune when doing wide replies.
A value of nil means exclude your own name only."
+ :version "21.1"
:group 'message
:type '(choice (const :tag "Yourself" nil)
regexp))
+(defvar message-shoot-gnksa-feet nil
+ "*A list of GNKSA feet you are allowed to shoot.
+Gnus gives you all the opportunity you could possibly want for
+shooting yourself in the foot. Also, Gnus allows you to shoot the
+feet of Good Net-Keeping Seal of Approval. The following are foot
+candidates:
+`empty-article' Allow you to post an empty article;
+`quoted-text-only' Allow you to post quoted text only;
+`multiple-copies' Allow you to post multiple copies.")
+
+(defsubst message-gnksa-enable-p (feature)
+ (or (not (listp message-shoot-gnksa-feet))
+ (memq feature message-shoot-gnksa-feet)))
+
;;; Internal variables.
;;; Well, not really internal.
(defvar message-mode-abbrev-table text-mode-abbrev-table
"Abbrev table used in Message mode buffers.
Defaults to `text-mode-abbrev-table'.")
-(defgroup message-headers nil
- "Message headers."
- :link '(custom-manual "(message)Variables")
- :group 'message)
(defface message-header-to-face
'((((class color)
"The limitation of messages sent as message/partial.
The lower bound of message size in characters, beyond which the message
should be sent in several parts. If it is nil, the size is unlimited."
+ :version "21.1"
:group 'message-buffers
:type '(choice (const :tag "unlimited" nil)
(integer 1000000)))
(defvar message-posting-charset nil)
;; Byte-compiler warning
-(defvar gnus-active-hashtb)
-(defvar gnus-read-active-file)
+(eval-when-compile
+ (defvar gnus-active-hashtb)
+ (defvar gnus-read-active-file))
;;; Regexp matching the delimiter of messages in UNIX mail format
;;; (UNIX From lines), minus the initial ^. It should be a copy
(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
- '("Message"
+ `("Message"
["Sort Headers" message-sort-headers t]
["Yank Original" message-yank-original t]
["Fill Yanked Message" message-fill-yanked-message t]
["Kill To Signature" message-kill-to-signature t]
["Newline and Reformat" message-newline-and-reformat t]
["Rename buffer" message-rename-buffer t]
- ["Spellcheck" ispell-message t]
- ["Attach file as MIME" mml-attach-file t]
+ ["Spellcheck" ispell-message
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Spellcheck this message"))]
+ ["Attach file as MIME" mml-attach-file
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Attach a file at point"))]
"----"
- ["Send Message" message-send-and-exit t]
- ["Abort Message" message-dont-send t]
- ["Kill Message" message-kill-buffer t]))
+ ["Send Message" message-send-and-exit
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Send this message"))]
+ ["Abort Message" message-dont-send
+ ,@(if (featurep 'xemacs) nil
+ '(:help "File this draft message and exit"))]
+ ["Kill Message" message-kill-buffer
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Delete this message without sending"))]))
(easy-menu-define
message-mode-field-menu message-mode-map ""
["Body" message-goto-body t]
["Signature" message-goto-signature t]))
-(defvar facemenu-add-face-function)
-(defvar facemenu-remove-face-function)
+(eval-when-compile
+ (defvar facemenu-add-face-function)
+ (defvar facemenu-remove-face-function)
+ (defvar message-tool-bar-map))
;;;###autoload
(defun message-mode ()
"Major mode for editing mail and news to be sent.
Like Text Mode but with these additional commands:
C-c C-s message-send (send the message) C-c C-c message-send-and-exit
-C-c C-d Pospone sending the message C-c C-k Kill the message
+C-c C-d Postpone sending the message C-c C-k Kill the message
C-c C-f move to a header field (and create it if there isn't):
C-c C-f C-t move to To C-c C-f C-s move to Subject
C-c C-f C-c move to Cc C-c C-f C-b move to Bcc
(if (featurep 'xemacs)
(message-setup-toolbar)
(set (make-local-variable 'font-lock-defaults)
- '(message-font-lock-keywords t)))
+ '(message-font-lock-keywords t))
+ (if (boundp 'tool-bar-map)
+ (set (make-local-variable 'tool-bar-map) message-tool-bar-map)))
(easy-menu-add message-mode-menu message-mode-map)
(easy-menu-add message-mode-field-menu message-mode-map)
;; Allow mail alias things.
(insert "\n"))
(funcall message-citation-line-function))))
-(defvar mail-citation-hook) ;Compiler directive
+(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive
(defun message-cite-original ()
"Cite function in the standard Message manner."
(if (and (boundp 'mail-citation-hook)
(when (funcall (cadr elem))
(when (and (or (not (memq (car elem)
message-sent-message-via))
- (y-or-n-p
- (format
- "Already sent message via %s; resend? "
- (car elem))))
+ (if (or (message-gnksa-enable-p 'multiple-copies)
+ (not (eq (car elem) 'news)))
+ (y-or-n-p
+ (format
+ "Already sent message via %s; resend? "
+ (car elem)))
+ (error "Denied posting -- multiple copies.")))
(setq success (funcall (caddr elem) arg)))
(setq sent t))))
(unless (or sent (not success))
(re-search-backward message-signature-separator nil t)
(beginning-of-line)
(or (re-search-backward "[^ \n\t]" b t)
- (y-or-n-p "Empty article. Really post? "))))
+ (if (message-gnksa-enable-p 'empty-article)
+ (y-or-n-p "Empty article. Really post? ")
+ (message "Denied posting -- Empty article.")
+ nil))))
;; Check for control characters.
(message-check 'control-chars
(if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t)
(or
(not message-checksum)
(not (eq (message-checksum) message-checksum))
- (y-or-n-p
- "It looks like no new text has been added. Really post? ")))
+ (if (message-gnksa-enable-p 'quoted-text-only)
+ (y-or-n-p
+ "It looks like no new text has been added. Really post? ")
+ (message "Denied posting -- no new text has been added.")
+ nil)))
;; Check the length of the signature.
(message-check 'signature
(goto-char (point-max))
(message-check 'quoting-style
(goto-char (point-max))
(let ((no-problem t))
- (when (search-backward-regexp "^>[^\n]*\n>" nil t)
- (setq no-problem nil)
- (while (not (eobp))
- (when (and (not (eolp)) (looking-at "[^> \t]"))
- (setq no-problem t))
- (forward-line)))
+ (when (search-backward-regexp "^>[^\n]*\n" nil t)
+ (setq no-problem (search-forward-regexp "^[ \t]*[^>\n]" nil t)))
(if no-problem
t
- (y-or-n-p "Your text should follow quoted text. Really post? "))))))
+ (if (message-gnksa-enable-p 'quoted-text-only)
+ (y-or-n-p "Your text should follow quoted text. Really post? ")
+ ;; Ensure that
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (if (search-forward-regexp "^[ \t]*[^>\n]" nil t)
+ (y-or-n-p "Your text should follow quoted text. Really post? ")
+ (message "Denied posting -- only quoted text.")
+ nil)))))))
(defun message-checksum ()
"Return a \"checksum\" for the current buffer."
(mail-header-references message-reply-headers)
(mail-header-subject message-reply-headers)
psubject
- (mail-header-subject message-reply-headers)
(not (string=
(message-strip-subject-re
(mail-header-subject message-reply-headers))
(defun message-set-auto-save-file-name ()
"Associate the message buffer with a file in the drafts directory."
(when message-auto-save-directory
+ (unless (file-directory-p
+ (directory-file-name message-auto-save-directory))
+ (gnus-make-directory message-auto-save-directory))
(if (gnus-alive-p)
(setq message-draft-article
(nndraft-request-associate-buffer "drafts"))
(push ccs follow-to)))))
follow-to))
+
;;;###autoload
(defun message-reply (&optional to-address wide)
"Start editing a reply to the article in the current buffer."
(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
;; Support for toolbar
-(when (featurep 'xemacs)
- (require 'messagexmas))
+(eval-when-compile
+ (defvar tool-bar-map)
+ (defvar tool-bar-mode))
+(if (featurep 'xemacs)
+ (require 'messagexmas)
+ (when (and (>= (string-to-int emacs-version) 21)
+ ;; I hate warnings --zsh.
+ (fboundp 'tool-bar-add-item-from-menu)
+ tool-bar-mode)
+ (defvar message-tool-bar-map
+ (let ((tool-bar-map (copy-keymap tool-bar-map)))
+ ;; 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))
+
+ (tool-bar-add-item-from-menu
+ 'message-send-and-exit "mail_send" message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'message-kill-buffer "close" message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'message-dont-send "cancel" message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'mml-attach-file "attach" message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'ispell-message "spell" message-mode-map)
+ tool-bar-map))))
;;; Group name completion.
(message-expand-group)
(tab-to-tab-stop)))
-(defvar gnus-active-hashtb)
(defun message-expand-group ()
"Expand the group name under point."
(let* ((b (save-excursion
projects / gnus / blobdiff