From 7743919c94113c668a09e272a91b309b9ba5d5a9 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Sun, 30 Dec 2001 21:20:29 +0000 Subject: [PATCH] * rfc2047.el (rfc2047-fold-line): New function. (rfc2047-unfold-line): Ditto. (rfc2047-fold-region): Don't fold just after the header name. * mail-parse.el (mail-header-fold-line): New alias. (mail-header-unfold-line): Ditto. * gnus-art.el (gnus-body-boundary-face): Renamed. (gnus-article-treat-body-boundary): Use it. (gnus-article-treat-body-boundary): Use an invisible header and a line of underline characters. --- lisp/ChangeLog | 14 ++++++++++++++ lisp/gnus-art.el | 12 ++++++++---- lisp/mail-parse.el | 3 +++ lisp/rfc2047.el | 32 +++++++++++++++++++++++++++----- 4 files changed, 52 insertions(+), 9 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 134b0cf29..fdf475c34 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,17 @@ +2001-12-30 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-fold-line): New function. + (rfc2047-unfold-line): Ditto. + (rfc2047-fold-region): Don't fold just after the header name. + + * mail-parse.el (mail-header-fold-line): New alias. + (mail-header-unfold-line): Ditto. + + * gnus-art.el (gnus-body-boundary-face): Renamed. + (gnus-article-treat-body-boundary): Use it. + (gnus-article-treat-body-boundary): Use an invisible header and a + line of underline characters. + 2001-12-30 ShengHuo ZHU * ietf-drums.el (ietf-drums-parse-addresses): Recover from errors. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 5b72bca8a..291d32db8 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -362,7 +362,7 @@ Esample: (_/*word*/_)." "Face used for displaying highlighted words." :group 'gnus-article-emphasis) -(defface gnus-body-separator-face +(defface gnus-body-boundary-face '((((class color) (background dark)) (:background "white") @@ -1635,10 +1635,14 @@ unfolded." (interactive) (gnus-with-article-headers (goto-char (point-max)) - (insert (make-string (1- (window-width)) ? ) + (let ((start (point))) + (insert "X-Boundary: ") + (gnus-add-text-properties start (point) '(invisible t intangible t)) + (insert (make-string (1- (window-width)) ?-) "\n") - (put-text-property (point) (progn (forward-line -1) (point)) - 'face 'gnus-body-separator-face))) + ;;(put-text-property (point) (progn (forward-line -1) (point)) + ;; 'face 'gnus-body-bondary-face) + ))) (defun article-fill-long-lines () "Fill lines that are wider than the window width." diff --git a/lisp/mail-parse.el b/lisp/mail-parse.el index 95a335925..ea6b242eb 100644 --- a/lisp/mail-parse.el +++ b/lisp/mail-parse.el @@ -59,7 +59,10 @@ (defalias 'mail-narrow-to-head 'ietf-drums-narrow-to-header) (defalias 'mail-quote-string 'ietf-drums-quote-string) +(defalias 'mail-header-fold-field 'rfc2047-fold-field) +(defalias 'mail-header-unfold-field 'rfc2047-unfold-field) (defalias 'mail-header-narrow-to-field 'rfc2047-narrow-to-field) + (defalias 'mail-encode-encoded-word-region 'rfc2047-encode-region) (defalias 'mail-encode-encoded-word-buffer 'rfc2047-encode-message-header) (defalias 'mail-encode-encoded-word-string 'rfc2047-encode-string) diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 530059e1e..c1ab6ca5c 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -338,6 +338,13 @@ The buffer may be narrowed." (insert "?=") (forward-line 1))))) +(defun rfc2047-fold-field () + "Fold the current line." + (save-excursion + (save-restriction + (rfc2047-narrow-to-field) + (rfc2047-fold-region (point-min) (point-max))))) + (defun rfc2047-fold-region (b e) "Fold long lines in region B to E." (save-restriction @@ -345,11 +352,13 @@ The buffer may be narrowed." (goto-char (point-min)) (let ((break nil) (qword-break nil) + (first t) (bol (save-restriction (widen) (gnus-point-at-bol)))) (while (not (eobp)) - (when (and (or break qword-break) (> (- (point) bol) 76)) + (when (and (or break qword-break) + (> (- (point) bol) 76)) (goto-char (or break qword-break)) (setq break nil qword-break nil) @@ -359,7 +368,8 @@ The buffer may be narrowed." (setq bol (1- (point))) ;; Don't break before the first non-LWSP characters. (skip-chars-forward " \t") - (unless (eobp) (forward-char 1))) + (unless (eobp) + (forward-char 1))) (cond ((eq (char-after) ?\n) (forward-char 1) @@ -373,7 +383,10 @@ The buffer may be narrowed." (forward-char 1)) ((memq (char-after) '(? ?\t)) (skip-chars-forward " \t") - (setq break (1- (point)))) + (if first + ;; Don't break just after the header name. + (setq first nil) + (setq break (1- (point))))) ((not break) (if (not (looking-at "=\\?[^=]")) (if (eq (char-after) ?=) @@ -383,7 +396,8 @@ The buffer may be narrowed." (skip-chars-forward "^ \t\n\r"))) (t (skip-chars-forward "^ \t\n\r")))) - (when (and (or break qword-break) (> (- (point) bol) 76)) + (when (and (or break qword-break) + (> (- (point) bol) 76)) (goto-char (or break qword-break)) (setq break nil qword-break nil) @@ -393,7 +407,15 @@ The buffer may be narrowed." (setq bol (1- (point))) ;; Don't break before the first non-LWSP characters. (skip-chars-forward " \t") - (unless (eobp) (forward-char 1)))))) + (unless (eobp) + (forward-char 1)))))) + +(defun rfc2047-unfold-field () + "Fold the current line." + (save-excursion + (save-restriction + (rfc2047-narrow-to-field) + (rfc2047-unfold-region (point-min) (point-max))))) (defun rfc2047-unfold-region (b e) "Unfold lines in region B to E." -- 2.34.1