X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=ead854d769367bb7765d508e1b36ccf940bff317;hb=cddb4672a1b8d0b3fb03dd1c5cad4b01f9fab219;hp=8ea8cd3466bdd784a62d8e908bacf7f66c969702;hpb=35954395de6fe886702bd3f5a8ae48c28c6a739c;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index 8ea8cd3..ead854d 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -645,6 +645,7 @@ Predefined functions include `message-cite-original' and `message-cite-original-without-signature'. Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil." :type '(radio (function-item message-cite-original) + (function-item message-cite-original-without-signature) (function-item sc-cite-original) (function :tag "Other")) :group 'message-insertion) @@ -1420,6 +1421,7 @@ Point is left at the beginning of the narrowed-to region." (defun message-sort-headers-1 () "Sort the buffer as headers using `message-rank' text props." (goto-char (point-min)) + (require 'sort) (sort-subr nil 'message-next-header (lambda () @@ -1523,7 +1525,7 @@ Point is left at the beginning of the narrowed-to region." ["Newline and Reformat" message-newline-and-reformat t] ["Rename buffer" message-rename-buffer t] ["Spellcheck" ispell-message t] - ["Attach file as MIME" message-mime-attach-file t] + ["Attach file as MIME" mime-edit-insert-file t] "----" ["Send Message" message-send-and-exit t] ["Abort Message" message-dont-send t] @@ -1576,8 +1578,7 @@ C-c C-q message-fill-yanked-message (fill what was yanked). C-c C-e message-elide-region (elide the text between point and mark). C-c C-v message-delete-not-region (remove the text outside the region). C-c C-z message-kill-to-signature (kill the text up to the signature). -C-c C-r message-caesar-buffer-body (rot13 the message body). -C-c C-a message-mime-attach-file (attach a file as MIME)." +C-c C-r message-caesar-buffer-body (rot13 the message body)." (interactive) (kill-all-local-variables) (set (make-local-variable 'message-reply-buffer) nil) @@ -1650,6 +1651,8 @@ C-c C-a message-mime-attach-file (attach a file as MIME)." (setq adaptive-fill-first-line-regexp (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-first-line-regexp)) + (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation. + (setq indent-tabs-mode nil) (run-hooks 'text-mode-hook 'message-mode-hook)) @@ -1735,7 +1738,8 @@ C-c C-a message-mime-attach-file (attach a file as MIME)." (interactive) (if (looking-at "[ \t]*\n") (expand-abbrev)) (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t)) + (or (search-forward (concat "\n" mail-header-separator "\n") nil t) + (search-forward "\n\n" nil t))) (defun message-goto-eoh () "Move point to the end of the headers." @@ -2067,20 +2071,27 @@ be added to \"References\" field." (interactive "P") (let ((modified (buffer-modified-p)) (buffer (message-eval-parameter message-reply-buffer)) - refs) + start end refs) (when (and buffer message-cite-function) (delete-windows-on buffer t) (insert-buffer buffer) ; mark will be set at the end of article. + (setq start (point) + end (mark t)) ;; Add new IDs to References field. (when (and message-yank-add-new-references (interactive-p)) (save-excursion (save-restriction - (narrow-to-region (point) (mark t)) + (message-narrow-to-headers) + (setq refs (message-list-references + nil + (message-fetch-field "References"))) + (widen) + (narrow-to-region start end) (std11-narrow-to-header) (when (setq refs (message-list-references - '() + refs (or (message-fetch-field "References") (message-fetch-field "In-Reply-To")) (message-fetch-field "Message-ID"))) @@ -2346,22 +2357,24 @@ the user from the mailer." (car elem)))) (setq success (funcall (caddr elem) arg))))) (setq sent t)))) - (when (and success sent) - (message-do-fcc) - ;;(when (fboundp 'mail-hist-put-headers-into-history) - ;; (mail-hist-put-headers-into-history)) - (save-excursion - (run-hooks 'message-sent-hook)) - (message "Sending...done") - ;; Mark the buffer as unmodified and delete autosave. - (set-buffer-modified-p nil) - (delete-auto-save-file-if-necessary t) - (message-disassociate-draft) - ;; Delete other mail buffers and stuff. - (message-do-send-housekeeping) - (message-do-actions message-send-actions) - ;; Return success. - t)))) + (prog1 + (when (and success sent) + (message-do-fcc) + ;;(when (fboundp 'mail-hist-put-headers-into-history) + ;; (mail-hist-put-headers-into-history)) + (save-excursion + (run-hooks 'message-sent-hook)) + (message "Sending...done") + ;; Mark the buffer as unmodified and delete autosave. + (set-buffer-modified-p nil) + (delete-auto-save-file-if-necessary t) + (message-disassociate-draft) + ;; Delete other mail buffers and stuff. + (message-do-send-housekeeping) + (message-do-actions message-send-actions) + ;; Return success. + t) + (kill-buffer message-encoding-buffer))))) (defun message-send-via-mail (arg) "Send the current message via mail." @@ -3011,15 +3024,12 @@ This sub function is for exclusive use of `message-send-news'." ;; Check the length of the signature. (message-check 'signature (goto-char (point-max)) - (if (or (not (re-search-backward message-signature-separator nil t)) - (search-forward message-forward-end-separator nil t)) - t - (if (> (count-lines (point) (point-max)) 5) - (y-or-n-p - (format - "Your .sig is %d lines; it should be max 4. Really post? " - (1- (count-lines (point) (point-max))))) - t))))) + (if (> (count-lines (point) (point-max)) 5) + (y-or-n-p + (format + "Your .sig is %d lines; it should be max 4. Really post? " + (1- (count-lines (point) (point-max))))) + t)))) (defun message-check-mail-syntax () "Check the syntax of the message." @@ -3517,7 +3527,7 @@ Headers already prepared in the buffer are not modified." ;; colon, if there is none. (if (/= (char-after) ? ) (insert " ") (forward-char 1)) ;; Find out whether the header is empty... - (looking-at "[ \t]*$"))) + (looking-at "[ \t]*\n[^ \t]"))) ;; So we find out what value we should insert. (setq value (cond @@ -4424,14 +4434,14 @@ the message." (current-buffer) (message-narrow-to-head) (let ((funcs message-make-forward-subject-function) - (subject (if message-wash-forwarded-subjects - (message-wash-subject - (or (nnheader-decode-subject - (message-fetch-field "Subject")) - "")) - (or (nnheader-decode-subject - (message-fetch-field "Subject")) - "")))) + (subject (message-fetch-field "Subject"))) + (setq subject + (if subject + (if message-wash-forwarded-subjects + (message-wash-subject + (nnheader-decode-subject subject)) + (nnheader-decode-subject subject)) + "(none)")) ;; Make sure funcs is a list. (and funcs (not (listp funcs)) @@ -4799,9 +4809,14 @@ regexp varstr." (defun message-maybe-encode () (when message-mime-mode + ;; Inherit the buffer local variable `mime-edit-pgp-processing'. + (let ((pgp-processing (with-current-buffer message-edit-buffer + mime-edit-pgp-processing))) + (setq mime-edit-pgp-processing pgp-processing)) (run-hooks 'mime-edit-translate-hook) (if (catch 'mime-edit-error (save-excursion + (mime-edit-pgp-enclose-buffer) (mime-edit-translate-body) )) (error "Translation error!") @@ -4850,124 +4865,51 @@ regexp varstr." ;;; MIME functions ;;; -(defun message-mime-query-file (prompt) - (let ((file (read-file-name prompt nil nil t))) - ;; Prevent some common errors. This is inspired by similar code in - ;; VM. - (when (file-directory-p file) - (error "%s is a directory, cannot attach" file)) - (unless (file-exists-p file) - (error "No such file: %s" file)) - (unless (file-readable-p file) - (error "Permission denied: %s" file)) - file)) - -(defun message-mime-query-type (file) - (let* ((default (or (mm-default-file-encoding file) - ;; Perhaps here we should check what the file - ;; looks like, and offer text/plain if it looks - ;; like text/plain. - "application/octet-stream")) - (string (completing-read - (format "Content type (default %s): " default) - (delete-duplicates - (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions) - :test 'equal)))) - (if (not (equal string "")) - string - default))) - -(defun message-mime-query-description () - (let ((description (read-string "One line description: "))) - (when (string-match "\\`[ \t]*\\'" description) - (setq description nil)) - description)) - -(defun message-mime-attach-file (file &optional type description) - "Attach a file to the outgoing MIME message. -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." - (interactive - (let* ((file (message-mime-query-file "Attach file: ")) - (type (message-mime-query-type file)) - (description (message-mime-query-description))) - (list file type description))) - (insert (format - "<#part type=%s name=%s filename=%s%s disposition=attachment><#/part>\n" - type (prin1-to-string (file-name-nondirectory file)) - (prin1-to-string file) - (if description - (format " description=%s" (prin1-to-string description)) - "")))) - -(defun message-mime-attach-external (file &optional type description) - "Attach an external file into the buffer. -FILE is an ange-ftp/efs specification of the part location. -TYPE is the MIME type to use." - (interactive - (let* ((file (message-mime-query-file "Attach external file: ")) - (type (message-mime-query-type file)) - (description (message-mime-query-description))) - (list file type description))) - (insert (format - "<#external type=%s name=%s disposition=attachment><#/external>\n" - type (prin1-to-string file)))) +(defvar message-inhibit-body-encoding t) (defun message-encode-message-body () - (let ((mail-parse-charset message-default-charset) - (case-fold-search t) - lines multipart-p content-type-p) - (message-goto-body) - (save-restriction - (narrow-to-region (point) (point-max)) - (let ((new (mml-generate-mime))) - (when new - (delete-region (point-min) (point-max)) - (insert new) - (goto-char (point-min)) - (if (eq (aref new 0) ?\n) - (delete-char 1) - (search-forward "\n\n") - (setq lines (buffer-substring (point-min) (1- (point)))) - (delete-region (point-min) (point)))))) - (save-restriction - (message-narrow-to-headers-or-head) - (message-remove-header "Mime-Version") - (goto-char (point-max)) - (insert "Mime-Version: 1.0\n") - (when lines - (insert lines)) - (setq multipart-p - (re-search-backward "^Content-Type: multipart/" nil t)) - (goto-char (point-max)) - (setq content-type-p - (re-search-backward "^Content-Type:" nil t))) - (save-restriction - (message-narrow-to-headers-or-head) - (message-remove-first-header "Content-Type") - (message-remove-first-header "Content-Transfer-Encoding")) - (when multipart-p + (unless message-inhibit-body-encoding + (let ((mail-parse-charset (or mail-parse-charset + message-default-charset + message-posting-charset)) + (case-fold-search t) + lines content-type-p) + (message-goto-body) + (save-restriction + (narrow-to-region (point) (point-max)) + (let ((new (mml-generate-mime))) + (when new + (delete-region (point-min) (point-max)) + (insert new) + (goto-char (point-min)) + (if (eq (aref new 0) ?\n) + (delete-char 1) + (search-forward "\n\n") + (setq lines (buffer-substring (point-min) (1- (point)))) + (delete-region (point-min) (point)))))) + (save-restriction + (message-narrow-to-headers-or-head) + (message-remove-header "Mime-Version") + (goto-char (point-max)) + (insert "MIME-Version: 1.0\n") + (when lines + (insert lines)) + (setq content-type-p + (re-search-backward "^Content-Type:" nil t))) (save-restriction (message-narrow-to-headers-or-head) (message-remove-first-header "Content-Type") (message-remove-first-header "Content-Transfer-Encoding")) - (message-goto-body) - (insert "This is a MIME multipart message. If you are reading\n") - (insert "this, you shouldn't.\n")) - ;; We always make sure that the message has a Content-Type header. - ;; This is because some broken MTAs and MUAs get awfully confused - ;; when confronted with a message with a MIME-Version header and - ;; without a Content-Type header. For instance, Solaris' - ;; /usr/bin/mail. - (unless content-type-p - (goto-char (point-min)) - (re-search-forward "^MIME-Version:") - (forward-line 1) - (insert "Content-Type: text/plain; charset=us-ascii\n")))) + ;; We always make sure that the message has a Content-Type header. + ;; This is because some broken MTAs and MUAs get awfully confused + ;; when confronted with a message with a MIME-Version header and + ;; without a Content-Type header. For instance, Solaris' + ;; /usr/bin/mail. + (unless content-type-p + (goto-char (point-min)) + (re-search-forward "^MIME-Version:") + (forward-line 1) + (insert "Content-Type: text/plain; charset=us-ascii\n"))))) (defvar message-save-buffer " *encoding") (defun message-save-drafts ()