# HG changeset patch # User ShengHuo ZHU # Date 977343651 0 # Node ID f04f551e94ce3256d6674833426fe2857e4a32ef # Parent 3a35752ca4cbabd5dc62a82c14e7691545097ebd * message.el (message-narrow-to-head-1): New function. (message-narrow-to-head): Use it. (message-reply): Ditto. (message-cancel-news): Ditto. (message-supersede): Ditto. (message-make-forward-subject): Ditto. (message-bounce): Ditto. * gnus-msg.el (gnus-summary-mail-forward): Use original buffer. * message.el (message-forward): Copy buffer in unibyte mode. (message-make-forward-subject): Don't widen. Decode. (message-forward): Don't decode subject. * mml.el (gnus-ems): Require it. * gnus-msg.el (gnus-summary-mail-forward): * message.el (message-forward): Move mime-to-mml here. * nnmbox.el (nnmbox-file-coding-system): Use binary. (nnmbox-active-file-coding-system): Ditto. * gnus-cus.el (gnus-group-parameters): Add posting-style. * mm-uu.el: Require binhex. * qp.el (quoted-printable-encode-region): Upcase QP. diff -r 3a35752ca4cb -r f04f551e94ce lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Wed Dec 20 20:09:59 2000 +0000 +++ b/lisp/gnus/ChangeLog Wed Dec 20 20:20:51 2000 +0000 @@ -1,3 +1,36 @@ +2000-12-20 ShengHuo ZHU + + * message.el (message-narrow-to-head-1): New function. + (message-narrow-to-head): Use it. + (message-reply): Ditto. + (message-cancel-news): Ditto. + (message-supersede): Ditto. + (message-make-forward-subject): Ditto. + (message-bounce): Ditto. + + * gnus-msg.el (gnus-summary-mail-forward): Use original buffer. + + * message.el (message-forward): Copy buffer in unibyte mode. + (message-make-forward-subject): Don't widen. Decode. + (message-forward): Don't decode subject. + + * mml.el (gnus-ems): Require it. + + * gnus-msg.el (gnus-summary-mail-forward): + + * message.el (message-forward): Move mime-to-mml here. + + * nnmbox.el (nnmbox-file-coding-system): Use binary. + (nnmbox-active-file-coding-system): Ditto. + + * gnus-cus.el (gnus-group-parameters): Add posting-style. + + * mm-uu.el: Require binhex. + +2000-12-20 Christoph Conrad + + * qp.el (quoted-printable-encode-region): Upcase QP. + 2000-12-20 ShengHuo ZHU * gnus-util.el (gnus-add-text-properties-when): New function. diff -r 3a35752ca4cb -r f04f551e94ce lisp/gnus/gnus-cus.el --- a/lisp/gnus/gnus-cus.el Wed Dec 20 20:09:59 2000 +0000 +++ b/lisp/gnus/gnus-cus.el Wed Dec 20 20:20:51 2000 +0000 @@ -270,7 +270,23 @@ (symbol :tag "Face" gnus-emphasis-highlight-words)))) "highlight regexps. -See gnus-emphasis-alist.")) +See gnus-emphasis-alist.") + + (posting-style + (choice :tag "Posting style" + :value nil + (repeat (list + (choice :tag "Type" + :value nil + (const signature) + (const signature-file) + (const organization) + (const address) + (const name) + (const body)) + (string :format "%v")))) + "post style. +See gnus-posting-styles.")) "Alist of valid group or topic parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter diff -r 3a35752ca4cb -r f04f551e94ce lisp/gnus/gnus-msg.el --- a/lisp/gnus/gnus-msg.el Wed Dec 20 20:09:59 2000 +0000 +++ b/lisp/gnus/gnus-msg.el Wed Dec 20 20:20:51 2000 +0000 @@ -721,23 +721,8 @@ (gnus-setup-message 'forward (gnus-summary-select-article) (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) - text) - (save-excursion - (set-buffer gnus-original-article-buffer) - (setq text (buffer-string))) - (set-buffer - (gnus-get-buffer-create - (generate-new-buffer-name " *Gnus forward*"))) - (erase-buffer) - (unless message-forward-show-mml - (mm-disable-multibyte)) - (insert text) - (goto-char (point-min)) - (when (looking-at "From ") - (replace-match "X-From-Line: ") ) - (when message-forward-show-mml - (mime-to-mml)) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) + (set-buffer gnus-original-article-buffer) (message-forward post))))) (defun gnus-summary-resend-message (address n) diff -r 3a35752ca4cb -r f04f551e94ce lisp/gnus/message.el --- a/lisp/gnus/message.el Wed Dec 20 20:09:59 2000 +0000 +++ b/lisp/gnus/message.el Wed Dec 20 20:20:51 2000 +0000 @@ -1242,10 +1242,8 @@ (point-max))) (goto-char (point-min))) -(defun message-narrow-to-head () - "Narrow the buffer to the head of the message. -Point is left at the beginning of the narrowed-to region." - (widen) +(defun message-narrow-to-head-1 () + "Like `message-narrow-to-head'. Don't widen." (narrow-to-region (goto-char (point-min)) (if (search-forward "\n\n" nil 1) @@ -1253,6 +1251,12 @@ (point-max))) (goto-char (point-min))) +(defun message-narrow-to-head () + "Narrow the buffer to the head of the message. +Point is left at the beginning of the narrowed-to region." + (widen) + (message-narrow-to-head-1)) + (defun message-narrow-to-headers-or-head () "Narrow the buffer to the head of the message." (widen) @@ -3758,7 +3762,7 @@ (message-this-is-mail t) gnus-warning) (save-restriction - (message-narrow-to-head) + (message-narrow-to-head-1) ;; Allow customizations to have their say. (if (not wide) ;; This is a regular reply. @@ -3932,7 +3936,7 @@ (save-excursion ;; Get header info from original article. (save-restriction - (message-narrow-to-head) + (message-narrow-to-head-1) (setq from (message-fetch-field "from") sender (message-fetch-field "sender") newsgroups (message-fetch-field "newsgroups") @@ -3994,7 +3998,7 @@ (message-pop-to-buffer (message-buffer-name "supersede")) (insert-buffer-substring cur) (mime-to-mml) - (message-narrow-to-head) + (message-narrow-to-head-1) ;; Remove unwanted headers. (when message-ignored-supersedes-headers (message-remove-header message-ignored-supersedes-headers t)) @@ -4082,13 +4086,15 @@ "Return a Subject header suitable for the message in the current buffer." (save-excursion (save-restriction - (current-buffer) - (message-narrow-to-head) + (message-narrow-to-head-1) (let ((funcs message-make-forward-subject-function) - (subject (if message-wash-forwarded-subjects - (message-wash-subject - (or (message-fetch-field "Subject") "")) - (or (message-fetch-field "Subject") "")))) + (subject (message-fetch-field "Subject"))) + (setq subject + (if subject + (mail-decode-encoded-word-string subject) + "")) + (if message-wash-forwarded-subjects + (setq subject (message-wash-subject subject))) ;; Make sure funcs is a list. (and funcs (not (listp funcs)) @@ -4108,10 +4114,7 @@ Optional DIGEST will use digest to forward." (interactive "P") (let* ((cur (current-buffer)) - (subject (if message-forward-show-mml - (message-make-forward-subject) - (mail-decode-encoded-word-string - (message-make-forward-subject)))) + (subject (message-make-forward-subject)) art-beg) (if news (message-news nil subject) @@ -4134,8 +4137,29 @@ (insert-buffer-substring cur) (mml-insert-buffer cur)) (if message-forward-show-mml - (insert-buffer-substring cur) - (mml-insert-buffer cur))) + (let ((target (current-buffer)) tmp) + (with-temp-buffer + (mm-disable-multibyte) ;; Must copy buffer in unibyte mode + (setq tmp (current-buffer)) + (set-buffer cur) + (mm-with-unibyte-current-buffer + (set-buffer tmp) + (insert-buffer-substring cur)) + (set-buffer tmp) + (mm-enable-multibyte) + (mime-to-mml) + (goto-char (point-min)) + (when (looking-at "From ") + (replace-match "X-From-Line: ")) + (set-buffer target) + (insert-buffer-substring tmp) + (set-buffer tmp)) + (goto-char (point-max))) + (mml-insert-buffer cur) + (goto-char (point-min)) + (when (looking-at "From ") + (replace-match "X-From-Line: ")) + (goto-char (point-max)))) (setq e (point)) (if message-forward-as-mime (if digest @@ -4241,7 +4265,7 @@ (mm-enable-multibyte) (mime-to-mml) (save-restriction - (message-narrow-to-head) + (message-narrow-to-head-1) (message-remove-header message-ignored-bounced-headers t) (goto-char (point-max)) (insert mail-header-separator)) diff -r 3a35752ca4cb -r f04f551e94ce lisp/gnus/mm-uu.el --- a/lisp/gnus/mm-uu.el Wed Dec 20 20:09:59 2000 +0000 +++ b/lisp/gnus/mm-uu.el Wed Dec 20 20:20:51 2000 +0000 @@ -32,10 +32,7 @@ (require 'mm-decode) (require 'mailcap) (require 'uudecode) - -(eval-and-compile - (autoload 'binhex-decode-region "binhex") - (autoload 'binhex-decode-region-external "binhex")) +(require 'binhex) (defun mm-uu-copy-to-buffer (from to) "Copy the contents of the current buffer to a fresh buffer. diff -r 3a35752ca4cb -r f04f551e94ce lisp/gnus/mml.el --- a/lisp/gnus/mml.el Wed Dec 20 20:09:59 2000 +0000 +++ b/lisp/gnus/mml.el Wed Dec 20 20:20:51 2000 +0000 @@ -27,6 +27,7 @@ (require 'mm-bodies) (require 'mm-encode) (require 'mm-decode) +(require 'gnus-ems) (eval-when-compile (require 'cl)) (eval-and-compile diff -r 3a35752ca4cb -r f04f551e94ce lisp/gnus/nnmbox.el --- a/lisp/gnus/nnmbox.el Wed Dec 20 20:09:59 2000 +0000 +++ b/lisp/gnus/nnmbox.el Wed Dec 20 20:20:51 2000 +0000 @@ -61,9 +61,9 @@ (defvoo nnmbox-group-alist nil) (defvoo nnmbox-active-timestamp nil) -(defvoo nnmbox-file-coding-system mm-text-coding-system) +(defvoo nnmbox-file-coding-system mm-binary-coding-system) (defvoo nnmbox-file-coding-system-for-write nil) -(defvoo nnmbox-active-file-coding-system mm-text-coding-system) +(defvoo nnmbox-active-file-coding-system mm-binary-coding-system) (defvoo nnmbox-active-file-coding-system-for-write nil) diff -r 3a35752ca4cb -r f04f551e94ce lisp/gnus/qp.el --- a/lisp/gnus/qp.el Wed Dec 20 20:09:59 2000 +0000 +++ b/lisp/gnus/qp.el Wed Dec 20 20:20:51 2000 +0000 @@ -89,52 +89,58 @@ If `mm-use-ultra-safe-encoding' is set, fold lines unconditionally and encode lines starting with \"From\"." (interactive "r") - ;; Fixme: what should this do in XEmacs/Mule? - (if (fboundp 'find-charset-region) ; else XEmacs, non-Mule - (if (delq 'unknown ; Emacs 20 unibyte - (delq 'eight-bit-graphic ; Emacs 21 - (delq 'eight-bit-control - (delq 'ascii (find-charset-region from to))))) - (error "Multibyte character in QP encoding region"))) (unless class - (setq class "^\000-\007\013\015-\037\200-\377=")) + ;; Avoid using 8bit characters. = is \075. + ;; Equivalent to "^\000-\007\013\015-\037\200-\377=" + (setq class "\010-\012\014\040-\074\076-\177")) (if (fboundp 'string-as-multibyte) (setq class (string-as-multibyte class))) (save-excursion (save-restriction (narrow-to-region from to) - ;; Encode all the non-ascii and control characters. - (goto-char (point-min)) - (while (and (skip-chars-forward class) - (not (eobp))) - (insert - (prog1 - (format "=%02x" (upcase (char-after))) - (delete-char 1)))) - ;; Encode white space at the end of lines. - (goto-char (point-min)) - (while (re-search-forward "[ \t]+$" nil t) - (goto-char (match-beginning 0)) - (while (not (eolp)) + (mm-with-unibyte-current-buffer-mule4 + ;; Fixme: what should this do in XEmacs/Mule? + (if (fboundp 'find-charset-region) ; else XEmacs, non-Mule + (if (delq 'unknown ; Emacs 20 unibyte + (delq 'eight-bit-graphic ; Emacs 21 + (delq 'eight-bit-control + (delq 'ascii + (find-charset-region from to))))) + (error "Multibyte character in QP encoding region"))) + ;; Encode all the non-ascii and control characters. + (goto-char (point-min)) + (while (and (skip-chars-forward class) + (not (eobp))) (insert (prog1 - (format "=%02x" (upcase (char-after))) - (delete-char 1))))) - (let ((mm-use-ultra-safe-encoding - (and (boundp 'mm-use-ultra-safe-encoding) - mm-use-ultra-safe-encoding))) - (when (or fold mm-use-ultra-safe-encoding) - ;; Fold long lines. - (let ((tab-width 1)) ; HTAB is one character. - (goto-char (point-min)) - (while (not (eobp)) - ;; In ultra-safe mode, encode "From " at the beginning - ;; of a line. - (when mm-use-ultra-safe-encoding - (beginning-of-line) - (when (looking-at "From ") - (replace-match "From=20" nil t))) - (end-of-line) + (format "=%02X" (char-after)) + (delete-char 1)))) + ;; Encode white space at the end of lines. + (goto-char (point-min)) + (while (re-search-forward "[ \t]+$" nil t) + (goto-char (match-beginning 0)) + (while (not (eolp)) + (insert + (prog1 + (format "=%02X" (char-after)) + (delete-char 1))))) + (let ((mm-use-ultra-safe-encoding + (and (boundp 'mm-use-ultra-safe-encoding) + mm-use-ultra-safe-encoding))) + (when (or fold mm-use-ultra-safe-encoding) + ;; Fold long lines. + (let ((tab-width 1)) ; HTAB is one character. + (goto-char (point-min)) + (while (not (eobp)) + ;; In ultra-safe mode, encode "From " at the beginning + ;; of a line. + (when mm-use-ultra-safe-encoding + (beginning-of-line) + (if (looking-at "From ") + (replace-match "From=20" nil t) + (if (looking-at "-") + (replace-match "=2D" nil t)))) + (end-of-line) (while (> (current-column) 76) ; tab-width must be 1. (beginning-of-line) (forward-char 75) ; 75 chars plus an "=" @@ -142,7 +148,7 @@ (insert "=\n") (end-of-line)) (unless (eobp) - (forward-line))))))))) + (forward-line)))))))))) (defun quoted-printable-encode-string (string) "Encode the STRING as quoted-printable and return the result."