X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=2bb0627c737ece1d9ac4d5806d149e00c06c3a41;hb=e6c591b33a7f48a9585956761eeb88f8f29243a5;hp=471b983d29d7691ee9540c41f61af37b14d1af77;hpb=d198967c494c706a1083d5e8ecef239ded7f6687;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index 471b983..2bb0627 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,5 +1,5 @@ ;;; message.el --- composing mail and news messages -;; Copyright (C) 1996,97 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -165,20 +165,9 @@ Otherwise, most addresses look like `angles', but they look like (const default)) :group 'message-headers) -(defcustom message-references-generator - (if (fboundp 'std11-fill-msg-id-list-string) - (function message-generate-filled-references) - (function message-generate-folded-references)) - "*Function to generate \"References\" field." - :type '(radio (function-item message-generate-filled-references) - (function-item message-generate-folded-references) - (function-item message-generate-unfolded-references) - (function :tag "Other")) - :group 'message-headers) - (defcustom message-syntax-checks nil - ;; Guess this one shouldn't be easy to customize... - "Controls what syntax checks should not be performed on outgoing posts. + ; Guess this one shouldn't be easy to customize... + "*Controls what syntax checks should not be performed on outgoing posts. To disable checking of long signatures, for instance, add `(signature . disabled)' to this list. @@ -194,7 +183,7 @@ shorten-followup-to existing-newsgroups buffer-file-name unchanged." '(From Newsgroups Subject Date Message-ID (optional . Organization) Lines (optional . X-Newsreader)) - "Headers to be generated or prompted for when posting an article. + "*Headers to be generated or prompted for when posting an article. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID. Organization, Lines, In-Reply-To, Expires, and X-Newsreader are optional. If don't you want message to insert some @@ -206,7 +195,7 @@ header, remove it from this list." (defcustom message-required-mail-headers '(From Subject Date (optional . In-Reply-To) Message-ID Lines (optional . X-Mailer)) - "Headers to be generated or prompted for when mailing a message. + "*Headers to be generated or prompted for when mailing a message. RFC822 required that From, Date, To, Subject and Message-ID be included. Organization, Lines and X-Mailer are optional." :group 'message-mail @@ -231,7 +220,7 @@ included. Organization, Lines and X-Mailer are optional." :group 'message-headers :type 'regexp) -(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|X-Trace:\\|X-Complaints-To:\\|Return-Path:\\|^Supersedes:" +(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:" "*Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion." @@ -245,7 +234,9 @@ any confusion." :group 'message-various) (defcustom message-elide-elipsis "\n[...]\n\n" - "*The string which is inserted for elided text.") + "*The string which is inserted for elided text." + :type 'string + :group 'message-various) (defcustom message-interactive nil "Non-nil means when sending a message wait for and display errors. @@ -424,7 +415,7 @@ might set this variable to '(\"-f\" \"you@some.where\")." ((boundp 'gnus-select-method) gnus-select-method) (t '(nnspool ""))) - "Method used to post news." + "*Method used to post news." :group 'message-news :group 'message-sending ;; This should be the `gnus-select-method' widget, but that might @@ -609,7 +600,7 @@ articles." ;; 33 and 126, except colon)", i. e., any chars except ctl chars, ;; space, or colon. '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) - "Set this non-nil if the system's mailer runs the header and body together. + "*Set this non-nil if the system's mailer runs the header and body together. \(This problem exists on Sunos 4 when sendmail is run in remote mode.) The value should be an expression to test whether the problem will actually occur." @@ -926,7 +917,7 @@ The cdr of ech entry is a function for applying the face to a region.") (Lines) (Expires) (Message-ID) - (References . message-fill-header) + (References . message-fill-references) (X-Mailer) (X-Newsreader)) "Alist used for formatting headers.") @@ -1339,10 +1330,10 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (mail-abbrevs-setup) (funcall (intern "mail-aliases-setup")))) (message-set-auto-save-file-name) - (run-hooks 'text-mode-hook 'message-mode-hook) (unless (string-match "XEmacs" emacs-version) (set (make-local-variable 'font-lock-defaults) - '(message-font-lock-keywords t)))) + '(message-font-lock-keywords t))) + (run-hooks 'text-mode-hook 'message-mode-hook)) @@ -1476,7 +1467,8 @@ With the prefix argument FORCE, insert the header anyway." (interactive) (let ((point (point))) (message-goto-signature) - (forward-line -2) + (unless (eobp) + (forward-line -2)) (kill-region point (point)) (unless (bolp) (insert "\n")))) @@ -1535,8 +1527,9 @@ With the prefix argument FORCE, insert the header anyway." (or (bolp) (insert "\n"))))) (defun message-elide-region (b e) - "Elide the text between point and mark. An ellipsis (from -message-elide-elipsis) will be inserted where the text was killed." + "Elide the text between point and mark. +An ellipsis (from `message-elide-elipsis') will be inserted where the +text was killed." (interactive "r") (kill-region b e) (unless (bolp) @@ -1832,6 +1825,7 @@ The text will also be indented the normal way." (defun message-dont-send () "Don't send the message you have been editing." (interactive) + (set-buffer-modified-p t) (save-buffer) (let ((actions message-postpone-actions)) (message-bury (current-buffer)) @@ -2452,8 +2446,12 @@ to find out how to use this." (let* ((case-fold-search t) (message-id (message-fetch-field "message-id" t))) (or (not message-id) + ;; Is there an @ in the ID? (and (string-match "@" message-id) - (string-match "@[^\\.]*\\." message-id)) + ;; Is there a dot in the ID? + (string-match "@[^.]*\\." message-id) + ;; Does the ID end with a dot? + (not (string-match "\\.>" message-id))) (y-or-n-p (format "The Message-ID looks strange: \"%s\". Really post? " message-id))))) @@ -2639,8 +2637,7 @@ to find out how to use this." (while (setq file (message-fetch-field "fcc")) (push file list) (message-remove-header "fcc" nil t))) - (run-hooks 'message-header-hook) - (run-hooks 'message-before-do-fcc-hook) + (run-hooks 'message-header-hook 'message-before-do-fcc-hook) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (replace-match "" t t) @@ -2956,44 +2953,6 @@ give as trustworthy answer as possible." (or mail-host-address (message-make-fqdn))) -(defun message-generate-filled-references (references message-id) - "Return filled References field from REFERENCES and MESSAGE-ID." - (std11-fill-msg-id-list-string (concat references message-id))) - -(defun message-generate-folded-references (references message-id) - "Return folded References field from REFERENCES and MESSAGE-ID." - (if references - (let (quote) - (setq references - (mapconcat (function - (lambda (char) - (cond ((eq char ?\\) - (setq quote t) - "\\") - ((memq char '(?\ ?\t)) - (prog1 - (if quote - (char-to-string char) - (concat "\n" (char-to-string char))) - (setq quote nil))) - (t - (setq quote nil) - (char-to-string char) - )))) - references "")) - (if message-id - (concat references "\n " message-id) - references)) - message-id)) - -(defun message-generate-unfolded-references (references message-id) - "Return folded References field from REFERENCES and MESSAGE-ID." - (if references - (if message-id - (concat references " " message-id) - references) - message-id)) - (defun message-generate-headers (headers) "Prepare article HEADERS. Headers already prepared in the buffer are not modified." @@ -3171,6 +3130,16 @@ Headers already prepared in the buffer are not modified." (widen) (forward-line 1))) +(defun message-fill-references (header value) + (let ((begin (point)) + (fill-column 990) + (fill-prefix "\t")) + (insert (capitalize (symbol-name header)) + ": " + (std11-fill-msg-id-list-string + (if (consp value) (car value) value)) + "\n"))) + (defun message-fill-header (header value) (let ((begin (point)) (fill-column 990) @@ -3475,9 +3444,9 @@ Headers already prepared in the buffer are not modified." `((Subject . ,subject) ,@follow-to ,@(if (or references message-id) - `((References . ,(funcall message-references-generator - references message-id)))) - ) + `((References . ,(concat (or references "") (and references " ") + (or message-id "")))) + nil)) cur))) ;;;###autoload @@ -3583,8 +3552,8 @@ responses here are directed to other newsgroups.")) `((Newsgroups . ,newsgroups)))) ,@(and distribution (list (cons 'Distribution distribution))) ,@(if (or references message-id) - `((References . ,(funcall message-references-generator - references message-id)))) + `((References . ,(concat (or references "") (and references " ") + (or message-id ""))))) ,@(when (and mct (not (equal (downcase mct) "never"))) (list (cons 'Cc (if (equal (downcase mct) "always")