Mercurial > emacs
changeset 87454:0cbc451989a7
Merge from gnus--devo--0
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-967
author | Miles Bader <miles@gnu.org> |
---|---|
date | Fri, 28 Dec 2007 22:26:31 +0000 |
parents | cdd30283527d |
children | 06f57a4af48c 56a72e2bd635 |
files | doc/misc/ChangeLog doc/misc/gnus.texi lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/gnus-draft.el lisp/gnus/gnus-registry.el lisp/gnus/message.el lisp/gnus/mm-decode.el lisp/gnus/mml-sec.el lisp/gnus/sieve-manage.el lisp/gnus/smime.el lisp/net/imap.el lisp/net/netrc.el |
diffstat | 13 files changed, 326 insertions(+), 53 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/misc/ChangeLog Fri Dec 28 22:26:14 2007 +0000 +++ b/doc/misc/ChangeLog Fri Dec 28 22:26:31 2007 +0000 @@ -1,3 +1,12 @@ +2007-12-29 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus.texi (Group Parameters): Reorder the text and add a note about + `gnus-parameters' near the beginning of the node. + +2007-12-29 IRIE Tetsuya <irie@t.email.ne.jp> (tiny change) + + * gnus.texi (Score File Editing): Fix function name. + 2007-12-23 Michael Albinus <michael.albinus@gmx.de> Sync with Tramp 2.1.12.
--- a/doc/misc/gnus.texi Fri Dec 28 22:26:14 2007 +0000 +++ b/doc/misc/gnus.texi Fri Dec 28 22:26:31 2007 +0000 @@ -2741,6 +2741,15 @@ @cindex group parameters The group parameters store information local to a particular group. + +Use the @kbd{G p} or the @kbd{G c} command to edit group parameters of a +group. (@kbd{G p} presents you with a Lisp-based interface, @kbd{G c} +presents you with a Customize-like interface. The latter helps avoid +silly Lisp errors.) You might also be interested in reading about topic +parameters (@pxref{Topic Parameters}). +Additionally, you can set group parameters via the +@code{gnus-parameters} variable, see below. + Here's an example group parameter list: @example @@ -3130,12 +3139,6 @@ @end table -Use the @kbd{G p} or the @kbd{G c} command to edit group parameters of a -group. (@kbd{G p} presents you with a Lisp-based interface, @kbd{G c} -presents you with a Customize-like interface. The latter helps avoid -silly Lisp errors.) You might also be interested in reading about topic -parameters (@pxref{Topic Parameters}). - @vindex gnus-parameters Group parameters can be set via the @code{gnus-parameters} variable too. But some variables, such as @code{visible}, have no effect (For this @@ -20962,9 +20965,9 @@ @item C-c C-c @kindex C-c C-c (Score) -@findex gnus-score-edit-done +@findex gnus-score-edit-exit Save the changes you have made and return to the summary buffer -(@code{gnus-score-edit-done}). +(@code{gnus-score-edit-exit}). @item C-c C-d @kindex C-c C-d (Score)
--- a/lisp/gnus/ChangeLog Fri Dec 28 22:26:14 2007 +0000 +++ b/lisp/gnus/ChangeLog Fri Dec 28 22:26:31 2007 +0000 @@ -1,3 +1,38 @@ +2007-12-28 Reiner Steib <Reiner.Steib@gmx.de> + + * message.el (message-send-mail-function): Increase custom version. + + * mml-sec.el, sieve-manage.el, smime.el: Simplify loading of + password-cache or password. Suggested by Glenn Morris <rgm@gnu.org>. + +2007-12-21 Teodor Zlatanov <tzz@lifelogs.com> + + * imap.el (imap-authenticate): Use current-buffer instead of buffer, + for the cases where imap-authenticate is called with a nil buffer + parameter. + +2007-12-19 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-browse-html-parts): Work for two or more + html parts correctly; support forwarded messages. + (gnus-article-browse-html-article): Remove work buffers. + + * netrc.el: Bind encrypt-file-alist for Emacs 21 and XEmacs when + compiling. + (netrc-bound-and-true-p): New macro. + (netrc-parse): Use it instead of bound-and-true-p that is not available + in XEmacs 21.4. + +2007-12-19 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-registry.el (gnus-registry-mark-article) + (gnus-registry-article-marks): Add functionality to mark articles + through the Gnus registry. + + * netrc.el: Autoload encrypt when encrypt-file-alist is set. + (netrc-parse): Use encrypt-file-alist to determine if + encrypt-find-model or encrypt-insert-file-contents should be used. + 2007-12-19 Glenn Morris <rgm@gnu.org> * mml.el (message-options-set, message-narrow-to-head) @@ -9,6 +44,24 @@ (message-options-set-recipient, message-generate-headers) (message-sort-headers): Declare as functions. +2007-12-18 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-draft.el (gnus-draft-send-message): Mention process/prefix + convention in doc string. + +2007-12-17 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-browse-html-parts): Add message header and + title to html parts. + (gnus-article-browse-html-article): Pass message header to it. + + * mm-decode.el (mm-display-external): Use mm-add-meta-html-tag. + +2007-12-16 Reiner Steib <Reiner.Steib@gmx.de> + + * mml-sec.el, sieve-manage.el, smime.el: Make loading of password-cache + or password compatible with XEmacs. + 2007-12-15 Reiner Steib <Reiner.Steib@gmx.de> * gnus-art.el (article-verify-x-pgp-sig): Add reference to X-PGP-Sig @@ -261,6 +314,12 @@ * message.el (message-ignored-supersedes-headers): Add "X-ID". +2007-12-03 Nathan J. Williams <nathanw@MIT.EDU> (tiny change) + + * imap.el (imap-mailbox-status-asynch): Upcase STATUS items. + (imap-parse-status): Upcase status-att for servers that sends them + lower-case (e.g., MS Exchange 2007). + 2007-12-03 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-sum.el (gnus-uu-extract-map): Add a command for the yenc
--- a/lisp/gnus/gnus-art.el Fri Dec 28 22:26:14 2007 +0000 +++ b/lisp/gnus/gnus-art.el Fri Dec 28 22:26:31 2007 +0000 @@ -2798,9 +2798,10 @@ (setq gnus-article-browse-html-temp-list nil)) gnus-article-browse-html-temp-list) -(defun gnus-article-browse-html-parts (list) +(defun gnus-article-browse-html-parts (list &optional header) "View all \"text/html\" parts from LIST. -Recurse into multiparts." +Recurse into multiparts. The optional HEADER that should be a decoded +message header will be added to the bodies of the \"text/html\" parts." ;; Internal function used by `gnus-article-browse-html-article'. (let (type file charset tmp-file showed) ;; Find and show the html-parts. @@ -2809,10 +2810,11 @@ (cond ((not (listp handle))) ((or (equal (car (setq type (mm-handle-type handle))) "text/html") (and (equal (car type) "message/external-body") - (setq file (or (mail-content-type-get type 'name) - (mail-content-type-get - (mm-handle-disposition handle) - 'filename))) + (or header + (setq file (or (mail-content-type-get type 'name) + (mail-content-type-get + (mm-handle-disposition handle) + 'filename)))) (or (mm-handle-cache handle) (condition-case code (progn (mm-extern-cache-contents handle) t) @@ -2825,24 +2827,111 @@ type (mm-handle-type handle)) (equal (car type) "text/html")))) (when (or (setq charset (mail-content-type-get type 'charset)) + header (not file)) (setq tmp-file (mm-make-temp-file ;; Do we need to care for 8.3 filenames? "mm-" nil ".html"))) - (if charset - ;; Add a meta html tag to specify charset. - (mm-with-unibyte-buffer - (insert (if (eq charset 'gnus-decoded) - (mm-encode-coding-string (mm-get-part handle) - (setq charset 'utf-8)) - (mm-get-part handle))) - (if (or (mm-add-meta-html-tag handle charset) - (not file)) - (mm-write-region (point-min) (point-max) - tmp-file nil nil nil 'binary t) - (setq tmp-file nil))) - (when tmp-file - (mm-save-part-to-file handle tmp-file))) + ;; Add a meta html tag to specify charset and a header. + (cond + (header + (let (title eheader body hcharset coding) + (with-temp-buffer + (mm-enable-multibyte) + (setq case-fold-search t) + (insert header "\n") + (setq title (message-fetch-field "subject")) + (goto-char (point-min)) + (while (re-search-forward "\\(<\\)\\|\\(>\\)\\|&" nil t) + (replace-match (cond ((match-beginning 1) "<") + ((match-beginning 2) ">") + (t "&")))) + (goto-char (point-min)) + (insert "<pre>\n") + (goto-char (point-max)) + (insert "</pre>\n<hr>\n") + ;; We have to examine charset one by one since + ;; charset specified in parts might be different. + (if (eq charset 'gnus-decoded) + (setq charset 'utf-8 + eheader (mm-encode-coding-string (buffer-string) + charset) + title (when title + (mm-encode-coding-string title charset)) + body (mm-encode-coding-string (mm-get-part handle) + charset)) + (setq hcharset (mm-find-mime-charset-region (point-min) + (point-max))) + (cond ((= (length hcharset) 1) + (setq hcharset (car hcharset) + coding (mm-charset-to-coding-system + hcharset))) + ((> (length hcharset) 1) + (setq hcharset 'utf-8 + coding hcharset))) + (if coding + (if charset + (progn + (setq body + (mm-charset-to-coding-system charset)) + (if (eq coding body) + (setq eheader (mm-encode-coding-string + (buffer-string) coding) + title (when title + (mm-encode-coding-string + title coding)) + body (mm-get-part handle)) + (setq charset 'utf-8 + eheader (mm-encode-coding-string + (buffer-string) charset) + title (when title + (mm-encode-coding-string + title charset)) + body (mm-encode-coding-string + (mm-decode-coding-string + (mm-get-part handle) body) + charset)))) + (setq charset hcharset + eheader (mm-encode-coding-string + (buffer-string) coding) + title (when title + (mm-encode-coding-string + title coding)) + body (mm-get-part handle))) + (setq eheader (mm-string-as-unibyte (buffer-string)) + body (mm-get-part handle)))) + (erase-buffer) + (mm-disable-multibyte) + (insert body) + (when charset + (mm-add-meta-html-tag handle charset)) + (when title + (goto-char (point-min)) + (unless (search-forward "<title>" nil t) + (re-search-forward "<head>\\s-*" nil t) + (insert "<title>" title "</title>\n"))) + (goto-char (point-min)) + (or (re-search-forward + "<body\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t) + (re-search-forward + "</head\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t)) + (insert eheader) + (mm-write-region (point-min) (point-max) + tmp-file nil nil nil 'binary t)))) + (charset + (mm-with-unibyte-buffer + (insert (if (eq charset 'gnus-decoded) + (mm-encode-coding-string + (mm-get-part handle) + (setq charset 'utf-8)) + (mm-get-part handle))) + (if (or (mm-add-meta-html-tag handle charset) + (not file)) + (mm-write-region (point-min) (point-max) + tmp-file nil nil nil 'binary t) + (setq tmp-file nil)))) + (tmp-file + (mm-save-part-to-file handle tmp-file))) (when tmp-file (add-to-list 'gnus-article-browse-html-temp-list tmp-file)) (add-hook 'gnus-summary-prepare-exit-hook @@ -2854,16 +2943,37 @@ (browse-url-of-file (or tmp-file (expand-file-name file))) (setq showed t)) ;; If multipart, recurse - ((and (stringp (car handle)) - (string-match "^multipart/" (car handle)) - (setq showed - (or showed - (gnus-article-browse-html-parts handle))))))) + ((equal (mm-handle-media-supertype handle) "multipart") + (when (gnus-article-browse-html-parts handle header) + (setq showed t))) + ((equal (mm-handle-media-type handle) "message/rfc822") + (mm-with-multibyte-buffer + (mm-insert-part handle) + (setq handle (mm-dissect-buffer t t)) + (when (and (bufferp (car handle)) + (stringp (car (mm-handle-type handle)))) + (setq handle (list handle))) + (when header + (article-decode-encoded-words) + (let ((gnus-visible-headers + (or (get 'gnus-visible-headers 'standard-value) + gnus-visible-headers))) + (article-hide-headers)) + (goto-char (point-min)) + (search-forward "\n\n" nil 'move) + (skip-chars-backward "\t\n ") + (setq header (buffer-substring (point-min) (point))))) + (when (prog1 + (gnus-article-browse-html-parts handle header) + (mm-destroy-parts handle)) + (setq showed t))))) showed)) ;; FIXME: Documentation in texi/gnus.texi missing. -(defun gnus-article-browse-html-article () +(defun gnus-article-browse-html-article (&optional arg) "View \"text/html\" parts of the current article with a WWW browser. +The message header is added to the beginning of every html part unless +the prefix argument ARG is given. Warning: Spammers use links to images in HTML articles to verify whether you have read the message. As @@ -2874,20 +2984,36 @@ If you alwasy want to display HTML part in the browser, set `mm-text-html-renderer' to nil." ;; Cf. `mm-w3m-safe-url-regexp' - (interactive) - (save-window-excursion - ;; Open raw article and select the buffer - (gnus-summary-show-article t) - (gnus-summary-select-article-buffer) - (let ((parts (mm-dissect-buffer t t))) + (interactive "P") + (if arg + (gnus-summary-show-article) + (let ((gnus-visible-headers (or (get 'gnus-visible-headers 'standard-value) + gnus-visible-headers))) + (gnus-summary-show-article))) + (with-current-buffer gnus-article-buffer + (let ((header (unless arg + (save-restriction + (widen) + (buffer-substring-no-properties + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (match-beginning 0) + (goto-char (point-max)) + (skip-chars-backward "\t\n ") + (point)))))) + parts) + (set-buffer gnus-original-article-buffer) + (setq parts (mm-dissect-buffer t t)) ;; If singlepart, enforce a list. (when (and (bufferp (car parts)) (stringp (car (mm-handle-type parts)))) (setq parts (list parts))) ;; Process the list - (unless (gnus-article-browse-html-parts parts) + (unless (gnus-article-browse-html-parts parts header) (gnus-error 3 "Mail doesn't contain a \"text/html\" part!")) - (gnus-summary-show-article)))) + (mm-destroy-parts parts) + (unless arg + (gnus-summary-show-article))))) (defun article-hide-list-identifiers () "Remove list identifies from the Subject header.
--- a/lisp/gnus/gnus-draft.el Fri Dec 28 22:26:14 2007 +0000 +++ b/lisp/gnus/gnus-draft.el Fri Dec 28 22:26:31 2007 +0000 @@ -119,7 +119,8 @@ message-send-actions))) (defun gnus-draft-send-message (&optional n) - "Send the current draft." + "Send the current draft(s). +Obeys the standard process/prefix convention." (interactive "P") (let* ((articles (gnus-summary-work-articles n)) (total (length articles))
--- a/lisp/gnus/gnus-registry.el Fri Dec 28 22:26:14 2007 +0000 +++ b/lisp/gnus/gnus-registry.el Fri Dec 28 22:26:31 2007 +0000 @@ -586,6 +586,54 @@ (string-match word x)) list))))) +(defun gnus-registry-mark-article (article &optional mark remove) + "Mark ARTICLE with MARK in the Gnus registry or remove MARK. +MARK can be any symbol. If ARTICLE is nil, then the +`gnus-current-article' will be marked. If MARK is nil, +`gnus-registry-flag-default' will be used." + (interactive "nArticle number: ") + (let ((article (or article gnus-current-article)) + (mark (or mark 'gnus-registry-flag-default)) + article-id) + (unless article + (error "No article on current line")) + (setq article-id + (gnus-registry-fetch-message-id-fast gnus-current-article)) + (unless article-id + (error "No article ID could be retrieved")) + (let* ( + ;; all the marks for this article + (marks (gnus-registry-fetch-extra-flags article-id)) + ;; the marks without the mark of interest + (cleaned-marks (delq mark marks)) + ;; the new marks we want to use + (new-marks (if remove + cleaned-marks + (cons mark cleaned-marks)))) + (apply 'gnus-registry-store-extra-flags ; set the extra flags + article-id ; for the message ID + new-marks) + (gnus-registry-fetch-extra-flags article-id)))) + +(defun gnus-registry-article-marks (article) + "Get the Gnus registry marks for ARTICLE. +If ARTICLE is nil, then the `gnus-current-article' will be +used." + (interactive "nArticle number: ") + (let ((article (or article gnus-current-article)) + article-id) + (unless article + (error "No article on current line")) + (setq article-id + (gnus-registry-fetch-message-id-fast gnus-current-article)) + (unless article-id + (error "No article ID could be retrieved")) + (gnus-message 1 + "Message ID %s, Registry flags: %s" + article-id + (concat (gnus-registry-fetch-extra-flags article-id))))) + + ;;; if this extends to more than 'flags, it should be improved to be more generic. (defun gnus-registry-fetch-extra-flags (id) "Get the flags of a message, based on the message ID.
--- a/lisp/gnus/message.el Fri Dec 28 22:26:14 2007 +0000 +++ b/lisp/gnus/message.el Fri Dec 28 22:26:31 2007 +0000 @@ -666,6 +666,7 @@ :tag "Use Mailclient package") (function :tag "Other")) :group 'message-sending + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :link '(custom-manual "(message)Mail Variables") :group 'message-mail)
--- a/lisp/gnus/mm-decode.el Fri Dec 28 22:26:14 2007 +0000 +++ b/lisp/gnus/mm-decode.el Fri Dec 28 22:26:31 2007 +0000 @@ -751,6 +751,7 @@ (set-buffer (generate-new-buffer " *mm*")) (setq method nil)) (mm-insert-part handle) + (mm-add-meta-html-tag handle) (let ((win (get-buffer-window cur t))) (when win (select-window win))) @@ -774,6 +775,7 @@ (mm-handle-set-undisplayer handle mm))))) ;; The function is a string to be executed. (mm-insert-part handle) + (mm-add-meta-html-tag handle) (let* ((dir (mm-make-temp-file (expand-file-name "emm." mm-tmp-directory) 'dir)) (filename (or
--- a/lisp/gnus/mml-sec.el Fri Dec 28 22:26:14 2007 +0000 +++ b/lisp/gnus/mml-sec.el Fri Dec 28 22:26:31 2007 +0000 @@ -27,8 +27,10 @@ ;;; Code: (eval-when-compile (require 'cl)) -(or (require 'password-cache nil t) - (require 'password)) + +(if (locate-library "password-cache") + (require 'password-cache) + (require 'password)) (autoload 'mml2015-sign "mml2015") (autoload 'mml2015-encrypt "mml2015")
--- a/lisp/gnus/sieve-manage.el Fri Dec 28 22:26:14 2007 +0000 +++ b/lisp/gnus/sieve-manage.el Fri Dec 28 22:26:31 2007 +0000 @@ -79,8 +79,11 @@ ;; For Emacs < 22.2. (eval-and-compile (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) -(or (require 'password-cache nil t) - (require 'password)) + +(if (locate-library "password-cache") + (require 'password-cache) + (require 'password)) + (eval-when-compile (require 'sasl) (require 'starttls))
--- a/lisp/gnus/smime.el Fri Dec 28 22:26:14 2007 +0000 +++ b/lisp/gnus/smime.el Fri Dec 28 22:26:31 2007 +0000 @@ -125,8 +125,11 @@ (eval-and-compile (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (require 'dig) -(or (require 'password-cache nil t) - (require 'password)) + +(if (locate-library "password-cache") + (require 'password-cache) + (require 'password)) + (eval-when-compile (require 'cl)) (eval-and-compile
--- a/lisp/net/imap.el Fri Dec 28 22:26:14 2007 +0000 +++ b/lisp/net/imap.el Fri Dec 28 22:26:31 2007 +0000 @@ -1177,18 +1177,18 @@ (if passwd (setq imap-password passwd)) (if imap-auth (and (funcall (nth 2 (assq imap-auth - imap-authenticator-alist)) buffer) + imap-authenticator-alist)) (current-buffer)) (setq imap-state 'auth)) ;; Choose authenticator. (let ((auths imap-authenticators) auth) (while (setq auth (pop auths)) ;; OK to use authenticator? - (when (funcall (nth 1 (assq auth imap-authenticator-alist)) buffer) + (when (funcall (nth 1 (assq auth imap-authenticator-alist)) (current-buffer)) (message "imap: Authenticating to `%s' using `%s'..." imap-server auth) (setq imap-auth auth) - (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer) + (if (funcall (nth 2 (assq auth imap-authenticator-alist)) (current-buffer)) (progn (message "imap: Authenticating to `%s' using `%s'...done" imap-server auth)
--- a/lisp/net/netrc.el Fri Dec 28 22:26:14 2007 +0000 +++ b/lisp/net/netrc.el Fri Dec 28 22:26:31 2007 +0000 @@ -35,10 +35,22 @@ ;;; .netrc and .authinfo rc parsing ;;; +;; use encrypt if loaded (encrypt-file-alist has to be set as well) +(eval-and-compile + (autoload 'encrypt-find-model "encrypt") + (autoload 'encrypt-insert-file-contents "encrypt")) (defalias 'netrc-point-at-eol (if (fboundp 'point-at-eol) 'point-at-eol 'line-end-position)) +(eval-when-compile + (defvar encrypt-file-alist) + ;; This is unnecessary in the compiled version as it is a macro. + (if (fboundp 'bound-and-true-p) + (defalias 'netrc-bound-and-true-p 'bound-and-true-p) + (defmacro netrc-bound-and-true-p (var) + "Return the value of symbol VAR if it is bound, else nil." + `(and (boundp (quote ,var)) ,var)))) (defgroup netrc nil "Netrc configuration." @@ -55,8 +67,12 @@ (let ((tokens '("machine" "default" "login" "password" "account" "macdef" "force" "port")) + (encryption-model (when (netrc-bound-and-true-p encrypt-file-alist) + (encrypt-find-model file))) alist elem result pair) - (insert-file-contents file) + (if encryption-model + (encrypt-insert-file-contents file encryption-model) + (insert-file-contents file)) (goto-char (point-min)) ;; Go through the file, line by line. (while (not (eobp))