# HG changeset patch # User Miles Bader # Date 1197779493 0 # Node ID b968c7f9a8b432d78cdade9ec6a1557a7ba3e6d2 # Parent a524d1739a14481f8250286569323816c143ccf3 Merge from gnus--devo--0 Revision: emacs@sv.gnu.org/emacs--devo--0--patch-955 diff -r a524d1739a14 -r b968c7f9a8b4 doc/misc/ChangeLog --- a/doc/misc/ChangeLog Sat Dec 15 11:37:25 2007 +0000 +++ b/doc/misc/ChangeLog Sun Dec 16 04:31:33 2007 +0000 @@ -1,3 +1,7 @@ +2007-12-14 Sven Joachim + + * gnus.texi (Score Variables): Fix typo. + 2007-12-07 Michael Albinus * dbus.texi (Synchronous Methods): Adapt dbus-call-method. diff -r a524d1739a14 -r b968c7f9a8b4 doc/misc/gnus.texi --- a/doc/misc/gnus.texi Sat Dec 15 11:37:25 2007 +0000 +++ b/doc/misc/gnus.texi Sun Dec 16 04:31:33 2007 +0000 @@ -20529,7 +20529,7 @@ @vindex gnus-score-uncacheable-files @cindex score cache All score files are normally cached to avoid excessive re-loading of -score files. However, if this might make your Emacs grow big and +score files. However, this might make your Emacs grow big and bloated, so this regexp can be used to weed out score files unlikely to be needed again. It would be a bad idea to deny caching of @file{all.SCORE}, while it might be a good idea to not cache diff -r a524d1739a14 -r b968c7f9a8b4 lisp/ChangeLog --- a/lisp/ChangeLog Sat Dec 15 11:37:25 2007 +0000 +++ b/lisp/ChangeLog Sun Dec 16 04:31:33 2007 +0000 @@ -18,6 +18,10 @@ * calc/calc.el (calc-set-mode-line): Use `math-lang-name' to set language name. +2007-12-10 Katsumi Yamaoka + + * pgg.el (pgg-run-at-time, pgg-cancel-timer): Use eval-and-compile. + 2007-12-10 Stefan Monnier * server.el (server-select-display): Fix important typo. diff -r a524d1739a14 -r b968c7f9a8b4 lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Sat Dec 15 11:37:25 2007 +0000 +++ b/lisp/gnus/ChangeLog Sun Dec 16 04:31:33 2007 +0000 @@ -1,3 +1,38 @@ +2007-12-15 Reiner Steib + + * gnus-art.el (article-verify-x-pgp-sig): Add reference to X-PGP-Sig + format document. + (gnus-mime-delete-part): Don't write description line if empty. + (gnus-article-encrypt-body): Add confirmation for gnus-novice-user. + +2007-12-14 Johan Bockg,Ae(Brd + + * gnus-sum.el (gnus-summary-mark-unread-as-read) + (gnus-summary-mark-read-and-unread-as-read) + (gnus-summary-mark-current-read-and-unread-as-read) + (gnus-summary-mark-unread-as-ticked): Doc fix. + `gnus-mark-article-hook', not `gnus-summary-mark-article-hook'. + +2007-12-14 Reiner Steib + + * gnus-sum.el (gnus-summary-prev-article): Fix doc string. Reported by + Christoph Conrad . + +2007-12-14 Reiner Steib + + * gnus-util.el (gnus-y-or-n-p, gnus-yes-or-no-p): Alias to y-or-n-p and + yes-or-no-p. + +2007-12-11 Katsumi Yamaoka + + * mm-decode.el (mm-add-meta-html-tag): New function. + (mm-save-part-to-file, mm-pipe-part): Use it + + * gnus-art.el (gnus-article-browse-delete-temp-files): Use + gnus-y-or-n-p instead of y-or-n-p. + (gnus-article-browse-html-parts): Work with message/external-body; use + mm-add-meta-html-tag. + 2007-12-11 Glenn Morris * gnus-cache.el: Require gnus-sum not just when compiling. @@ -74,6 +109,10 @@ * spam.el (gnus-extract-address-components): Declare as functions. +2007-12-10 Katsumi Yamaoka + + * gnus-art.el (gnus-article-browse-html-parts): Decode CTE. + 2007-12-09 Glenn Morris * gnus-uu.el (gnus-uu-yenc-article): Use insert-buffer-substring. diff -r a524d1739a14 -r b968c7f9a8b4 lisp/gnus/gnus-art.el --- a/lisp/gnus/gnus-art.el Sat Dec 15 11:37:25 2007 +0000 +++ b/lisp/gnus/gnus-art.el Sun Dec 16 04:31:33 2007 +0000 @@ -2782,9 +2782,9 @@ (or how (setq how gnus-article-browse-delete-temp))) (when (and (eq how 'ask) - (y-or-n-p (format - "Delete all %s temporary HTML file(s)? " - (length gnus-article-browse-html-temp-list))) + (gnus-y-or-n-p (format + "Delete all %s temporary HTML file(s)? " + (length gnus-article-browse-html-temp-list))) (setq how t))) (dolist (file gnus-article-browse-html-temp-list) (when (and (file-exists-p file) @@ -2802,61 +2802,63 @@ "View all \"text/html\" parts from LIST. Recurse into multiparts." ;; Internal function used by `gnus-article-browse-html-article'. - (let ((showed)) + (let (type file charset tmp-file showed) ;; Find and show the html-parts. (dolist (handle list) ;; If HTML, show it: - (when (listp handle) - (cond ((and (bufferp (car handle)) - (string-match "text/html" (car (mm-handle-type handle)))) - (let ((tmp-file (mm-make-temp-file - ;; Do we need to care for 8.3 filenames? - "mm-" nil ".html")) - (charset (mail-content-type-get (mm-handle-type handle) - 'charset))) - (if charset - ;; Add a meta html tag to specify charset. - (mm-with-unibyte-buffer - (insert (with-current-buffer (mm-handle-buffer handle) - (if (eq charset 'gnus-decoded) - (mm-encode-coding-string - (buffer-string) - (setq charset 'utf-8)) - (buffer-string)))) - (setq charset (format "\ -" - charset)) - (goto-char (point-min)) - (let ((case-fold-search t)) - (cond (;; Don't modify existing meta tag. - (re-search-forward "\ -]+>" - nil t)) - ((re-search-forward "[\t\n\r ]*" nil t) - (insert charset "\n")) - (t - (re-search-forward "\ -]+\\|[\t\n\r ]*\\)>[\t\n\r ]*" - nil t) - (insert "\n" charset "\n\n")))) + (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 (mm-handle-cache handle) + (condition-case code + (progn (mm-extern-cache-contents handle) t) + (error + (gnus-message 3 "%s" (error-message-string code)) + (when (>= gnus-verbose 3) (sit-for 2)) + nil))) + (progn + (setq handle (mm-handle-cache handle) + type (mm-handle-type handle)) + (equal (car type) "text/html")))) + (when (or (setq charset (mail-content-type-get type 'charset)) + (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)) - (mm-save-part-to-file handle tmp-file)) - (add-to-list 'gnus-article-browse-html-temp-list tmp-file) - (add-hook 'gnus-summary-prepare-exit-hook - 'gnus-article-browse-delete-temp-files) - (add-hook 'gnus-exit-gnus-hook - (lambda () - (gnus-article-browse-delete-temp-files t))) - ;; FIXME: Warn if there's an tag? - (browse-url-of-file tmp-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)))))))) + tmp-file nil nil nil 'binary t) + (setq tmp-file nil))) + (when 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 + 'gnus-article-browse-delete-temp-files) + (add-hook 'gnus-exit-gnus-hook + (lambda () + (gnus-article-browse-delete-temp-files t))) + ;; FIXME: Warn if there's an tag? + (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))))))) showed)) ;; FIXME: Documentation in texi/gnus.texi missing. @@ -3916,6 +3918,7 @@ (defun article-verify-x-pgp-sig () "Verify X-PGP-Sig." + ;; (interactive) (if (gnus-buffer-live-p gnus-original-article-buffer) (let ((sig (with-current-buffer gnus-original-article-buffer @@ -4724,8 +4727,9 @@ (handles gnus-article-mime-handles) (none "(none)") (description - (mail-decode-encoded-word-string (or (mm-handle-description data) - none))) + (let ((desc (mm-handle-description data))) + (when desc + (mail-decode-encoded-word-string desc)))) (filename (or (mail-content-type-get (mm-handle-disposition data) 'filename) none)) @@ -4743,7 +4747,8 @@ "| Type: " type "\n" "| Filename: " filename "\n" "| Size (encoded): " bsize " Byte\n" - "| Description: " description "\n" + (when description + (concat "| Description: " description "\n")) "`----\n")) (setcdr data (cdr (mm-make-handle @@ -8003,6 +8008,11 @@ gnus-article-encrypt-protocol-alist nil t)) current-prefix-arg)) + ;; User might hit `K E' instead of `K e', so prompt once. + (when (and gnus-article-encrypt-protocol + gnus-novice-user) + (unless (gnus-y-or-n-p "Really encrypt article(s)? ") + (error "Encrypt aborted."))) (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist)))) (unless func (error "Can't find the encrypt protocol %s" protocol)) diff -r a524d1739a14 -r b968c7f9a8b4 lisp/gnus/gnus-sum.el --- a/lisp/gnus/gnus-sum.el Sat Dec 15 11:37:25 2007 +0000 +++ b/lisp/gnus/gnus-sum.el Sun Dec 16 04:31:33 2007 +0000 @@ -7658,7 +7658,7 @@ (gnus-summary-article-subject)))) (defun gnus-summary-prev-article (&optional unread subject) - "Select the article after the current one. + "Select the article before the current one. If UNREAD is non-nil, only unread articles are selected." (interactive "P") (gnus-summary-next-article unread subject t)) @@ -10830,12 +10830,12 @@ (gnus-summary-mark-forward (- n) gnus-unread-mark)) (defun gnus-summary-mark-unread-as-read () - "Intended to be used by `gnus-summary-mark-article-hook'." + "Intended to be used by `gnus-mark-article-hook'." (when (memq gnus-current-article gnus-newsgroup-unreads) (gnus-summary-mark-article gnus-current-article gnus-read-mark))) (defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark) - "Intended to be used by `gnus-summary-mark-article-hook'." + "Intended to be used by `gnus-mark-article-hook'." (let ((mark (gnus-summary-article-mark))) (when (or (gnus-unread-mark-p mark) (gnus-read-mark-p mark)) @@ -10843,7 +10843,7 @@ (or new-mark gnus-read-mark))))) (defun gnus-summary-mark-current-read-and-unread-as-read (&optional new-mark) - "Intended to be used by `gnus-summary-mark-article-hook'." + "Intended to be used by `gnus-mark-article-hook'." (let ((mark (gnus-summary-article-mark))) (when (or (gnus-unread-mark-p mark) (gnus-read-mark-p mark)) @@ -10851,7 +10851,7 @@ (or new-mark gnus-read-mark))))) (defun gnus-summary-mark-unread-as-ticked () - "Intended to be used by `gnus-summary-mark-article-hook'." + "Intended to be used by `gnus-mark-article-hook'." (when (memq gnus-current-article gnus-newsgroup-unreads) (gnus-summary-mark-article gnus-current-article gnus-ticked-mark))) diff -r a524d1739a14 -r b968c7f9a8b4 lisp/gnus/gnus-util.el --- a/lisp/gnus/gnus-util.el Sat Dec 15 11:37:25 2007 +0000 +++ b/lisp/gnus/gnus-util.el Sun Dec 16 04:31:33 2007 +0000 @@ -337,15 +337,23 @@ ;; Two silly functions to ensure that all `y-or-n-p' questions clear ;; the echo area. -(defun gnus-y-or-n-p (prompt) - (prog1 - (y-or-n-p prompt) - (message ""))) +;; +;; Do we really need these aliases? Workarounds for bugs in the corresponding +;; Emacs functions? Maybe these bug are no longer present in any supported +;; (X)Emacs version? Alias them to the original functions and see if anyone +;; reports a problem. If not, replace with original functions. --rsteib +;; +;; (defun gnus-y-or-n-p (prompt) +;; (prog1 +;; (y-or-n-p prompt) +;; (message ""))) +;; (defun gnus-yes-or-no-p (prompt) +;; (prog1 +;; (yes-or-no-p prompt) +;; (message ""))) -(defun gnus-yes-or-no-p (prompt) - (prog1 - (yes-or-no-p prompt) - (message ""))) +(defalias 'gnus-y-or-n-p 'y-or-n-p) +(defalias 'gnus-yes-or-no-p 'yes-or-no-p) ;; By Frank Schmitt . Allows to have ;; age-depending date representations. (e.g. just the time if it's diff -r a524d1739a14 -r b968c7f9a8b4 lisp/gnus/mm-decode.el --- a/lisp/gnus/mm-decode.el Sat Dec 15 11:37:25 2007 +0000 +++ b/lisp/gnus/mm-decode.el Sun Dec 16 04:31:33 2007 +0000 @@ -1239,9 +1239,39 @@ (mm-save-part-to-file handle file) file)))) +(defun mm-add-meta-html-tag (handle &optional charset) + "Add meta html tag to specify CHARSET of HANDLE in the current buffer. +CHARSET defaults to the one HANDLE specifies. Existing meta tag that +specifies charset will not be modified. Return t if meta tag is added +or replaced." + (when (equal (mm-handle-media-type handle) "text/html") + (when (or charset + (setq charset (mail-content-type-get (mm-handle-type handle) + 'charset))) + (setq charset (format "\ +" charset)) + (let ((case-fold-search t)) + (goto-char (point-min)) + (if (re-search-forward "\ +]*>" nil t) + (if (and (match-beginning 2) + (string-match "\\`html\\'" (match-string 1))) + ;; Don't modify existing meta tag. + nil + ;; Replace it with the one specifying charset. + (replace-match charset) + t) + (if (re-search-forward "\\s-*" nil t) + (insert charset "\n") + (re-search-forward "]+\\|\\s-*\\)>\\s-*" nil t) + (insert "\n" charset "\n\n")) + t))))) + (defun mm-save-part-to-file (handle file) (mm-with-unibyte-buffer (mm-insert-part handle) + (mm-add-meta-html-tag handle) (let ((current-file-modes (default-file-modes))) (set-default-file-modes mm-attachment-file-modes) (unwind-protect @@ -1258,6 +1288,7 @@ (read-string "Shell command on MIME part: " mm-last-shell-command))) (mm-with-unibyte-buffer (mm-insert-part handle) + (mm-add-meta-html-tag handle) (let ((coding-system-for-write 'binary)) (shell-command-on-region (point-min) (point-max) command nil))))) diff -r a524d1739a14 -r b968c7f9a8b4 lisp/pgg.el --- a/lisp/pgg.el Sat Dec 15 11:37:25 2007 +0000 +++ b/lisp/pgg.el Sun Dec 16 04:31:33 2007 +0000 @@ -42,12 +42,10 @@ ;;; (eval-when-compile - (unless (featurep 'xemacs) - (defalias 'pgg-run-at-time 'run-at-time) - (defalias 'pgg-cancel-timer 'cancel-timer)) - - (when (featurep 'xemacs) - (defmacro pgg-run-at-time-1 (time repeat function args) + ;; Define it as a null macro for Emacs in order to suppress a byte + ;; compile warning that Emacs 21 issues. + (defmacro pgg-run-at-time-1 (time repeat function args) + (when (featurep 'xemacs) (if (condition-case nil (let ((delete-itimer 'delete-itimer) (itimer-driver-start 'itimer-driver-start) @@ -105,19 +103,23 @@ itimer (append (list itimer function) args))))) 1e-9 (if time (max time 1e-9) 1e-9) - nil t itimers ,repeat ,function ,args)))) + nil t itimers ,repeat ,function ,args)))))) - (defun pgg-run-at-time (time repeat function &rest args) - "Emulating function run as `run-at-time'. +(eval-and-compile + (if (featurep 'xemacs) + (progn + (defun pgg-run-at-time (time repeat function &rest args) + "Emulating function run as `run-at-time'. TIME should be nil meaning now, or a number of seconds from now. Return an itimer object which can be used in either `delete-itimer' or `cancel-timer'." - (pgg-run-at-time-1 time repeat function args)) - (defun pgg-cancel-timer (timer) - "Emulate cancel-timer for xemacs." - (let ((delete-itimer 'delete-itimer)) - (funcall delete-itimer timer))) - )) + (pgg-run-at-time-1 time repeat function args)) + (defun pgg-cancel-timer (timer) + "Emulate cancel-timer for xemacs." + (let ((delete-itimer 'delete-itimer)) + (funcall delete-itimer timer)))) + (defalias 'pgg-run-at-time 'run-at-time) + (defalias 'pgg-cancel-timer 'cancel-timer))) (defun pgg-invoke (func scheme &rest args) (progn