From: yamaoka Date: Thu, 13 Oct 2005 22:08:34 +0000 (+0000) Subject: Synch to No Gnus 200510131948. X-Git-Tag: t-gnus-6_17_4-quimby-~303 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=ac3b087c73a63e271e40a8e134a345463323e292;p=elisp%2Fgnus.git- Synch to No Gnus 200510131948. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dbb5caa..ba8db63 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,26 @@ 2005-10-13 Reiner Steib + * mml-sec.el (mml-secure-method): New internal variable. + (mml-secure-sign, mml-secure-encrypt, mml-secure-message-sign) + (mml-secure-message-sign-encrypt, mml-secure-message-encrypt): New + functions using mml-secure-method. + + * mml.el (mml-mode-map): Add key bindings for those functions. + (mml-menu): Simplify security menu entries. Suggested by Jesper + Harder . + (mml-attach-file, mml-attach-buffer, mml-attach-external): Goto + end of message if point is the headers of the message. + + * message.el (message-in-body-p): New function. + + * assistant.el: Autoload gnus-util and netrc. + + * mm-util.el (mm-charset-to-coding-system): Add allow-override. + Use `mm-charset-override-alist' only when decoding. + + * mm-bodies.el (mm-decode-body): Call + `mm-charset-to-coding-system' with allow-override argument. + * gnus-art.el (gnus-mime-view-part-as-type-internal): Try to fetch `filename' from Content-Disposition if Content-Type doesn't provide `name'. diff --git a/lisp/assistant.el b/lisp/assistant.el index 2a99421..f1e0e60 100644 --- a/lisp/assistant.el +++ b/lisp/assistant.el @@ -31,6 +31,11 @@ (require 'widget) (require 'wid-edit) +(autoload 'gnus-error "gnus-util") +(autoload 'netrc-get "netrc") +(autoload 'netrc-machine "netrc") +(autoload 'netrc-parse "netrc") + (defvar assistant-readers '(("variable" assistant-variable-reader) ("validate" assistant-sexp-reader) diff --git a/lisp/message.el b/lisp/message.el index bf8dd17..9f2d7b3 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -2989,6 +2989,11 @@ the address is inserted by default." (message-goto-body) (forward-line -1)) +(defun message-in-body-p () + "Return t if point is in the message body." + (let ((body (save-excursion (message-goto-body) (point)))) + (>= (point) body))) + (defun message-goto-signature () "Move point to the beginning of the message signature. If there is no signature in the article, go to the end and diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 5f1c93b..b91a774 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -247,7 +247,10 @@ decoding. If it is nil, default to `mail-parse-charset'." (when encoding (mm-decode-content-transfer-encoding encoding type)) (when (featurep 'mule) ; Fixme: Wrong test for unibyte session. - (let ((coding-system (mm-charset-to-coding-system charset))) + (let ((coding-system (mm-charset-to-coding-system + ;; Allow overwrite using + ;; `mm-charset-override-alist'. + charset nil t))) (if (and (not coding-system) (listp mail-parse-ignored-charsets) (memq 'gnus-unknown mail-parse-ignored-charsets)) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 512cf28..543fdf7 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -491,11 +491,17 @@ mail with multiple parts is preferred to sending a Unicode one.") (pop alist)) out))) -(defun mm-charset-to-coding-system (charset &optional lbt) +(defun mm-charset-to-coding-system (charset &optional lbt + allow-override) "Return coding-system corresponding to CHARSET. CHARSET is a symbol naming a MIME charset. If optional argument LBT (`unix', `dos' or `mac') is specified, it is -used as the line break code type of the coding system." +used as the line break code type of the coding system. + +If ALLOW-OVERRIDE is given, use `mm-charset-override-alist' to +map undesired charset names to their replacement. This should +only be used for decoding, not for encoding." + ;; OVERRIDE is used (only) in `mm-decode-body'. (when (stringp charset) (setq charset (intern (downcase charset)))) (when lbt @@ -507,9 +513,11 @@ used as the line break code type of the coding system." ((or (null (mm-get-coding-system-list)) (not (fboundp 'coding-system-get))) charset) - ;; Check override list quite early: - ((let ((cs (cdr (assq charset mm-charset-override-alist)))) - (and cs (mm-coding-system-p cs) cs))) + ;; Check override list quite early. Should only used for decoding, not for + ;; encoding! + ((and allow-override + (let ((cs (cdr (assq charset mm-charset-override-alist)))) + (and cs (mm-coding-system-p cs) cs)))) ;; ascii ((eq charset 'us-ascii) 'ascii) diff --git a/lisp/mml-sec.el b/lisp/mml-sec.el index 904f07d..d3511dd 100644 --- a/lisp/mml-sec.el +++ b/lisp/mml-sec.el @@ -188,6 +188,29 @@ You can also customize or set `mml-signencrypt-style-alist' instead." (cons method tags)))) (t (error "The message is corrupted. No mail header separator")))))) +(defvar mml-secure-method + (if (equal mml-default-encrypt-method mml-default-sign-method) + mml-default-sign-method + "pgpmime") + "Current security method. Internal variable.") + +(defun mml-secure-sign (&optional method) + "Add MML tags to sign this MML part. +Use METHOD if given. Else use `mml-secure-method' or +`mml-default-sign-method'." + (interactive) + (mml-secure-part + (or method mml-secure-method mml-default-sign-method) + 'sign)) + +(defun mml-secure-encrypt (&optional method) + "Add MML tags to encrypt this MML part. +Use METHOD if given. Else use `mml-secure-method' or +`mml-default-sign-method'." + (interactive) + (mml-secure-part + (or method mml-secure-method mml-default-sign-method))) + (defun mml-secure-sign-pgp () "Add MML tags to PGP sign this MML part." (interactive) @@ -256,6 +279,34 @@ You can also customize or set `mml-signencrypt-style-alist' instead." (when (re-search-backward "^<#secure.*>\n" nil t) (delete-region (match-beginning 0) (match-end 0))))) + +(defun mml-secure-message-sign (&optional method) + "Add MML tags to sign this MML part. +Use METHOD if given. Else use `mml-secure-method' or +`mml-default-sign-method'." + (interactive) + (mml-secure-part + (or method mml-secure-method mml-default-sign-method) + 'sign)) + +(defun mml-secure-message-sign-encrypt (&optional method) + "Add MML tag to sign and encrypt the entire message. +Use METHOD if given. Else use `mml-secure-method' or +`mml-default-sign-method'." + (interactive) + (mml-secure-message + (or method mml-secure-method mml-default-sign-method) + 'signencrypt)) + +(defun mml-secure-message-encrypt (&optional method) + "Add MML tag to encrypt the entire message. +Use METHOD if given. Else use `mml-secure-method' or +`mml-default-sign-method'." + (interactive) + (mml-secure-message + (or method mml-secure-method mml-default-sign-method) + 'encrypt)) + (defun mml-secure-message-sign-smime () "Add MML tag to encrypt/sign the entire message." (interactive) diff --git a/lisp/mml.el b/lisp/mml.el index d24d030..d4d4b69 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -870,6 +870,11 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (encryptpart (make-sparse-keymap)) (map (make-sparse-keymap)) (main (make-sparse-keymap))) + (define-key map "\C-s" 'mml-secure-message-sign) + (define-key map "\C-c" 'mml-secure-message-encrypt) + (define-key map "\C-e" 'mml-secure-message-sign-encrypt) + (define-key map "\C-p\C-s" 'mml-secure-sign) + (define-key map "\C-p\C-c" 'mml-secure-encrypt) (define-key sign "p" 'mml-secure-message-sign-pgpmime) (define-key sign "o" 'mml-secure-message-sign-pgp) (define-key sign "s" 'mml-secure-message-sign-smime) @@ -907,26 +912,51 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ["Attach File..." mml-attach-file ,@(if (featurep 'xemacs) '(t) '(:help "Attach a file at point"))] - ["Attach Buffer..." mml-attach-buffer t] - ["Attach External..." mml-attach-external t] - ["Insert Part..." mml-insert-part t] - ["Insert Multipart..." mml-insert-multipart t] - ["PGP/MIME Sign" mml-secure-message-sign-pgpmime t] - ["PGP/MIME Encrypt" mml-secure-message-encrypt-pgpmime t] - ["PGP Sign" mml-secure-message-sign-pgp t] - ["PGP Encrypt" mml-secure-message-encrypt-pgp t] - ["S/MIME Sign" mml-secure-message-sign-smime t] - ["S/MIME Encrypt" mml-secure-message-encrypt-smime t] - ("Secure MIME part" - ["PGP/MIME Sign Part" mml-secure-sign-pgpmime t] - ["PGP/MIME Encrypt Part" mml-secure-encrypt-pgpmime t] - ["PGP Sign Part" mml-secure-sign-pgp t] - ["PGP Encrypt Part" mml-secure-encrypt-pgp t] - ["S/MIME Sign Part" mml-secure-sign-smime t] - ["S/MIME Encrypt Part" mml-secure-encrypt-smime t]) - ["Encrypt/Sign off" mml-unsecure-message t] + ["Attach Buffer..." mml-attach-buffer + ,@(if (featurep 'xemacs) '(t) + '(:help "Attach a buffer to the outgoing MIME message"))] + ["Attach External..." mml-attach-external + ,@(if (featurep 'xemacs) '(t) + '(:help "Attach reference to file"))] + ;; + ("Change Security Method" + ["PGP/MIME" + (lambda () (interactive) (setq mml-secure-method "pgpmime")) + ,@(if (featurep 'xemacs) nil + '(:help "Set Security Method to PGP/MIME")) + :style radio + :selected (equal mml-secure-method "pgpmime") ] + ["S/MIME" + (lambda () (interactive) (setq mml-secure-method "smime")) + ,@(if (featurep 'xemacs) nil + '(:help "Set Security Method to S/MIME")) + :style radio + :selected (equal mml-secure-method "smime") ] + ["Inline PGP" + (lambda () (interactive) (setq mml-secure-method "pgp")) + ,@(if (featurep 'xemacs) nil + '(:help "Set Security Method to inline PGP")) + :style radio + :selected (equal mml-secure-method "pgp") ] ) + ;; + ["Sign Message" mml-secure-message-sign t] + ["Encrypt Message" mml-secure-message-encrypt t] + ["Sign and Encrypt Message" mml-secure-message-sign-encrypt t] + ["Encrypt/Sign off" mml-unsecure-message + ,@(if (featurep 'xemacs) '(t) + '(:help "Don't Encrypt/Sign Message"))] + ;; Maybe we could remove these, because people who write MML most probably + ;; don't use the menu: + ["Insert Part..." mml-insert-part + :active (message-in-body-p)] + ["Insert Multipart..." mml-insert-multipart + :active (message-in-body-p)] + ;; + ;; Do we have separate encrypt and encrypt/sign commands for parts? + ["Sign Part" mml-secure-sign t] + ["Encrypt Part" mml-secure-encrypt t] ;;["Narrow" mml-narrow-to-part t] - ["Quote MML" mml-quote-region + ["Quote MML in region" mml-quote-region :active (message-mark-active-p) ,@(if (featurep 'xemacs) nil '(:help "Quote MML tags in region"))] @@ -1093,11 +1123,13 @@ description of the attachment." (description (mml-minibuffer-read-description)) (disposition (mml-minibuffer-read-disposition type))) (list file type description disposition))) - (mml-insert-empty-tag 'part - 'type type - 'filename file - 'disposition (or disposition "attachment") - 'description description)) + (save-excursion + (unless (message-in-body-p) (goto-char (point-max))) + (mml-insert-empty-tag 'part + 'type type + 'filename file + 'disposition (or disposition "attachment") + 'description description))) (defun mml-dnd-attach-file (uri action) "Attach a drag and drop file. @@ -1131,8 +1163,11 @@ See `mml-attach-file' for details of operation." (type (mml-minibuffer-read-type buffer "text/plain")) (description (mml-minibuffer-read-description))) (list buffer type description))) - (mml-insert-empty-tag 'part 'type type 'buffer buffer - 'disposition "attachment" 'description description)) + (save-excursion + (unless (message-in-body-p) (goto-char (point-max))) + (mml-insert-empty-tag 'part 'type type 'buffer buffer + 'disposition "attachment" + 'description description))) (defun mml-attach-external (file &optional type description) "Attach an external file into the buffer. @@ -1143,8 +1178,10 @@ TYPE is the MIME type to use." (type (mml-minibuffer-read-type file)) (description (mml-minibuffer-read-description))) (list file type description))) - (mml-insert-empty-tag 'external 'type type 'name file - 'disposition "attachment" 'description description)) + (save-excursion + (unless (message-in-body-p) (goto-char (point-max))) + (mml-insert-empty-tag 'external 'type type 'name file + 'disposition "attachment" 'description description))) (defun mml-insert-multipart (&optional type) (interactive (list (completing-read "Multipart type (default mixed): "