From 9ef3ff2439df2b5f147b53e87bc8852bd999398b Mon Sep 17 00:00:00 2001 From: yamaoka Date: Thu, 7 Feb 2002 23:33:25 +0000 Subject: [PATCH] Synch with Oort Gnus. --- lisp/ChangeLog | 22 +++++++++++++++++++++- lisp/gnus-art.el | 7 ++++--- lisp/gnus-msg.el | 1 + lisp/gnus-util.el | 4 ++-- lisp/message.el | 1 + lisp/nnheader.el | 49 +++++++++++++++++++++++++++++++------------------ lisp/rfc2047.el | 20 ++++++++------------ 7 files changed, 68 insertions(+), 36 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6391869..ee9ef51 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,25 @@ +2002-02-07 Paul Jarc + + * gnus-util.el (gnus-split-references): Allow (broken) Message-IDs + with internal whitespace. + (gnus-parent-id): Ditto. + 2002-02-07 ShengHuo ZHU + * gnus-art.el (gnus-article-treat-body-boundary): Add + gnus-decoration property. + * gnus-msg.el (gnus-copy-article-buffer): Remove gnus-decoration. + + * message.el (message-mode): Set local-abbrev-table. + From Matt Armstrong . + + * gnus-art.el (gnus-article-treat-unfold-headers): Don't remove + too many spaces. + + * rfc2047.el (rfc2047-unfold-region): Ditto. + (rfc2047-decode-region): Don't unfold. Let + gnus-article-treat-unfold-headers do it. + * gnus-sum.el (gnus-dependencies-add-header): Fix typo. From: Jesper Harder @@ -1910,7 +1930,7 @@ 2001-12-29 Lars Magne Ingebrigtsen * gnus-art.el (gnus-treat-unfold-lines): New variable. - (gnus-treat-unfold-headers): Remamed. + (gnus-treat-unfold-headers): Renamed. (gnus-article-treat-unfold-headers): New command and keystroke. * rfc2047.el (rfc2047-encode-message-header): Clean up. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index f2fa92f..5641f05 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1875,11 +1875,11 @@ unfolded." (with-temp-buffer (insert header) (goto-char (point-min)) - (while (re-search-forward "[\t ]*\n[\t ]+" nil t) + (while (re-search-forward "\n[\t ]" nil t) (replace-match " " t t))) (setq length (- (point-max) (point-min) 1))) (when (< length (window-width)) - (while (re-search-forward "[\t ]*\n[\t ]+" nil t) + (while (re-search-forward "\n[\t ]" nil t) (replace-match " " t t))) (goto-char (point-max))))))) @@ -1951,7 +1951,8 @@ unfolded." (while (>= (1- (window-width)) (length str)) (setq str (concat str gnus-body-boundary-delimiter))) (substring str 0 (1- (window-width)))) - "\n"))))) + "\n") + (gnus-add-text-properties start (point) '(gnus-decoration 'header)))))) (defun article-fill-long-lines () "Fill lines that are wider than the window width." diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 47040ae..1202bdb 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -777,6 +777,7 @@ header line with the old Message-ID." (gnus-article-delete-text-of-type 'annotation) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next) + (gnus-remove-text-with-property 'gnus-decoration) (gnus-remove-text-with-property 'x-face-mule-bitmap-image) (insert (prog1 diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 84303c1..931f14a 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -495,7 +495,7 @@ jabbering all the time." "Return a list of Message-IDs in REFERENCES." (let ((beg 0) ids) - (while (string-match "<[^> \t]+>" references beg) + (while (string-match "<[^<]+[^< \t]" references beg) (push (substring references (match-beginning 0) (setq beg (match-end 0))) ids)) (nreverse ids))) @@ -510,7 +510,7 @@ If N, return the Nth ancestor instead." (while (nthcdr n ids) (setq ids (cdr ids))) (car ids)) - (when (string-match "<[^> \t]+>\\'" references) + (when (string-match "<[^<]+\\'" references) (match-string 0 references))))) (defun gnus-buffer-live-p (buffer) diff --git a/lisp/message.el b/lisp/message.el index 5c20e8f..36d7ef1 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1988,6 +1988,7 @@ C-c C-r `message-caesar-buffer-body' (rot13 the message body). C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance). C-c M-n `message-insert-disposition-notification-to' (request receipt). M-RET `message-newline-and-reformat' (break the line and reformat)." + (setq local-abbrev-table text-mode-abbrev-table) (set (make-local-variable 'message-reply-buffer) nil) (make-local-variable 'message-send-actions) (make-local-variable 'message-exit-actions) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 52f7e9f..24bc755 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -106,6 +106,7 @@ This variable is a substitute for `mm-text-coding-system-for-write'.") ;; mm- stuff. (unless (featurep 'mm-util) + ;; Should keep track of `mm-image-load-path' in mm-util.el. (defun nnheader-image-load-path (&optional package) (let (dir result) (dolist (path load-path (nreverse result)) @@ -117,6 +118,7 @@ This variable is a substitute for `mm-text-coding-system-for-write'.") (push path result)))) (defalias 'mm-image-load-path 'nnheader-image-load-path) + ;; Should keep track of `mm-read-coding-system' in mm-util.el. (defalias 'mm-read-coding-system (if (or (and (featurep 'xemacs) (<= (string-to-number emacs-version) 21.1)) @@ -125,14 +127,15 @@ This variable is a substitute for `mm-text-coding-system-for-write'.") (read-coding-system prompt)) 'read-coding-system)) + ;; Should keep track of `mm-%s' in mm-util.el. (defalias 'mm-multibyte-string-p (if (fboundp 'multibyte-string-p) 'multibyte-string-p 'ignore)) - (defalias 'mm-encode-coding-string 'encode-coding-string) (defalias 'mm-decode-coding-string 'decode-coding-string) + ;; Should keep track of `mm-detect-coding-region' in mm-util.el. (defun nnheader-detect-coding-region (start end) "Like 'detect-coding-region' except returning the best one." (let ((coding-systems @@ -143,6 +146,7 @@ This variable is a substitute for `mm-text-coding-system-for-write'.") coding-systems))) (defalias 'mm-detect-coding-region 'nnheader-detect-coding-region) + ;; Should keep track of `mm-detect-mime-charset-region' in mm-util.el. (defun nnheader-detect-mime-charset-region (start end) "Detect MIME charset of the text in the region between START and END." (coding-system-to-mime-charset @@ -150,6 +154,7 @@ This variable is a substitute for `mm-text-coding-system-for-write'.") (defalias 'mm-detect-mime-charset-region 'nnheader-detect-mime-charset-region) + ;; Should keep track of `mm-with-unibyte-buffer' in mm-util.el. (defmacro nnheader-with-unibyte-buffer (&rest forms) "Create a temporary buffer, and evaluate FORMS there like `progn'. Use unibyte mode for this." @@ -163,6 +168,7 @@ Use unibyte mode for this." ;; mail-parse stuff. (unless (featurep 'mail-parse) + ;; Should keep track of `rfc2047-narrow-to-field' in rfc2047.el. (defun-maybe std11-narrow-to-field () "Narrow the buffer to the header on the current line." (forward-line 0) @@ -172,9 +178,9 @@ Use unibyte mode for this." (when (eolp) (forward-line 1)) (point))) (goto-char (point-min))) - (defalias 'mail-header-narrow-to-field 'std11-narrow-to-field) + ;; Should keep track of `ietf-drums-narrow-to-header' in ietf-drums.el. (defun mail-narrow-to-head () "Narrow to the header section in the current buffer." (narrow-to-region @@ -184,6 +190,7 @@ Use unibyte mode for this." (point-max))) (goto-char (point-min))) + ;; Should keep track of `rfc2047-fold-region' in rfc2047.el. (defun-maybe std11-fold-region (b e) "Fold long lines in region B to E." (save-restriction @@ -249,6 +256,7 @@ Use unibyte mode for this." (unless (eobp) (forward-char 1)))))) + ;; Should keep track of `rfc2047-fold-field' in rfc2047.el. (defun-maybe std11-fold-field () "Fold the current line." (save-excursion @@ -258,6 +266,7 @@ Use unibyte mode for this." (defalias 'mail-header-fold-field 'std11-fold-field) + ;; Should keep track of `rfc2047-unfold-region' in rfc2047.el. (defun-maybe std11-unfold-region (b e) "Unfold lines in region B to E." (save-restriction @@ -266,22 +275,20 @@ Use unibyte mode for this." (let ((bol (save-restriction (widen) (gnus-point-at-bol))) - (eol (gnus-point-at-eol)) - leading) + (eol (gnus-point-at-eol))) (forward-line 1) (while (not (eobp)) - (looking-at "[ \t]*") - (setq leading (- (match-end 0) (match-beginning 0))) - (if (< (- (gnus-point-at-eol) bol leading) 76) - (progn - (goto-char eol) - (delete-region eol (progn - (skip-chars-forward " \t\n\r") - (1- (point))))) + (if (and (looking-at "[ \t]") + (< (- (gnus-point-at-eol) bol) 76)) + (delete-region eol (progn + (goto-char eol) + (skip-chars-forward "\r\n") + (point))) (setq bol (gnus-point-at-bol))) (setq eol (gnus-point-at-eol)) (forward-line 1))))) + ;; Should keep track of `rfc2047-unfold-field' in rfc2047.el. (defun-maybe std11-unfold-field () "Fold the current line." (save-excursion @@ -291,17 +298,22 @@ Use unibyte mode for this." (defalias 'mail-header-unfold-field 'std11-unfold-field) + ;; This is the original function in T-gnus. (defun-maybe std11-extract-addresses-components (string) "Extract a list of full name and canonical address from STRING. Each element looks like a list of the form (FULL-NAME CANONICAL-ADDRESS). If no name can be extracted, FULL-NAME will be nil." (when string - (mapcar (function - (lambda (structure) - (list (std11-full-name-string structure) - (std11-address-string structure)))) - (std11-parse-addresses-string (std11-unfold-string string))))) - + (let (addresses) + (dolist (structure (std11-parse-addresses-string + (std11-unfold-string string)) + addresses) + (push (list (std11-full-name-string structure) + (std11-address-string structure)) + addresses)) + (nreverse addresses)))) + + ;; Should keep track of `ietf-drums-parse-addresses' in ietf-drums.el. (defun mail-header-parse-addresses (string) "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." (mapcar (function @@ -309,6 +321,7 @@ If no name can be extracted, FULL-NAME will be nil." (cons (nth 1 components) (car components)))) (std11-extract-addresses-components string))) + ;; Should keep track of `rfc2047-field-value' in rfc2047.el. (defun-maybe std11-field-value (&optional dont-include-last-newline) "Return the value of the field at point. If the optional argument is given, the return value will not contain the last newline." diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 2d4a87a..452be13 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -433,18 +433,15 @@ The buffer may be narrowed." (let ((bol (save-restriction (widen) (gnus-point-at-bol))) - (eol (gnus-point-at-eol)) - leading) + (eol (gnus-point-at-eol))) (forward-line 1) (while (not (eobp)) - (looking-at "[ \t]*") - (setq leading (- (match-end 0) (match-beginning 0))) - (if (< (- (gnus-point-at-eol) bol leading) 76) - (progn - (goto-char eol) - (delete-region eol (progn - (skip-chars-forward " \t\n\r") - (1- (point))))) + (if (and (looking-at "[ \t]") + (< (- (gnus-point-at-eol) bol) 76)) + (delete-region eol (progn + (goto-char eol) + (skip-chars-forward "\r\n") + (point))) (setq bol (gnus-point-at-bol))) (setq eol (gnus-point-at-eol)) (forward-line 1))))) @@ -530,8 +527,7 @@ The buffer may be narrowed." mail-parse-charset (not (eq mail-parse-charset 'us-ascii)) (not (eq mail-parse-charset 'gnus-decoded))) - (mm-decode-coding-region b (point-max) mail-parse-charset)) - (rfc2047-unfold-region (point-min) (point-max)))))) + (mm-decode-coding-region b (point-max) mail-parse-charset)))))) (defun rfc2047-decode-string (string) "Decode the quoted-printable-encoded STRING and return the results." -- 1.7.10.4