X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=5ce99077a22cdf79e910ebbfddf2bded4d3aad88;hb=a48c00c889d397f0edeb0a3ef1d29c1bb40f9fdb;hp=5884c8e908e4f31fea62bfd843cdde885c4165e9;hpb=53c2e8db713ae319b1706a06c514e66c4f0b58e0;p=gnus diff --git a/lisp/message.el b/lisp/message.el index 5884c8e90..5ce99077a 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1354,7 +1354,9 @@ text and it replaces `self-insert-command' with the other command, e.g. :type '(repeat function)) (defcustom message-auto-save-directory - (file-name-as-directory (expand-file-name "drafts" message-directory)) + (if (file-writable-p message-directory) + (file-name-as-directory (expand-file-name "drafts" message-directory)) + "~/") "*Directory where Message auto-saves buffers if Gnus isn't running. If nil, Message won't auto-save." :group 'message-buffers @@ -1395,7 +1397,8 @@ candidates: `quoted-text-only' Allow you to post quoted text only; `multiple-copies' Allow you to post multiple copies; `cancel-messages' Allow you to cancel or supersede messages from - your other email addresses.") + your other email addresses; +`canlock-verify' Allow you to cancel messages without verifying canlock.") (defsubst message-gnksa-enable-p (feature) (or (not (listp message-shoot-gnksa-feet)) @@ -2544,7 +2547,7 @@ Return the number of headers removed." (point-max))) (goto-char (point-min))) -;; FIXME: clarify diffference: message-narrow-to-head, +;; FIXME: clarify difference: message-narrow-to-head, ;; message-narrow-to-headers-or-head, message-narrow-to-headers (defun message-narrow-to-head () "Narrow the buffer to the head of the message. @@ -3720,7 +3723,7 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line." (message-delete-line)) ;; Delete blank lines at the end of the buffer. (goto-char (point-max)) - (unless (eolp) + (unless (eq (preceding-char) ?\n) (insert "\n")) (while (and (zerop (forward-line -1)) (looking-at "$")) @@ -4063,7 +4066,9 @@ The text will also be indented the normal way." ;;; (defun message-send-and-exit (&optional arg) - "Send message like `message-send', then, if no errors, exit from mail buffer." + "Send message like `message-send', then, if no errors, exit from mail buffer. +The usage of ARG is defined by the instance that called Message. +It should typically alter the sending method in some way or other." (interactive "P") (let ((buf (current-buffer)) (actions message-exit-actions)) @@ -4295,8 +4300,10 @@ conformance." "Invisible text found and made visible; continue sending? ") (error "Invisible text found and made visible"))))) (message-check 'illegible-text - (let (char found choice) + (let (char found choice nul-chars) (message-goto-body) + (setq nul-chars (save-excursion + (search-forward "\000" nil t))) (while (progn (skip-chars-forward mm-7bit-chars) (when (get-text-property (point) 'no-illegible-text) @@ -4322,7 +4329,9 @@ conformance." (when found (setq choice (gnus-multiple-choice - "Non-printable characters found. Continue sending?" + (if nul-chars + "NUL characters found, which may cause problems. Continue sending?" + "Non-printable characters found. Continue sending?") `((?d "Remove non-printable characters and send") (?r ,(format "Replace non-printable characters with \"%s\" and send" @@ -4827,7 +4836,9 @@ Do not use this for anything important, it is cryptographically weak." (require 'sha1) (let (sha1-maximum-internal-length) (sha1 (concat (message-unique-id) - (format "%x%x%x" (random) (random t) (random)) + (format "%x%x%x" (random) + (progn (random t) (random)) + (random)) (prin1-to-string (recent-keys)) (prin1-to-string (garbage-collect)))))) @@ -5530,10 +5541,12 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." ;; You might for example insert a "." somewhere (not next to another dot ;; or string boundary), or modify the "fsf" string. (defun message-unique-id () + (random t) ;; Don't use microseconds from (current-time), they may be unsupported. ;; Instead we use this randomly inited counter. (setq message-unique-id-char - (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20))))) + (% (1+ (or message-unique-id-char + (logand (random most-positive-fixnum) (1- (lsh 1 20))))) ;; (current-time) returns 16-bit ints, ;; and 2^16*25 just fits into 4 digits i base 36. (* 25 25))) @@ -6362,7 +6375,7 @@ between beginning of field and beginning of line." (progn (gnus-select-frame-set-input-focus (window-frame window)) (select-window window)) - (funcall (or switch-function 'pop-to-buffer) buffer) + (funcall (or switch-function 'switch-to-buffer) buffer) (set-buffer buffer)) (when (and (buffer-modified-p) (not (prog1 @@ -6370,7 +6383,7 @@ between beginning of field and beginning of line." "Message already being composed; erase? ") (message nil)))) (error "Message being composed"))) - (funcall (or switch-function 'pop-to-buffer) name) + (funcall (or switch-function 'switch-to-buffer) name) (set-buffer name)) (erase-buffer) (message-mode))) @@ -6391,35 +6404,38 @@ between beginning of field and beginning of line." ;; Rename the buffer. (if message-send-rename-function (funcall message-send-rename-function) - ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus. - (when (string-match - "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to " - (buffer-name)) - (let ((name (match-string 2 (buffer-name))) - to group) - (if (not (or (null name) - (string-equal name "mail") - (string-equal name "posting"))) - (setq name (concat "*sent " name "*")) - (message-narrow-to-headers) - (setq to (message-fetch-field "to")) - (setq group (message-fetch-field "newsgroups")) - (widen) - (setq name - (cond - (to (concat "*sent mail to " - (or (car (mail-extract-address-components to)) - to) "*")) - ((and group (not (string= group ""))) - (concat "*sent posting on " group "*")) - (t "*sent mail*")))) - (unless (string-equal name (buffer-name)) - (rename-buffer name t))))) + (message-default-send-rename-function)) ;; Push the current buffer onto the list. (when message-max-buffers (setq message-buffer-list (nconc message-buffer-list (list (current-buffer)))))) +(defun message-default-send-rename-function () + ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus. + (when (string-match + "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to " + (buffer-name)) + (let ((name (match-string 2 (buffer-name))) + to group) + (if (not (or (null name) + (string-equal name "mail") + (string-equal name "posting"))) + (setq name (concat "*sent " name "*")) + (message-narrow-to-headers) + (setq to (message-fetch-field "to")) + (setq group (message-fetch-field "newsgroups")) + (widen) + (setq name + (cond + (to (concat "*sent mail to " + (or (car (mail-extract-address-components to)) + to) "*")) + ((and group (not (string= group ""))) + (concat "*sent posting on " group "*")) + (t "*sent mail*")))) + (unless (string-equal name (buffer-name)) + (rename-buffer name t))))) + (defun message-mail-user-agent () (let ((mua (cond ((not message-mail-user-agent) nil) @@ -6563,7 +6579,9 @@ are not included." (message-position-point) ;; Allow correct handling of `message-checksum' in `message-yank-original': (set-buffer-modified-p nil) - (undo-boundary)) + (undo-boundary) + ;; rmail-start-mail expects message-mail to return t (Bug#9392) + t) (defun message-set-auto-save-file-name () "Associate the message buffer with a file in the drafts directory." @@ -6922,20 +6940,19 @@ Useful functions to put in this list include: (unless follow-to (setq follow-to (message-get-reply-headers wide to-address)))) - (unless (message-mail-user-agent) - (message-pop-to-buffer - (message-buffer-name - (if wide "wide reply" "reply") from - (if wide to-address nil)) - switch-function)) - - (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")) - - (message-setup - `((Subject . ,subject) - ,@follow-to) - cur))) + (let ((headers + `((Subject . ,subject) + ,@follow-to))) + (unless (message-mail-user-agent) + (message-pop-to-buffer + (message-buffer-name + (if wide "wide reply" "reply") from + (if wide to-address nil)) + switch-function)) + (setq message-reply-headers + (vector 0 (cdr (assq 'Subject headers)) + from date message-id references 0 0 "")) + (message-setup headers cur)))) ;;;###autoload (defun message-wide-reply (&optional to-address) @@ -7076,7 +7093,8 @@ regexp to match all of yours addresses." (save-excursion (save-restriction (message-narrow-to-head-1) - (if (message-fetch-field "Cancel-Lock") + (if (and (message-fetch-field "Cancel-Lock") + (message-gnksa-enable-p 'canlock-verify)) (if (null (canlock-verify)) t (error "Failed to verify Cancel-lock: This article is not yours")) @@ -7193,7 +7211,7 @@ header line with the old Message-ID." (defun message-wash-subject (subject) "Remove junk like \"Re:\", \"(fwd)\", etc. added to subject string SUBJECT. -Previous forwarders, replyers, etc. may add it." +Previous forwarders, repliers, etc. may add it." (with-temp-buffer (insert subject) (goto-char (point-min)) @@ -7457,14 +7475,16 @@ is for the internal use." (with-temp-buffer (insert-buffer-substring cur) (when (setq handles (mm-dissect-buffer t t)) - (if (and (prog1 - (bufferp (car handles)) - (mm-destroy-parts handles)) + (if (and (bufferp (car handles)) (equal (mm-handle-media-type handles) "text/plain")) (progn + (erase-buffer) + (insert-buffer-substring (car handles)) (mm-decode-content-transfer-encoding (mm-handle-encoding handles)) + (mm-destroy-parts handles) (setq handles (mm-uu-dissect))) + (mm-destroy-parts handles) (setq handles nil)))))) (when handles (prog1 @@ -7650,12 +7670,8 @@ you." "Like `message-mail' command, but display mail buffer in another window." (interactive) (unless (message-mail-user-agent) - (let ((pop-up-windows t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "mail" to)))) + (message-pop-to-buffer (message-buffer-name "mail" to) + 'switch-to-buffer-other-window)) (let ((message-this-is-mail t)) (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))) nil nil nil 'switch-to-buffer-other-window))) @@ -7665,12 +7681,8 @@ you." "Like `message-mail' command, but display mail buffer in another frame." (interactive) (unless (message-mail-user-agent) - (let ((pop-up-frames t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "mail" to)))) + (message-pop-to-buffer (message-buffer-name "mail" to) + 'switch-to-buffer-other-frame)) (let ((message-this-is-mail t)) (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))) nil nil nil 'switch-to-buffer-other-frame))) @@ -7679,12 +7691,8 @@ you." (defun message-news-other-window (&optional newsgroups subject) "Start editing a news article to be sent." (interactive) - (let ((pop-up-windows t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))) + (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups) + 'switch-to-buffer-other-window) (let ((message-this-is-news t)) (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) @@ -7693,12 +7701,8 @@ you." (defun message-news-other-frame (&optional newsgroups subject) "Start editing a news article to be sent." (interactive) - (let ((pop-up-frames t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))) + (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups) + 'switch-to-buffer-other-frame) (let ((message-this-is-news t)) (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) @@ -7930,7 +7934,11 @@ those headers." (let ((mail-abbrev-mode-regexp (caar alist))) (not (mail-abbrev-in-expansion-header-p)))) (setq alist (cdr alist))) - (cdar alist))) + (when (cdar alist) + (lexical-let ((fun (cdar alist))) + ;; Even if completion fails, return a non-nil value, so as to avoid + ;; falling back to message-tab-body-function. + (lambda () (funcall fun) 'completion-attempted))))) (eval-and-compile (condition-case nil @@ -8115,10 +8123,10 @@ regexp VARSTR." (defun message-read-from-minibuffer (prompt &optional initial-contents) "Read from the minibuffer while providing abbrev expansion." (if (fboundp 'mail-abbrevs-setup) - (let ((mail-abbrev-mode-regexp "") - (minibuffer-setup-hook 'mail-abbrevs-setup) + (let ((minibuffer-setup-hook 'mail-abbrevs-setup) (minibuffer-local-map message-minibuffer-local-map)) - (read-from-minibuffer prompt initial-contents)) + (flet ((mail-abbrev-in-expansion-header-p nil t)) + (read-from-minibuffer prompt initial-contents))) (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook) (minibuffer-local-map message-minibuffer-local-map)) (read-string prompt initial-contents))))