X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Frfc2047.el;h=10eff841e3b118d4801b3c56667e7882bfb5e198;hb=3738187cad20787b5b99c4061256e30e19ee721a;hp=7d04a83e4fe3a5db2f5ac055e10bf5aabf90c5c2;hpb=12880262125c73b531b08cd9005fbaf49c2c3395;p=elisp%2Fgnus.git- diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 7d04a83..10eff84 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -116,6 +116,14 @@ Valid encodings are nil, `Q' and `B'.") (point-max)))) (goto-char (point-min))) +(defun rfc2047-field-value () + "Return the value of the field at point." + (save-excursion + (save-restriction + (rfc2047-narrow-to-field) + (re-search-forward ":[ \t\n]*" nil t) + (buffer-substring (point) (point-max))))) + (defun rfc2047-encode-message-header () "Encode the message header according to `rfc2047-header-encoding-alist'. Should be called narrowed to the head of the message." @@ -127,15 +135,26 @@ Should be called narrowed to the head of the message." (save-restriction (rfc2047-narrow-to-field) (if (not (rfc2047-encodable-p)) - (if (and (eq (mm-body-7-or-8) '8bit) - (mm-multibyte-p) - (mm-coding-system-p - (car message-posting-charset))) - ;; 8 bit must be decoded. - ;; Is message-posting-charset a coding system? - (mm-encode-coding-region - (point-min) (point-max) - (car message-posting-charset))) + (prog1 + (if (and (eq (mm-body-7-or-8) '8bit) + (mm-multibyte-p) + (mm-coding-system-p + (car message-posting-charset))) + ;; 8 bit must be decoded. + ;; Is message-posting-charset a coding system? + (mm-encode-coding-region + (point-min) (point-max) + (car message-posting-charset)) + nil) + ;; No encoding necessary, but folding is nice + (rfc2047-fold-region + (save-excursion + (goto-char (point-min)) + (skip-chars-forward "^:") + (when (looking-at ": ") + (forward-char 2)) + (point)) + (point-max))) ;; We found something that may perhaps be encoded. (setq method nil alist rfc2047-header-encoding-alist) @@ -157,18 +176,29 @@ Should be called narrowed to the head of the message." mail-parse-charset) (mm-encode-coding-region (point-min) (point-max) mail-parse-charset))) + ;; We get this when CC'ing messsages to newsgroups with + ;; 8-bit names. The group name mail copy just get + ;; unconditionally encoded. Previously, it would ask + ;; whether to encode, which was quite confusing for the + ;; user. If the new behaviour is wrong, tell me. I have + ;; left the old code commented out below. + ;; -- Per Abrahamsen Date: 2001-10-07. ((null method) - (and (delq 'ascii - (mm-find-charset-region (point-min) - (point-max))) - (if (or (message-options-get - 'rfc2047-encode-message-header-encode-any) - (message-options-set - 'rfc2047-encode-message-header-encode-any - (y-or-n-p - "Some texts are not encoded. Encode anyway?"))) - (rfc2047-encode-region (point-min) (point-max)) - (error "Cannot send unencoded text.")))) + (when (delq 'ascii + (mm-find-charset-region (point-min) (point-max))) + (rfc2047-encode-region (point-min) (point-max)))) +;;; ((null method) +;;; (and (delq 'ascii +;;; (mm-find-charset-region (point-min) +;;; (point-max))) +;;; (if (or (message-options-get +;;; 'rfc2047-encode-message-header-encode-any) +;;; (message-options-set +;;; 'rfc2047-encode-message-header-encode-any +;;; (y-or-n-p +;;; "Some texts are not encoded. Encode anyway?"))) +;;; (rfc2047-encode-region (point-min) (point-max)) +;;; (error "Cannot send unencoded text")))) ((mm-coding-system-p method) (if (and (featurep 'mule) (if (boundp 'default-enable-multibyte-characters) @@ -316,6 +346,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 @@ -323,21 +360,24 @@ 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) - (if (looking-at " \t") + (if (looking-at "[ \t]") (insert "\n") (insert "\n ")) (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) @@ -351,7 +391,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) ?=) @@ -361,17 +404,26 @@ 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) - (if (looking-at " \t") + (if (looking-at "[ \t]") (insert "\n") (insert "\n ")) (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." @@ -419,7 +471,7 @@ The buffer may be narrowed." (while alist (when (looking-at (caar alist)) (mm-with-unibyte-current-buffer-mule4 - (quoted-printable-encode-region + (quoted-printable-encode-region (point-min) (point-max) nil (cdar alist))) (subst-char-in-region (point-min) (point-max) ? ?_) (setq alist nil))