summaryrefslogtreecommitdiff
path: root/lisp/gnus
diff options
context:
space:
mode:
authorShengHuo ZHU <zsh@cs.rochester.edu>2000-12-20 20:20:51 +0000
committerShengHuo ZHU <zsh@cs.rochester.edu>2000-12-20 20:20:51 +0000
commit158d6e07f0788e7de5f41758fd838d6df58241c5 (patch)
tree13dc0922842cd95089d4fcaaa0bac9318202d8e4 /lisp/gnus
parent19594307c97cb7c9b9fed97f704c427d8c9c695f (diff)
downloademacs-158d6e07f0788e7de5f41758fd838d6df58241c5.tar.gz
* 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.
Diffstat (limited to 'lisp/gnus')
-rw-r--r--lisp/gnus/ChangeLog33
-rw-r--r--lisp/gnus/gnus-cus.el18
-rw-r--r--lisp/gnus/gnus-msg.el19
-rw-r--r--lisp/gnus/message.el64
-rw-r--r--lisp/gnus/mm-uu.el5
-rw-r--r--lisp/gnus/mml.el1
-rw-r--r--lisp/gnus/nnmbox.el4
-rw-r--r--lisp/gnus/qp.el84
8 files changed, 145 insertions, 83 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 326d346b9a8..b2e6d65febb 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,5 +1,38 @@
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.
(gnus-remove-text-properties-when): Ditto.
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index c735fe984d1..87987e59e49 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -270,7 +270,23 @@ default charset will be used instead.")
(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 --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index d9ec9a56019..91baed2029c 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -721,23 +721,8 @@ If POST, post instead of mail."
(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 --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index ef0cc85393c..11ea1a40fb0 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1242,10 +1242,8 @@ Return the number of headers removed."
(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 is left at the beginning of the narrowed-to region."
(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 @@ OTHER-HEADERS is an alist of header/value pairs."
(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 @@ If ARG, allow editing of the cancellation message."
(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 @@ header line with the old Message-ID."
(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 @@ the message."
"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 NEWS will use news to forward instead of mail.
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 @@ Optional DIGEST will use digest to forward."
(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 @@ you."
(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 --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index c7bab9dd4d3..c50c04b2291 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -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 --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 4bd92f3a220..b11a2d8bb14 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -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 --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index 33a951d1fad..43b00a65098 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -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 --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el
index cb0b4bb4a7e..a5993de136f 100644
--- a/lisp/gnus/qp.el
+++ b/lisp/gnus/qp.el
@@ -89,52 +89,58 @@ the form expected by `skip-chars-forward'.
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 @@ encode lines starting with \"From\"."
(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."