X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Frfc2047.el;h=081ba9b24a13421c5ad9aad4ec31eaed96c3d250;hb=29066f563c4fb40540835af4e82210b6367c7cee;hp=babae4e562788a6ea1318bd1ee440027f783ab1e;hpb=3b7d176c4be2bb207554ac958b519f7286e7d031;p=gnus diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index babae4e56..081ba9b24 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -44,7 +44,7 @@ '(("Newsgroups" . nil) ("Followup-To" . nil) ("Message-ID" . nil) - ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\ + ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|\\(In-\\)?Reply-To\\|Sender\ \\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime) (t . mime)) "*Header/encoding method alist. @@ -369,14 +369,14 @@ Dynamically bind `rfc2047-encoding-type' to change that." (forward-list) ;; Encode text as an unstructured field. (let ((rfc2047-encoding-type 'mime)) - (rfc2047-encode-region (1+ start) (1- (point))) - (forward-char))) + (rfc2047-encode-region (1+ start) (1- (point)))) + (skip-chars-forward ")")) (t ; normal token/whitespace sequence ;; Find the end. ;; Skip one ASCII word, or encode continuous words ;; in which all those contain non-ASCII characters. (setq end nil) - (while (not end) + (while (not (or end (eobp))) (when (looking-at "[\000-\177]+") (setq begin (point) end (match-end 0)) @@ -409,6 +409,7 @@ Dynamically bind `rfc2047-encoding-type' to change that." (while (re-search-forward encodable-regexp end t)) (< begin (point))) + (goto-char begin) (or (not (re-search-forward "\\Sw" end t)) (progn (goto-char (match-beginning 0)) @@ -421,7 +422,9 @@ Dynamically bind `rfc2047-encoding-type' to change that." ;; to be encoded so that MTAs may parse ;; them safely. (cond ((= end (point))) - ((looking-at encodable-regexp) + ((looking-at (concat "\\sw*\\(" + encodable-regexp + "\\)")) (setq end nil)) (t (goto-char (1- (match-end 0))) @@ -441,12 +444,20 @@ Dynamically bind `rfc2047-encoding-type' to change that." (goto-char start) (if (re-search-forward encodable-regexp end 'move) (progn - (goto-char start) - (unless (memq (char-before) '(nil ?\t ? )) - ;; Separate encodable text and delimiter. - (insert " ") - (setq end (1+ end))) - (rfc2047-encode (point) end) + (unless (memq (char-before start) '(nil ?\t ? )) + (if (progn + (goto-char start) + (skip-chars-backward "^ \t\n") + (and (looking-at "\\Sw+") + (= (match-end 0) start))) + ;; Also encode bogus delimiters. + (setq start (point)) + ;; Separate encodable text and delimiter. + (goto-char start) + (insert " ") + (setq start (1+ start) + end (1+ end)))) + (rfc2047-encode start end) (setq last-encoded t)) (setq last-encoded nil))))) (error @@ -471,7 +482,8 @@ By default, the string is treated as containing addresses (see If it is nil, encoded-words will not be folded. Too small value may cause an error. Don't change this for no particular reason.") -(defun rfc2047-encode-1 (column string cs encoder start space &optional eword) +(defun rfc2047-encode-1 (column string cs encoder start crest tail + &optional eword) "Subroutine used by `rfc2047-encode'." (cond ((string-equal string "") (or eword "")) @@ -482,17 +494,21 @@ cause an error. Don't change this for no particular reason.") string)) "?=")) ((>= column rfc2047-encode-max-chars) - (when (and eword - (string-match "\n[ \t]+\\'" eword)) - ;; Reomove a superfluous empty line. - (setq eword (substring eword 0 (match-beginning 0)))) - (rfc2047-encode-1 (length space) string cs encoder start " " - (concat eword "\n" space))) + (when eword + (cond ((string-match "\n[ \t]+\\'" eword) + ;; Reomove a superfluous empty line. + (setq eword (substring eword 0 (match-beginning 0)))) + ((string-match "(+\\'" eword) + ;; Break the line before the open parenthesis. + (setq crest (concat crest (match-string 0 eword)) + eword (substring eword 0 (match-beginning 0)))))) + (rfc2047-encode-1 (length crest) string cs encoder start " " tail + (concat eword "\n" crest))) (t (let ((index 0) (limit (1- (length string))) (prev "") - next) + next len) (while (and prev (<= index limit)) (setq next (concat start @@ -502,27 +518,48 @@ cause an error. Don't change this for no particular reason.") (substring string 0 (1+ index)) cs) (substring string 0 (1+ index)))) - "?=")) - (if (<= (+ column (length next)) rfc2047-encode-max-chars) - (setq prev next - index (1+ index)) - (setq next prev - prev nil))) - (setq eword (concat eword next)) + "?=") + len (+ column (length next))) + (if (> len rfc2047-encode-max-chars) + (setq next prev + prev nil) + (if (or (< index limit) + (<= (+ len (or (string-match "\n" tail) + (length tail))) + rfc2047-encode-max-chars)) + (setq prev next + index (1+ index)) + (if (string-match "\\`)+" tail) + ;; Break the line after the close parenthesis. + (setq tail (concat (substring tail 0 (match-end 0)) + "\n " + (substring tail (match-end 0))) + prev next + index (1+ index)) + (setq next prev + prev nil))))) (if (> index limit) - eword + (concat eword next tail) + (if (= 0 index) + (if (and eword + (string-match "(+\\'" eword)) + (setq crest (concat crest (match-string 0 eword)) + eword (substring eword 0 (match-beginning 0))) + (setq eword (concat eword next))) + (setq crest " " + eword (concat eword next))) (when (string-match "\n[ \t]+\\'" eword) ;; Reomove a superfluous empty line. (setq eword (substring eword 0 (match-beginning 0)))) - (rfc2047-encode-1 (length space) (substring string index) - cs encoder start " " - (concat eword "\n" space))))))) + (rfc2047-encode-1 (length crest) (substring string index) + cs encoder start " " tail + (concat eword "\n" crest))))))) (defun rfc2047-encode (b e) "Encode the word(s) in the region B to E. Point moves to the end of the region." (let ((mime-charset (or (mm-find-mime-charset-region b e) (list 'us-ascii))) - cs encoding space eword) + cs encoding tail crest eword) (cond ((> (length mime-charset) 1) (error "Can't rfc2047-encode `%s'" (buffer-substring-no-properties b e))) @@ -543,12 +580,19 @@ Point moves to the end of the region." 'B 'Q))) (widen) + (goto-char e) + (skip-chars-forward "^ \t\n") + ;; `tail' may contain a close parenthesis. + (setq tail (buffer-substring-no-properties e (point))) (goto-char b) (setq b (point-marker) e (set-marker (make-marker) e)) (rfc2047-fold-region (point-at-bol) b) + (goto-char b) + (skip-chars-backward "^ \t\n") (unless (= 0 (skip-chars-backward " \t")) - (setq space (buffer-substring-no-properties (point) b))) + ;; `crest' may contain whitespace and an open parenthesis. + (setq crest (buffer-substring-no-properties (point) b))) (setq eword (rfc2047-encode-1 (- b (point-at-bol)) (mm-replace-in-string @@ -560,15 +604,21 @@ Point moves to the end of the region." 'identity) (concat "=?" (downcase (symbol-name mime-charset)) "?" (upcase (symbol-name encoding)) "?") - (or space " "))) + (or crest " ") + tail)) (delete-region (if (eq (aref eword 0) ?\n) - (point) + (if (bolp) + ;; The line was folded before encoding. + (1- (point)) + (point)) (goto-char b)) - e) + (+ e (length tail))) + ;; `eword' contains `crest' and `tail'. (insert eword) (set-marker b nil) (set-marker e nil) - (unless (or (eolp) + (unless (or (/= 0 (length tail)) + (eobp) (looking-at "[ \t\n)]")) (insert " ")))) (t @@ -639,9 +689,10 @@ Point moves to the end of the region." (goto-char (or break qword-break)) (setq break nil qword-break nil) - (if (looking-at "[ \t]") - (insert ?\n) - (insert "\n ")) + (if (or (> 0 (skip-chars-backward " \t")) + (looking-at "[ \t]")) + (insert ?\n) + (insert "\n ")) (setq bol (1- (point))) ;; Don't break before the first non-LWSP characters. (skip-chars-forward " \t") @@ -717,7 +768,7 @@ it, put the following line in your ~/.gnus.el file: (string (rfc2047-encode-string value))) (if (string-match "[][()<>@,;:\\\"/?=]" ;; tspecials string) - (concat param "=" (format "%S" string)) + (format "%s=%S" param string) (concat param "=" string)))) ;;;