From 3412804220a4479e11c6c124299a036e602d7e3b Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Fri, 10 Feb 2006 05:08:29 +0000 Subject: Revision: emacs@sv.gnu.org/emacs--devo--0--patch-62 Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 22-26) - Update from CVS - Merge from emacs--devo--0 --- lisp/gnus/ChangeLog | 34 ++++++++++++++++++ lisp/gnus/mm-view.el | 3 +- lisp/gnus/mml1991.el | 6 ++-- lisp/gnus/mml2015.el | 2 ++ lisp/gnus/nnfolder.el | 2 +- lisp/gnus/rfc2231.el | 98 +++++++++++++++++++++++++++------------------------ lisp/pgg-def.el | 3 ++ lisp/pgg-gpg.el | 26 +++++++------- 8 files changed, 112 insertions(+), 62 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 168280e8e2..f7c9732565 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,37 @@ +2006-02-09 Daiki Ueno + + * pgg-gpg.el (pgg-gpg-encrypt-region): Don't convert line-endings + in elisp. + (pgg-gpg-encrypt-symmetric-region): Ditto. + (pgg-gpg-sign-region): Ditto. + + * pgg-def.el (pgg-text-mode): New variable. + + * mml2015.el (mml2015-pgg-sign): Enable pgg-text-mode. + (mml2015-pgg-encrypt): Ditto. + + * mml1991.el (mml1991-pgg-sign): Enable pgg-text-mode. + (mml1991-pgg-encrypt): Ditto. + +2006-02-08 Katsumi Yamaoka + + * nnfolder.el (nnfolder-insert-newsgroup-line): Use + message-make-date instead of current-time-string. + + * mm-view.el (mm-inline-message): Don't set gnus-newsgroup-charset + to gnus-decoded which mm-uu might set. + +2006-02-08 Katsumi Yamaoka + + * rfc2231.el (rfc2231-parse-string): Sort segmented parameters; + don't decode quoted parameters; remove misimported Emacs code. + Suggested by ARISAWA Akihiro . + (rfc2231-decode-encoded-string): Don't use split-string which + behaves differently according to Emacs version; use + mm-decode-coding-region to convert charset to coding-system. + Suggested by ARISAWA Akihiro . + (rfc2231-encode-string): Remove misimported Emacs code. + 2006-02-07 Katsumi Yamaoka * gnus-art.el (article-decode-charset): Don't use ignore-errors diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 73cab0a567..43d6bddf19 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -486,7 +486,8 @@ ;; disable prepare hook gnus-article-prepare-hook (gnus-newsgroup-charset - (or charset gnus-newsgroup-charset))) + (unless (eq charset 'gnus-decoded) ;; mm-uu might set it. + (or charset gnus-newsgroup-charset)))) (let ((gnus-original-article-buffer (mm-handle-buffer handle))) (run-hooks 'gnus-article-decode-hook)) (gnus-article-prepare-display) diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 761ce4f0af..0c6bb67538 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -229,7 +229,8 @@ (defvar pgg-output-buffer)) (defun mml1991-pgg-sign (cont) - (let (headers cte) + (let ((pgg-text-mode t) + headers cte) ;; Don't sign headers. (goto-char (point-min)) (while (not (looking-at "^$")) @@ -261,7 +262,8 @@ t)) (defun mml1991-pgg-encrypt (cont &optional sign) - (let (cte) + (let ((pgg-text-mode t) + cte) ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED (goto-char (point-min)) (while (looking-at "^Content[^ ]+:") diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index cb9e77983d..80dd5b2659 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -814,6 +814,7 @@ (boundary (mml-compute-boundary cont)) (pgg-default-user-id (or (message-options-get 'mml-sender) pgg-default-user-id)) + (pgg-text-mode t) entry) (unless (pgg-sign-region (point-min) (point-max)) (pop-to-buffer mml2015-result-buffer) @@ -841,6 +842,7 @@ (defun mml2015-pgg-encrypt (cont &optional sign) (let ((pgg-errors-buffer mml2015-result-buffer) + (pgg-text-mode t) (boundary (mml-compute-boundary cont))) (unless (pgg-encrypt-region (point-min) (point-max) (split-string diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index c7043011fa..bd9957283f 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -826,7 +826,7 @@ deleted. Point is left where the deleted region was." (insert "\n")) (forward-char -1) (insert (format (concat nnfolder-article-marker "%d %s\n") - (cdr group-art) (current-time-string))))) + (cdr group-art) (message-make-date))))) (defun nnfolder-active-number (group) ;; Find the next article number in GROUP. diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el index 31c9f1ade9..7b4cf2447f 100644 --- a/lisp/gnus/rfc2231.el +++ b/lisp/gnus/rfc2231.el @@ -52,14 +52,8 @@ function fails in parsing of parameters." (let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token)) (stoken (ietf-drums-token-to-list ietf-drums-tspecials)) (ntoken (ietf-drums-token-to-list "0-9")) - (prev-value "") - display-name mailbox c display-string parameters - attribute value type subtype number encoded - prev-attribute prev-encoded) - ;; Some mailer (e.g. Thunderbird 1.5) doesn't terminate each - ;; line with semicolon when folding a long parameter value. - (while (string-match "\\([^\t\n\r ;]\\)[\t ]*\r?\n[\t ]+" string) - (setq string (replace-match "\\1;\n " nil nil string))) + c type attribute encoded number prev-attribute vals + prev-encoded parameters value) (ietf-drums-init (mail-header-remove-whitespace (mail-header-remove-comments string))) (let ((table (copy-syntax-table ietf-drums-syntax-table))) @@ -97,31 +91,36 @@ function fails in parsing of parameters." (point) (progn (forward-sexp 1) (point)))))) (error "Invalid header: %s" string)) (setq c (char-after)) - (when (eq c ?*) - (forward-char 1) - (setq c (char-after)) - (if (not (memq c ntoken)) - (setq encoded t - number nil) - (setq number - (string-to-number - (buffer-substring - (point) (progn (forward-sexp 1) (point))))) - (setq c (char-after)) - (when (eq c ?*) - (setq encoded t) + (if (eq c ?*) + (progn (forward-char 1) - (setq c (char-after))))) + (setq c (char-after)) + (if (not (memq c ntoken)) + (setq encoded t + number nil) + (setq number + (string-to-number + (buffer-substring + (point) (progn (forward-sexp 1) (point))))) + (setq c (char-after)) + (when (eq c ?*) + (setq encoded t) + (forward-char 1) + (setq c (char-after))))) + (setq number nil + encoded nil)) ;; See if we have any previous continuations. (when (and prev-attribute (not (eq prev-attribute attribute))) + (setq vals + (mapconcat 'cdr (sort vals 'car-less-than-car) "")) (push (cons prev-attribute (if prev-encoded - (rfc2231-decode-encoded-string prev-value) - prev-value)) + (rfc2231-decode-encoded-string vals) + vals)) parameters) (setq prev-attribute nil - prev-value "" + vals nil prev-encoded nil)) (unless (eq c ?=) (error "Invalid header: %s" string)) @@ -132,7 +131,10 @@ function fails in parsing of parameters." (setq value (buffer-substring (1+ (point)) (progn (forward-sexp 1) - (1- (point)))))) + (1- (point))))) + (when encoded + (setq value (mapconcat (lambda (c) (format "%%%02x" c)) + value "")))) ((and (or (memq c ttoken) ;; EXTENSION: Support non-ascii chars. (> c ?\177)) @@ -153,9 +155,10 @@ function fails in parsing of parameters." (t (error "Invalid header: %s" string))) (if number - (setq prev-attribute attribute - prev-value (concat prev-value value) - prev-encoded encoded) + (progn + (push (cons number value) vals) + (setq prev-attribute attribute + prev-encoded encoded)) (push (cons attribute (if encoded (rfc2231-decode-encoded-string value) @@ -164,10 +167,11 @@ function fails in parsing of parameters." ;; Take care of any final continuations. (when prev-attribute + (setq vals (mapconcat 'cdr (sort vals 'car-less-than-car) "")) (push (cons prev-attribute (if prev-encoded - (rfc2231-decode-encoded-string prev-value) - prev-value)) + (rfc2231-decode-encoded-string vals) + vals)) parameters))) (error (setq parameters nil) @@ -181,25 +185,27 @@ function fails in parsing of parameters." (defun rfc2231-decode-encoded-string (string) "Decode an RFC2231-encoded string. -These look like \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\"." - (with-temp-buffer - (let ((elems (split-string string "'"))) - ;; The encoded string may contain zero to two single-quote - ;; marks. This should give us the encoded word stripped - ;; of any preceding values. - (insert (car (last elems))) +These look like: + \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\", + \"us-ascii''This%20is%20%2A%2A%2Afun%2A%2A%2A\", + \"'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\", + \"''This%20is%20%2A%2A%2Afun%2A%2A%2A\", or + \"This is ***fun***\"." + (string-match "\\`\\(\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string) + (let ((coding-system (mm-charset-to-coding-system (match-string 2 string))) + ;;(language (match-string 3 string)) + (value (match-string 4 string))) + (mm-with-multibyte-buffer + (insert value) (goto-char (point-min)) (while (search-forward "%" nil t) (insert (prog1 (string-to-number (buffer-substring (point) (+ (point) 2)) 16) (delete-region (1- (point)) (+ (point) 2))))) - ;; Encode using the charset, if any. - (when (and (mm-multibyte-p) - (> (length elems) 1) - (not (equal (intern (downcase (car elems))) 'us-ascii))) - (mm-decode-coding-region (point-min) (point-max) - (intern (downcase (car elems))))) + ;; Decode using the charset, if any. + (unless (memq coding-system '(nil ascii)) + (mm-decode-coding-region (point-min) (point-max) coding-system)) (buffer-string)))) (defun rfc2231-encode-string (param value) @@ -263,12 +269,12 @@ the result of this function." (forward-line 1)))) (spacep (goto-char (point-min)) - (insert "\n " param "=\"") + (insert param "=\"") (goto-char (point-max)) (insert "\"")) (t (goto-char (point-min)) - (insert "\n " param "="))) + (insert param "="))) (buffer-string)))) (provide 'rfc2231) diff --git a/lisp/pgg-def.el b/lisp/pgg-def.el index 0b356461d6..058dca4fa8 100644 --- a/lisp/pgg-def.el +++ b/lisp/pgg-def.el @@ -83,6 +83,9 @@ Whether the passphrase is cached at all is controlled by (defvar pgg-scheme nil "Current scheme of PGP implementation.") +(defvar pgg-text-mode nil + "If t, inform the recipient that the input is text.") + (defmacro pgg-truncate-key-identifier (key) `(if (> (length ,key) 8) (substring ,key 8) ,key)) diff --git a/lisp/pgg-gpg.el b/lisp/pgg-gpg.el index be9b8bf9e7..0c9f45ab5b 100644 --- a/lisp/pgg-gpg.el +++ b/lisp/pgg-gpg.el @@ -87,7 +87,9 @@ (buffer-disable-undo) (erase-buffer) (if (file-exists-p output-file-name) - (let ((coding-system-for-read 'raw-text-dos)) + (let ((coding-system-for-read (if pgg-text-mode + 'raw-text + 'binary))) (insert-file-contents output-file-name))) (set-buffer errors-buffer) (if (not (equal exit-status 0)) @@ -187,7 +189,8 @@ passphrase cache or user." pgg-gpg-user-id)))) (args (append - (list "--batch" "--textmode" "--armor" "--always-trust" "--encrypt") + (list "--batch" "--armor" "--always-trust" "--encrypt") + (if pgg-text-mode (list "--textmode")) (if sign (list "--sign" "--local-user" pgg-gpg-user-id)) (if recipients (apply #'nconc @@ -196,8 +199,7 @@ passphrase cache or user." (append recipients (if pgg-encrypt-for-me (list pgg-gpg-user-id))))))))) - (pgg-as-lbt start end 'CRLF - (pgg-gpg-process-region start end passphrase pgg-gpg-program args)) + (pgg-gpg-process-region start end passphrase pgg-gpg-program args) (when sign (with-current-buffer pgg-errors-buffer ;; Possibly cache passphrase under, e.g. "jas", for future sign. @@ -215,9 +217,9 @@ passphrase cache or user." (pgg-read-passphrase "GnuPG passphrase for symmetric encryption: "))) (args - (append (list "--batch" "--textmode" "--armor" "--symmetric" )))) - (pgg-as-lbt start end 'CRLF - (pgg-gpg-process-region start end passphrase pgg-gpg-program args)) + (append (list "--batch" "--armor" "--symmetric" ) + (if pgg-text-mode (list "--textmode"))))) + (pgg-gpg-process-region start end passphrase pgg-gpg-program args) (pgg-process-when-success))) (defun pgg-gpg-decrypt-region (start end &optional passphrase) @@ -279,13 +281,13 @@ passphrase cache or user." (format "GnuPG passphrase for %s: " pgg-gpg-user-id) pgg-gpg-user-id))) (args - (list (if cleartext "--clearsign" "--detach-sign") - "--armor" "--batch" "--verbose" - "--local-user" pgg-gpg-user-id)) + (append (list (if cleartext "--clearsign" "--detach-sign") + "--armor" "--batch" "--verbose" + "--local-user" pgg-gpg-user-id) + (if pgg-text-mode (list "--textmode")))) (inhibit-read-only t) buffer-read-only) - (pgg-as-lbt start end 'CRLF - (pgg-gpg-process-region start end passphrase pgg-gpg-program args)) + (pgg-gpg-process-region start end passphrase pgg-gpg-program args) (with-current-buffer pgg-errors-buffer ;; Possibly cache passphrase under, e.g. "jas", for future sign. (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id) -- cgit v1.2.3