Mercurial > emacs

changeset 34752:f04f551e94ce

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* 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.
author ShengHuo ZHU <zsh@cs.rochester.edu>
date Wed, 20 Dec 2000 20:20:51 +0000
parents 3a35752ca4cb
children 879195ddd0d6
files lisp/gnus/ChangeLog lisp/gnus/gnus-cus.el lisp/gnus/gnus-msg.el lisp/gnus/message.el lisp/gnus/mm-uu.el lisp/gnus/mml.el lisp/gnus/nnmbox.el lisp/gnus/qp.el
diffstat 8 files changed, 145 insertions(+), 83 deletions(-) [+]
line wrap: on
line diff
--- 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  <zsh@cs.rochester.edu>
+
+	* 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 <C.Conrad@cli.de>
+
+	* qp.el (quoted-printable-encode-region): Upcase QP.
+
 2000-12-20  ShengHuo ZHU  <zsh@cs.rochester.edu>
 
 	* gnus-util.el (gnus-add-text-properties-when): New function.
--- 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
--- 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)
--- 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))
--- 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.
--- 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
--- 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)
 
 
--- 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."