Mercurial > emacs
changeset 107739:813096803a4a
Merge from trunk
| author | Jan D. <jan.h.d@swipnet.se> |
|---|---|
| date | Tue, 23 Mar 2010 20:32:31 +0100 |
| parents | 1e30c1690fd8 (current diff) 6edb016a3cfc (diff) |
| children | cc6fa055586c |
| files | |
| diffstat | 23 files changed, 724 insertions(+), 243 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/ChangeLog Tue Mar 23 08:04:35 2010 +0100 +++ b/etc/ChangeLog Tue Mar 23 20:32:31 2010 +0100 @@ -1,3 +1,9 @@ +2010-03-22 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus/gnus-setup.ast: Add finish links to the top nodes. + + * gnus/news-server.ast: Add some trivial validation. + 2010-03-13 Michael Albinus <michael.albinus@gmx.de> * NEWS: Add secrets.el.
--- a/etc/TODO Tue Mar 23 08:04:35 2010 +0100 +++ b/etc/TODO Tue Mar 23 20:32:31 2010 +0100 @@ -105,9 +105,6 @@ ** erase-buffer should perhaps disregard read-only properties of text. -** Make occur correctly handle matches that span more than one line, - as well as overlapping matches. - ** Fix the kill/yank treatment of invisible text. At the moment, invisible text is placed in the kill-ring, so that the contents of the ring may not correspond to the text as displayed to the user.
--- a/etc/gnus/gnus-setup.ast Tue Mar 23 08:04:35 2010 +0100 +++ b/etc/gnus/gnus-setup.ast Tue Mar 23 20:32:31 2010 +0100 @@ -33,6 +33,8 @@ @end text +@next 'finish + @node Setting up a NNTP server @text @@ -40,6 +42,8 @@ Run M-x assistant and use the news-server.ast file as input. @end text +@next 'finish + @c Local variables: @c mode: texinfo
--- a/etc/gnus/news-server.ast Tue Mar 23 08:04:35 2010 +0100 +++ b/etc/gnus/news-server.ast Tue Mar 23 20:32:31 2010 +0100 @@ -2,9 +2,9 @@ @node Setting up the news server name and port number -@variable server :string (gnus-getenv-nntpserver) +@variable server :string (or (gnus-getenv-nntpserver) "your-server-here") @variable port :number 119 -@validate (assistant-validate-connect-to-server server port) +@validate (or (assistant-validate-connect-to-server server port) (y-or-n-p "Do you want to use the server anyway, although you can't confirm it's valid?")) @result gnus-select-method (list 'nntp server (list 'nntp-server port)) @text Usenet news is usually read from your Internet service prodider's news @@ -14,10 +14,10 @@ Server name: @variable{server} Port number: @variable{port} + @end text @next t "User name and password" - @node User name and password @type interstitial @next
--- a/lisp/ChangeLog Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/ChangeLog Tue Mar 23 20:32:31 2010 +0100 @@ -1,3 +1,49 @@ +2010-03-23 Sam Steingold <sds@gnu.org> + + Fix bug#5620: recalculate all markers on compilation buffer + modifications, not on file modifications. + * progmodes/compile.el (buffer-modtime): New buffer-local variable: + the buffer modification time, for buffers not associated with files. + (compilation-mode): Create it. + (compilation-filter): Update it. + (compilation-next-error-function): Use it instead of + `visited-file-modtime' for timestamp. + +2010-03-23 Juri Linkov <juri@jurta.org> + + Implement Occur multi-line matches. + http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01044.html + + * replace.el (occur): Doc fix. + (occur-engine): Set `begpt' to the beginning of the first line. + Set `endpt' to the end of the last match line. At first, count + line numbers between `origpt' and `begpt'. Split out code from + `out-line' variable to new let-bindings `match-prefix' and + `match-str'. In `out-line' add non-numeric prefix to all + non-first lines of multi-line matches. Finally, count lines + between `begpt' and `endpt' and add to `lines'. + +2010-03-23 Juri Linkov <juri@jurta.org> + + * replace.el (occur-accumulate-lines, occur-engine): + Use `occur-engine-line' instead of duplicate code. + (occur-engine-line): New function created from duplicate code + in `occur-accumulate-lines' and `occur-engine'. + + * replace.el (occur-engine-line): Add optional arg `keep-props'. + (occur-accumulate-lines, occur-engine): Add arg `keep-props'. + +2010-03-23 Juri Linkov <juri@jurta.org> + + * finder.el: Remove TODO tasks. + + * info.el (Info-finder-find-node): Add node "all" + with all package info. Handle a list of multiple keywords + separated by comma. + (info-finder): In interactive use with a prefix argument, + use `completing-read-multiple' to read a list of keywords + separated by comma. + 2010-03-23 Stefan Monnier <monnier@iro.umontreal.ca> Add a new completion style `substring'.
--- a/lisp/finder.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/finder.el Tue Mar 23 20:32:31 2010 +0100 @@ -27,12 +27,6 @@ ;; This mode uses the Keywords library header to provide code-finding ;; services by keyword. -;; -;; Things to do: -;; 1. Support multiple keywords per search. This could be extremely hairy; -;; there doesn't seem to be any way to get completing-read to exit on -;; an EOL with no substring pending, which is what we'd want to end the loop. -;; 2. Search by string in synopsis line? ;;; Code:
--- a/lisp/gnus/ChangeLog Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/gnus/ChangeLog Tue Mar 23 20:32:31 2010 +0100 @@ -1,3 +1,90 @@ +2010-03-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (canlock-verify): Autoload it for Emacs 21. + + * message.el (ecomplete-setup): Autoload it for Emacs <23. + + * mml-sec.el (mml-secure-cache-passphrase): Default to t that is + password-cache's default if it is not bound. + (mml-secure-passphrase-cache-expiry): Default to 16 that is + password-cache-expiry's default if it is not bound. + + * pop3.el (pop3-list): Don't use 3rd arg of `split-string' which is not + available in Emacs 21. + +2010-03-23 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el (auth-sources): Fix up definition so extra parameters + are always inline. + +2010-03-22 Martin Stjernholm <mast@lysator.liu.se> + + * nnimap.el (nnimap-verify-uidvalidity): Fixed bug where uidvalidity + wasn't updated after mismatch. Clear cached mailbox info correctly + when uidvalidity changes. + (nnimap-group-prefixed-name): New function to avoid some code + duplication. + (nnimap-verify-uidvalidity, nnimap-group-overview-filename) + (nnimap-request-group): Use it. + (nnimap-retrieve-groups, nnimap-verify-uidvalidity) + (nnimap-update-unseen): Significantly improved speed of Gnus startup + with many imap folders. This is done by caching the group status from + the imap server persistently in a group parameter `imap-status'. (This + was cached before too if `nnimap-retrieve-groups-asynchronous' was set, + but not persistently, so every Gnus startup was still very slow.) + +2010-03-20 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el: Set up autoloads. Bump to 23.2 because of the + secrets.el dependency. + (auth-sources): Add optional user name. Add secrets.el configuration + choice (unused right now). + +2010-03-20 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-sum.el (gnus-summary-make-menu-bar): Let + `gnus-registry-install-shortcuts' fill in the functions. + + * gnus-registry.el (gnus-summary-misc-menu): Declare to avoid + warnings. + (gnus-registry-misc-menus): Variable to hold registry mark menus. + (gnus-registry-install-shortcuts): Populate and use it in a + `gnus-summary-menu-hook' lambda, under "Gnus"->"Registry Marks". + +2010-03-20 Martin Stjernholm <mast@lysator.liu.se> + + * nnimap.el (nnimap-decode-group-name, nnimap-encode-group-name): + In-place substitutions for the group name encoding/decoding. + (nnimap-find-minmax-uid, nnimap-possibly-change-group) + (nnimap-retrieve-headers-progress, nnimap-possibly-change-group) + (nnimap-retrieve-headers-progress, nnimap-request-article-part) + (nnimap-update-unseen, nnimap-request-list) + (nnimap-retrieve-groups, nnimap-request-update-info-internal) + (nnimap-request-set-mark, nnimap-split-to-groups) + (nnimap-split-articles, nnimap-request-newgroups) + (nnimap-request-create-group, nnimap-request-accept-article) + (nnimap-request-delete-group, nnimap-request-rename-group) + (nnimap-acl-get, nnimap-acl-edit): Use them. Replace `mbx' with + `encoded-mbx' for consistency. + (nnimap-close-group): Call `imap-current-mailbox' instead of using the + variable `imap-current-mailbox'. + + * gnus-agent.el (gnus-agent-fetch-articles, gnus-agent-fetch-headers) + (gnus-agent-regenerate-group): Use `gnus-agent-decoded-group-name'. + +2010-03-20 Bojan Petrovic <bpetrovi@f.bg.ac.rs> + + * pop3.el (pop3-display-message-size-flag): Display message size byte + counts during POP3 download. + (pop3-movemail): Use it. + (pop3-list): Implement listing of available messages. + +2010-03-20 Mark Triggs <mst@dishevelled.net> (tiny change) + + * nnir.el (nnir-get-article-nov-override-function): New function to + override the normal NOV retrieval. + (nnir-retrieve-headers): Use it. + 2010-03-19 Michael Albinus <michael.albinus@gmx.de> * auth-source.el (netrc-machine-user-or-password): Autoload.
--- a/lisp/gnus/auth-source.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/gnus/auth-source.el Tue Mar 23 20:32:31 2010 +0100 @@ -35,6 +35,9 @@ (eval-when-compile (require 'cl)) (autoload 'netrc-machine-user-or-password "netrc") +(autoload 'secrets-search-items "secrets") +(autoload 'secrets-get-alias "secrets") +(autoload 'secrets-get-attribute "secrets") (defgroup auth-source nil "Authentication sources." @@ -49,7 +52,7 @@ "List of authentication protocols and their names" :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type '(repeat :tag "Authentication Protocols" (cons :tag "Protocol Entry" (symbol :tag "Protocol") @@ -71,7 +74,7 @@ (defcustom auth-source-do-cache t "Whether auth-source should cache information." :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type `boolean) (defcustom auth-source-debug nil @@ -85,7 +88,7 @@ If the value is a function, debug messages are logged by calling that function using the same arguments as `message'." :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type `(choice :tag "auth-source debugging mode" (const :tag "Log using `message' to the *Messages* buffer" t) @@ -96,19 +99,32 @@ "Whether auth-source should hide passwords in log messages. Only relevant if `auth-source-debug' is not nil." :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type `boolean) (defcustom auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t)) "List of authentication sources. -Each entry is the authentication type with optional properties." +Each entry is the authentication type with optional properties. + +It's best to customize this with `M-x customize-variable' because the choices +can get pretty complex." :group 'auth-source - :version "23.1" ;; No Gnus + :version "23.2" ;; No Gnus :type `(repeat :tag "Authentication Sources" (list :tag "Source definition" (const :format "" :value :source) - (string :tag "Authentication Source") + (choice :tag "Authentication backend choice" + (string :tag "Authentication Source (file)") + (list :tag "secrets.el (Secret Service API/KWallet/GNOME KeyRing)" + (const :format "" :value :secrets) + (choice :tag "Collection to use" + (string :tag "Collection name") + (const :tag "Default" 'default) + (const :tag "Any" t) + (const :tag "Temporary" "session") + (string :tag "Specific session name") + (const :tag "Fallback" nil)))) (const :format "" :value :host) (choice :tag "Host (machine) choice" (const :tag "Any" t) @@ -118,7 +134,15 @@ (choice :tag "Protocol" (const :tag "Any" t) (const :tag "Fallback" nil) - ,@auth-source-protocols-customize)))) + ,@auth-source-protocols-customize) + (repeat :tag "Extra Parameters" :inline t + (choice :tag "Extra parameter" + (list :tag "Preferred username" :inline t + (const :format "" :value :preferred-username) + (choice :tag "Personality or username" + (const :tag "Any" t) + (const :tag "Fallback" nil) + (string :tag "Specific user name")))))))) ;; temp for debugging ;; (unintern 'auth-source-protocols)
--- a/lisp/gnus/gnus-agent.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/gnus/gnus-agent.el Tue Mar 23 20:32:31 2010 +0100 @@ -1583,7 +1583,8 @@ (setq selected-sets (nreverse selected-sets)) (gnus-make-directory dir) - (gnus-message 7 "Fetching articles for %s..." group) + (gnus-message 7 "Fetching articles for %s..." + (gnus-agent-decoded-group-name group)) (unwind-protect (while (setq articles (pop selected-sets)) @@ -1594,7 +1595,8 @@ (let (article) (while (setq article (pop articles)) (gnus-message 10 "Fetching article %s for %s..." - article group) + article + (gnus-agent-decoded-group-name group)) (when (or (gnus-backlog-request-article group article nntp-server-buffer) @@ -1942,7 +1944,8 @@ (if articles (progn - (gnus-message 7 "Fetching headers for %s..." group) + (gnus-message 7 "Fetching headers for %s..." + (gnus-agent-decoded-group-name group)) ;; Fetch them. (gnus-make-directory (nnheader-translate-file-chars @@ -3904,7 +3907,7 @@ (sit-for 1) t))))) (when group - (gnus-message 5 "Regenerating in %s" group) + (gnus-message 5 "Regenerating in %s" (gnus-agent-decoded-group-name group)) (let* ((gnus-command-method (or gnus-command-method (gnus-find-method-for-group group))) (file (gnus-agent-article-name ".overview" group)) @@ -3981,7 +3984,8 @@ (or (not nov-arts) (> (car downloaded) (car nov-arts)))) ;; This entry is missing from the overview file - (gnus-message 3 "Regenerating NOV %s %d..." group + (gnus-message 3 "Regenerating NOV %s %d..." + (gnus-agent-decoded-group-name group) (car downloaded)) (let ((file (concat dir (number-to-string (car downloaded))))) (mm-with-unibyte-buffer
--- a/lisp/gnus/gnus-art.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/gnus/gnus-art.el Tue Mar 23 20:32:31 2010 +0100 @@ -4192,6 +4192,8 @@ (put-text-property (match-end 0) (point-max) 'face eface))))))))) +(autoload 'canlock-verify "canlock" nil t) ;; for Emacs 21. + (defun article-verify-cancel-lock () "Verify Cancel-Lock header." (interactive)
--- a/lisp/gnus/gnus-registry.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/gnus/gnus-registry.el Tue Mar 23 20:32:31 2010 +0100 @@ -60,6 +60,7 @@ (require 'gnus-sum) (require 'gnus-util) (require 'nnmail) +(require 'easymenu) (defvar gnus-adaptive-word-syntax-table) @@ -137,6 +138,10 @@ (const :tag "Always Install" t) (const :tag "Ask Me" ask))) +(defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning. + +(defvar gnus-registry-misc-menus nil) ; ugly way to keep the menus + (defcustom gnus-registry-clean-empty t "Whether the empty registry entries should be deleted. Registry entries are considered empty when they have no groups @@ -764,7 +769,8 @@ "Install the keyboard shortcuts and menus for the registry. Uses `gnus-registry-marks' to find what shortcuts to install." (let (keys-plist) - (gnus-registry-do-marks + (setq gnus-registry-misc-menus nil) + (gnus-registry-do-marks :char (lambda (mark data) (let ((function-format @@ -813,19 +819,34 @@ ;; all this just to get the mark, I must be doing it wrong (intern ,(symbol-name mark)) articles ,remove t) + (gnus-message + 9 + "Applying mark %s to %d articles" + ,(symbol-name mark) (length articles)) (dolist (article articles) (gnus-summary-update-article - article + article (assoc article (gnus-data-list nil))))))) (push (intern function-name) keys-plist) - (push shortcut keys-plist) - (gnus-message + (push shortcut keys-plist) + (push (vector (format "%s %s" + (upcase-initials variant-name) + (symbol-name mark)) + (intern function-name) t) + gnus-registry-misc-menus) + (gnus-message 9 "Defined mark handling function %s" function-name)))))) (gnus-define-keys-1 - '(gnus-registry-mark-map "M" gnus-summary-mark-map) - keys-plist))) + '(gnus-registry-mark-map "M" gnus-summary-mark-map) + keys-plist) + (add-hook 'gnus-summary-menu-hook + (lambda () + (easy-menu-add-item + gnus-summary-misc-menu + nil + (cons "Registry Marks" gnus-registry-misc-menus)))))) ;;; use like this: ;;; (defalias 'gnus-user-format-function-M
--- a/lisp/gnus/gnus-sum.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/gnus/gnus-sum.el Tue Mar 23 20:32:31 2010 +0100 @@ -2635,17 +2635,6 @@ ["Set expirable mark" gnus-summary-mark-as-expirable t] ["Set bookmark" gnus-summary-set-bookmark t] ["Remove bookmark" gnus-summary-remove-bookmark t]) - ("Registry Mark" - ["Important" gnus-registry-set-article-Important-mark t] - ["Not Important" gnus-registry-remove-article-Important-mark t] - ["Work" gnus-registry-set-article-Work-mark t] - ["Not Work" gnus-registry-remove-article-Work-mark t] - ["Later" gnus-registry-set-article-Later-mark t] - ["Not Later" gnus-registry-remove-article-Later-mark t] - ["Personal" gnus-registry-set-article-Personal-mark t] - ["Not Personal" gnus-registry-remove-article-Personal-mark t] - ["To Do" gnus-registry-set-article-To-Do-mark t] - ["Not To Do" gnus-registry-remove-article-To-Do-mark t]) ("Limit to" ["Marks..." gnus-summary-limit-to-marks t] ["Subject..." gnus-summary-limit-to-subject t] @@ -2691,6 +2680,7 @@ gnus-newsgroup-process-stack] ["Save" gnus-summary-save-process-mark t] ["Run command on marked..." gnus-summary-universal-argument t])) + ("Registry Marks") ("Scroll article" ["Page forward" gnus-summary-next-page ,@(if (featurep 'xemacs) '(t)
--- a/lisp/gnus/message.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/gnus/message.el Tue Mar 23 20:32:31 2010 +0100 @@ -2850,6 +2850,8 @@ (inhibit-read-only t)) (remove-text-properties begin end message-forbidden-properties)))) +(autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23. + ;;;###autoload (define-derived-mode message-mode text-mode "Message" "Major mode for editing mail and news to be sent.
--- a/lisp/gnus/mml-sec.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/gnus/mml-sec.el Tue Mar 23 20:32:31 2010 +0100 @@ -105,12 +105,18 @@ :group 'message :type 'boolean) -(defcustom mml-secure-cache-passphrase password-cache +(defcustom mml-secure-cache-passphrase + (if (boundp 'password-cache) + password-cache + t) "If t, cache passphrase." :group 'message :type 'boolean) -(defcustom mml-secure-passphrase-cache-expiry password-cache-expiry +(defcustom mml-secure-passphrase-cache-expiry + (if (boundp 'password-cache-expiry) + password-cache-expiry + 16) "How many seconds the passphrase is cached. Whether the passphrase is cached at all is controlled by `mml-secure-cache-passphrase'."
--- a/lisp/gnus/nnimap.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/gnus/nnimap.el Tue Mar 23 20:32:31 2010 +0100 @@ -501,6 +501,20 @@ ;; Utility functions: +(defsubst nnimap-decode-group-name (group) + (and group + (gnus-group-decoded-name group))) + +(defsubst nnimap-encode-group-name (group) + (and group + (mm-encode-coding-string group (gnus-group-name-charset nil group)))) + +(defun nnimap-group-prefixed-name (group &optional server) + (gnus-group-prefixed-name group + (gnus-server-to-method + (format "nnimap:%s" + (or server nnimap-current-server))))) + (defsubst nnimap-get-server-buffer (server) "Return buffer for SERVER, if nil use current server." (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist))) @@ -521,9 +535,7 @@ (defun nnimap-verify-uidvalidity (group server) "Verify stored uidvalidity match current one in GROUP on SERVER." - (let* ((gnusgroup (gnus-group-prefixed-name - group (gnus-server-to-method - (format "nnimap:%s" server)))) + (let* ((gnusgroup (nnimap-group-prefixed-name group server)) (new-uidvalidity (imap-mailbox-get 'uidvalidity)) (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity)) (dir (file-name-as-directory (expand-file-name nnimap-directory))) @@ -544,10 +556,18 @@ (if old-uidvalidity (if (not (equal old-uidvalidity new-uidvalidity)) ;; uidvalidity clash - (gnus-delete-file file) - (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity) + (progn + (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity) + (gnus-group-remove-parameter gnusgroup 'imap-status) + (gnus-sethash (gnus-group-prefixed-name group server) + nil nnimap-mailbox-info) + (gnus-delete-file file)) t) (gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity)) + (gnus-group-remove-parameter gnusgroup 'imap-status) + (gnus-sethash ; Maybe not necessary here. + (gnus-group-prefixed-name group server) + nil nnimap-mailbox-info) t))) (defun nnimap-before-find-minmax-bugworkaround () @@ -563,36 +583,39 @@ "Find lowest and highest active article number in GROUP. If EXAMINE is non-nil the group is selected read-only." (with-current-buffer nnimap-server-buffer - (when (or (string= group (imap-current-mailbox)) - (imap-mailbox-select group examine)) - (let (minuid maxuid) - (when (> (imap-mailbox-get 'exists) 0) - (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch) - (imap-message-map (lambda (uid Uid) - (setq minuid (if minuid (min minuid uid) uid) - maxuid (if maxuid (max maxuid uid) uid))) - 'UID)) - (list (imap-mailbox-get 'exists) minuid maxuid))))) + (let ((decoded-group (nnimap-decode-group-name group))) + (when (or (string= decoded-group (imap-current-mailbox)) + (imap-mailbox-select decoded-group examine)) + (let (minuid maxuid) + (when (> (imap-mailbox-get 'exists) 0) + (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch) + (imap-message-map (lambda (uid Uid) + (setq minuid (if minuid (min minuid uid) uid) + maxuid (if maxuid (max maxuid uid) uid))) + 'UID)) + (list (imap-mailbox-get 'exists) minuid maxuid)))))) (defun nnimap-possibly-change-group (group &optional server) "Make GROUP the current group, and SERVER the current server." (when (nnimap-possibly-change-server server) - (with-current-buffer nnimap-server-buffer - (if (or (null group) (imap-current-mailbox-p group)) - imap-current-mailbox - (if (imap-mailbox-select group) - (if (or (nnimap-verify-uidvalidity - group (or server nnimap-current-server)) - (zerop (imap-mailbox-get 'exists group)) - t ;; for OGnus to see if ignoring uidvalidity - ;; changes has any bad effects. - (yes-or-no-p - (format - "nnimap: Group %s is not uidvalid. Continue? " group))) - imap-current-mailbox - (imap-mailbox-unselect) - (error "nnimap: Group %s is not uid-valid" group)) - (nnheader-report 'nnimap (imap-error-text))))))) + (let ((decoded-group (nnimap-decode-group-name group))) + (with-current-buffer nnimap-server-buffer + (if (or (null group) (imap-current-mailbox-p decoded-group)) + imap-current-mailbox ; Note: utf-7 encoded. + (if (imap-mailbox-select decoded-group) + (if (or (nnimap-verify-uidvalidity + group (or server nnimap-current-server)) + (zerop (imap-mailbox-get 'exists decoded-group)) + t ;; for OGnus to see if ignoring uidvalidity + ;; changes has any bad effects. + (yes-or-no-p + (format + "nnimap: Group %s is not uidvalid. Continue? " + decoded-group))) + imap-current-mailbox ; Note: utf-7 encoded. + (imap-mailbox-unselect) + (error "nnimap: Group %s is not uid-valid" decoded-group)) + (nnheader-report 'nnimap (imap-error-text)))))))) (defun nnimap-replace-whitespace (string) "Return STRING with all whitespace replaced with space." @@ -618,7 +641,7 @@ (let (headers lines chars uid mbx) (with-current-buffer nnimap-server-buffer (setq uid imap-current-message - mbx imap-current-mailbox + mbx (nnimap-encode-group-name (imap-current-mailbox)) headers (if (imap-capability 'IMAP4rev1) ;; xxx don't just use car? alist doesn't contain ;; anything else now, but it might... @@ -665,9 +688,7 @@ "Make file name for GROUP on SERVER." (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory))) (uidvalidity (gnus-group-get-parameter - (gnus-group-prefixed-name - group (gnus-server-to-method - (format "nnimap:%s" server))) + (nnimap-group-prefixed-name group server) 'uidvalidity)) (name (nnheader-translate-file-chars (concat nnimap-nov-file-name @@ -964,8 +985,10 @@ article))) (when article (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..." - article (or group imap-current-mailbox - gnus-newsgroup-name)) + article (or (nnimap-decode-group-name group) + (imap-current-mailbox) + (nnimap-decode-group-name + gnus-newsgroup-name))) (if (not nnheader-callback-function) (with-current-buffer (or to-buffer nntp-server-buffer) (erase-buffer) @@ -979,11 +1002,15 @@ (nnheader-ms-strip-cr) (gnus-message 10 "nnimap: Fetching (part of) article %d from %s...done" - article (or group imap-current-mailbox gnus-newsgroup-name)) + article (or (nnimap-decode-group-name group) + (imap-current-mailbox) + (nnimap-decode-group-name gnus-newsgroup-name))) (if (bobp) (nnheader-report 'nnimap "No such article %d in %s: %s" - article (or group imap-current-mailbox - gnus-newsgroup-name) + article (or (nnimap-decode-group-name group) + (imap-current-mailbox) + (nnimap-decode-group-name + gnus-newsgroup-name)) (imap-error-text nnimap-server-buffer)) (cons group article))) (add-hook 'imap-fetch-data-hook @@ -1020,8 +1047,7 @@ (deffoo nnimap-request-group (group &optional server fast) (nnimap-request-update-info-internal group - (gnus-get-info (gnus-group-prefixed-name - group (gnus-server-to-method (format "nnimap:%s" server)))) + (gnus-get-info (nnimap-group-prefixed-name group server)) server) (when (nnimap-possibly-change-group group server) (nnimap-before-find-minmax-bugworkaround) @@ -1044,8 +1070,8 @@ (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server) nnimap-mailbox-info))) (list (nth 0 old) (nth 1 old) - (imap-mailbox-status group 'unseen nnimap-server-buffer) - (nth 3 old))) + (imap-mailbox-status (nnimap-decode-group-name group) + 'unseen nnimap-server-buffer))) nnimap-mailbox-info)) (defun nnimap-close-group (group &optional server) @@ -1060,7 +1086,7 @@ (imap-mailbox-close nnimap-close-asynchronous)))) (ask (if (and (imap-search "DELETED") (gnus-y-or-n-p (format "Expunge articles in group `%s'? " - imap-current-mailbox))) + (imap-current-mailbox)))) (progn (imap-mailbox-expunge nnimap-close-asynchronous) (unless nnimap-dont-close @@ -1089,11 +1115,12 @@ (dolist (mbx (funcall nnimap-request-list-method (cdr pattern) (car pattern))) (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx)) - (let ((info (nnimap-find-minmax-uid mbx 'examine))) + (let* ((encoded-mbx (nnimap-encode-group-name mbx)) + (info (nnimap-find-minmax-uid encoded-mbx 'examine))) (when info (with-current-buffer nntp-server-buffer (insert (format "\"%s\" %d %d y\n" - mbx (or (nth 2 info) 0) + encoded-mbx (or (nth 2 info) 0) (max 1 (or (nth 1 info) 1))))))))))) (gnus-message 5 "nnimap: Generating active list%s...done" (if (> (length server) 0) (concat " for " server) "")) @@ -1143,73 +1170,88 @@ (with-current-buffer nntp-server-buffer (erase-buffer) (nnimap-before-find-minmax-bugworkaround) - (let (asyncgroups slowgroups) + (let (asyncgroups slowgroups decoded-group) (if (null nnimap-retrieve-groups-asynchronous) (setq slowgroups groups) (dolist (group groups) - (gnus-message 9 "nnimap: Quickly checking mailbox %s" group) - (add-to-list (if (gnus-gethash-safe - (gnus-group-prefixed-name group server) - nnimap-mailbox-info) + (setq decoded-group (nnimap-decode-group-name group)) + (gnus-message 9 "nnimap: Quickly checking mailbox %s" + decoded-group) + (add-to-list (if (gnus-group-get-parameter + (nnimap-group-prefixed-name group) + 'imap-status) 'asyncgroups 'slowgroups) (list group (imap-mailbox-status-asynch - group '(uidvalidity uidnext unseen) + decoded-group + '(uidvalidity uidnext unseen) nnimap-server-buffer)))) (dolist (asyncgroup asyncgroups) - (let ((group (nth 0 asyncgroup)) - (tag (nth 1 asyncgroup)) - new old) + (let* ((group (nth 0 asyncgroup)) + (tag (nth 1 asyncgroup)) + (gnusgroup (nnimap-group-prefixed-name group)) + (saved-uidvalidity (gnus-group-get-parameter gnusgroup + 'uidvalidity)) + (saved-imap-status (gnus-group-get-parameter gnusgroup + 'imap-status)) + (saved-info (and saved-imap-status + (split-string saved-imap-status " ")))) + (setq decoded-group (nnimap-decode-group-name group)) (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer)) - (if (or (not (string= - (nth 0 (gnus-gethash (gnus-group-prefixed-name - group server) - nnimap-mailbox-info)) - (imap-mailbox-get 'uidvalidity group + (if (or (not (equal + saved-uidvalidity + (imap-mailbox-get 'uidvalidity decoded-group nnimap-server-buffer))) - (not (string= - (nth 1 (gnus-gethash (gnus-group-prefixed-name - group server) - nnimap-mailbox-info)) - (imap-mailbox-get 'uidnext group + (not (equal + (nth 0 saved-info) + (imap-mailbox-get 'uidnext decoded-group nnimap-server-buffer)))) (push (list group) slowgroups) - (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name - group server) - nnimap-mailbox-info)))))))) + (gnus-sethash + (gnus-group-prefixed-name group server) + (list (imap-mailbox-get 'uidvalidity + decoded-group nnimap-server-buffer) + (imap-mailbox-get 'uidnext + decoded-group nnimap-server-buffer) + (imap-mailbox-get 'unseen + decoded-group nnimap-server-buffer)) + nnimap-mailbox-info) + (insert (format "\"%s\" %s %s y\n" group + (nth 2 saved-info) + (nth 1 saved-info)))))))) (dolist (group slowgroups) (if nnimap-retrieve-groups-asynchronous (setq group (car group))) - (gnus-message 7 "nnimap: Mailbox %s modified" group) - (imap-mailbox-put 'uidnext nil group nnimap-server-buffer) - (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group + (setq decoded-group (nnimap-decode-group-name group)) + (gnus-message 7 "nnimap: Mailbox %s modified" decoded-group) + (or (member "\\NoSelect" (imap-mailbox-get 'list-flags decoded-group nnimap-server-buffer)) - (let* ((info (nnimap-find-minmax-uid group 'examine)) - (str (format "\"%s\" %d %d y\n" group - (or (nth 2 info) 0) - (max 1 (or (nth 1 info) 1))))) - (when (> (or (imap-mailbox-get 'recent group + (let* ((gnusgroup (nnimap-group-prefixed-name group)) + (status (imap-mailbox-status + decoded-group '(uidvalidity uidnext unseen) + nnimap-server-buffer)) + (info (nnimap-find-minmax-uid group 'examine)) + (min-uid (max 1 (or (nth 1 info) 1))) + (max-uid (or (nth 2 info) 0))) + (when (> (or (imap-mailbox-get 'recent decoded-group nnimap-server-buffer) 0) 0) - (push (list (cons group 0)) nnmail-split-history)) - (insert str) - (when nnimap-retrieve-groups-asynchronous - (gnus-sethash - (gnus-group-prefixed-name group server) - (list (or (imap-mailbox-get - 'uidvalidity group nnimap-server-buffer) - (imap-mailbox-status - group 'uidvalidity nnimap-server-buffer)) - (or (imap-mailbox-get - 'uidnext group nnimap-server-buffer) - (imap-mailbox-status - group 'uidnext nnimap-server-buffer)) - (or (imap-mailbox-get - 'unseen group nnimap-server-buffer) - (imap-mailbox-status - group 'unseen nnimap-server-buffer)) - str) - nnimap-mailbox-info))))))) + (push (list (cons decoded-group 0)) nnmail-split-history)) + (insert (format "\"%s\" %d %d y\n" group max-uid min-uid)) + (gnus-sethash + (gnus-group-prefixed-name group server) + status + nnimap-mailbox-info) + (if (not (equal (nth 0 status) + (gnus-group-get-parameter gnusgroup + 'uidvalidity))) + (nnimap-verify-uidvalidity group nnimap-current-server)) + ;; The imap-status parameter is a string on the form + ;; "<uidnext> <min-uid> <max-uid>". + (gnus-group-add-parameter + gnusgroup + (cons 'imap-status + (format "%s %s %s" (nth 1 status) min-uid max-uid)))))))) (gnus-message 5 "nnimap: Checking mailboxes...done") 'active)) @@ -1218,7 +1260,7 @@ (when info ;; xxx what does this mean? should we create a info? (with-current-buffer nnimap-server-buffer (gnus-message 5 "nnimap: Updating info for %s..." - (gnus-info-group info)) + (nnimap-decode-group-name (gnus-info-group info))) (when (nnimap-mark-permanent-p 'read) (let (seen unseen) @@ -1264,7 +1306,7 @@ t)) (gnus-message 5 "nnimap: Updating info for %s...done" - (gnus-info-group info)) + (nnimap-decode-group-name (gnus-info-group info))) info)))) @@ -1277,7 +1319,8 @@ (when (nnimap-possibly-change-group group server) (with-current-buffer nnimap-server-buffer (let (action) - (gnus-message 7 "nnimap: Setting marks in %s..." group) + (gnus-message 7 "nnimap: Setting marks in %s..." + (nnimap-decode-group-name group)) (while (setq action (pop actions)) (let ((range (nth 0 action)) (what (nth 1 action)) @@ -1318,7 +1361,8 @@ (imap-message-flags-set (imap-range-to-message-set range) (nnimap-mark-to-flag marks nil t))))))) - (gnus-message 7 "nnimap: Setting marks in %s...done" group)))) + (gnus-message 7 "nnimap: Setting marks in %s...done" + (nnimap-decode-group-name group))))) nil) (defun nnimap-split-fancy () @@ -1329,6 +1373,7 @@ (defun nnimap-split-to-groups (rules) ;; tries to match all rules in nnimap-split-rule against content of ;; nntp-server-buffer, returns a list of groups that matched. + ;; Note: This function takes and returns decoded group names. (with-current-buffer nntp-server-buffer ;; Fold continuation lines. (goto-char (point-min)) @@ -1381,12 +1426,16 @@ (list nnimap-split-inbox))) (defun nnimap-split-articles (&optional group server) + ;; Note: Assumes decoded group names in nnimap-split-inbox, + ;; nnimap-split-rule, nnimap-split-fancy, and nnmail-split-history. (when (nnimap-possibly-change-server server) (with-current-buffer nnimap-server-buffer - (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server))) + (let (rule inbox removeorig + (inboxes (nnimap-split-find-inbox server))) ;; iterate over inboxes (while (and (setq inbox (pop inboxes)) - (nnimap-possibly-change-group inbox)) ;; SELECT + (nnimap-possibly-change-group + (nnimap-encode-group-name inbox))) ;; SELECT ;; find split rule for this server / inbox (when (setq rule (nnimap-split-find-rule server inbox)) ;; iterate over articles @@ -1415,7 +1464,7 @@ (and (setq msgid (nnmail-fetch-field "message-id")) (nnmail-cache-insert msgid - to-group + (nnimap-encode-group-name to-group) (nnmail-fetch-field "subject")))))) ;; Add the group-art list to the history list. (push (list (cons to-group 0)) nnmail-split-history)) @@ -1458,10 +1507,11 @@ (if (string= (downcase mailbox) "\\noselect") (throw 'found t))) nil) - (let ((info (nnimap-find-minmax-uid mbx 'examine))) + (let* ((encoded-mbx (nnimap-encode-group-name mbx)) + (info (nnimap-find-minmax-uid encoded-mbx 'examine))) (when info (insert (format "\"%s\" %d %d y\n" - mbx (or (nth 2 info) 0) + encoded-mbx (or (nth 2 info) 0) (max 1 (or (nth 1 info) 1))))))))) (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done" (if (> (length server) 0) " on " "") server)) @@ -1469,10 +1519,11 @@ (deffoo nnimap-request-create-group (group &optional server args) (when (nnimap-possibly-change-server server) - (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer) - (imap-mailbox-create group nnimap-server-buffer) - (nnheader-report 'nnimap "%S" - (imap-error-text nnimap-server-buffer))))) + (let ((decoded-group (nnimap-decode-group-name group))) + (or (imap-mailbox-status decoded-group 'uidvalidity nnimap-server-buffer) + (imap-mailbox-create decoded-group nnimap-server-buffer) + (nnheader-report 'nnimap "%S" + (imap-error-text nnimap-server-buffer)))))) (defun nnimap-time-substract (time1 time2) "Return TIME for TIME1 - TIME2." @@ -1603,7 +1654,8 @@ nnimap-current-move-group) (imap-message-copy (number-to-string nnimap-current-move-article) - group 'dontcreate nil + (nnimap-decode-group-name group) + 'dontcreate nil nnimap-server-buffer)) (with-current-buffer (current-buffer) (goto-char (point-min)) @@ -1623,13 +1675,15 @@ ;; this 'or' is for Cyrus server bug (or (null (imap-current-mailbox nnimap-server-buffer)) (imap-mailbox-unselect nnimap-server-buffer)) - (imap-message-append group (current-buffer) nil nil + (imap-message-append (nnimap-decode-group-name group) + (current-buffer) nil nil nnimap-server-buffer))) (cons group (nth 1 uid)) (nnheader-report 'nnimap (imap-error-text nnimap-server-buffer)))))) (deffoo nnimap-request-delete-group (group force &optional server) (when (nnimap-possibly-change-server server) + (setq group (nnimap-decode-group-name group)) (when (string= group (imap-current-mailbox nnimap-server-buffer)) (imap-mailbox-unselect nnimap-server-buffer)) (with-current-buffer nnimap-server-buffer @@ -1641,7 +1695,9 @@ (deffoo nnimap-request-rename-group (group new-name &optional server) (when (nnimap-possibly-change-server server) - (imap-mailbox-rename group new-name nnimap-server-buffer))) + (imap-mailbox-rename (nnimap-decode-group-name group) + (nnimap-decode-group-name new-name) + nnimap-server-buffer))) (defun nnimap-expunge (mailbox server) (when (nnimap-possibly-change-group mailbox server) @@ -1650,7 +1706,8 @@ (defun nnimap-acl-get (mailbox server) (when (nnimap-possibly-change-server server) (and (imap-capability 'ACL nnimap-server-buffer) - (imap-mailbox-acl-get mailbox nnimap-server-buffer)))) + (imap-mailbox-acl-get (nnimap-decode-group-name mailbox) + nnimap-server-buffer)))) (defun nnimap-acl-edit (mailbox method old-acls new-acls) (when (nnimap-possibly-change-server (cadr method)) @@ -1660,7 +1717,8 @@ ;; delete all removed identifiers (mapc (lambda (old-acl) (unless (assoc (car old-acl) new-acls) - (or (imap-mailbox-acl-delete (car old-acl) mailbox) + (or (imap-mailbox-acl-delete (car old-acl) + (nnimap-decode-group-name mailbox)) (error "Can't delete ACL for %s" (car old-acl))))) old-acls) ;; set all changed acl's @@ -1669,7 +1727,8 @@ (old-rights (cdr (assoc (car new-acl) old-acls)))) (unless (and old-rights new-rights (string= old-rights new-rights)) - (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox) + (or (imap-mailbox-acl-set (car new-acl) new-rights + (nnimap-decode-group-name mailbox)) (error "Can't set ACL for %s to %s" (car new-acl) new-rights))))) new-acls)
--- a/lisp/gnus/nnir.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/gnus/nnir.el Tue Mar 23 20:32:31 2010 +0100 @@ -358,6 +358,14 @@ (defvar nnir-imap-search-argument-history () "The history for querying search options in nnir") +(defvar nnir-get-article-nov-override-function nil + "If non-nil, a function that will be passed each search result. This +should return a message's headers in NOV format. + +If this variable is nil, or if the provided function returns nil for a search +result, `gnus-retrieve-headers' will be called instead.") + + ;;; Developer Extension Variable: (defvar nnir-engines @@ -779,25 +787,31 @@ (nnir-possibly-change-server server) (let ((gnus-override-method (gnus-server-to-method server))) - (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil)) - (nov - (goto-char (point-min)) - (setq novitem (nnheader-parse-nov)) - (unless novitem - (pop-to-buffer nntp-server-buffer) - (error - "nnheader-parse-nov returned nil for article %s in group %s" - artno artfullgroup))) - (headers - (goto-char (point-min)) - (setq novitem (nnheader-parse-head)) - (unless novitem - (pop-to-buffer nntp-server-buffer) - (error - "nnheader-parse-head returned nil for article %s in group %s" - artno artfullgroup))) - (t (error "Unknown header type %s while requesting article %s of group %s" - foo artno artfullgroup)))) + ;; if nnir-get-article-nov-override-function is set, use it + (if nnir-get-article-nov-override-function + (setq novitem (funcall nnir-get-article-nov-override-function + artitem)) + ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head + (case (setq foo (gnus-retrieve-headers (list artno) + artfullgroup nil)) + (nov + (goto-char (point-min)) + (setq novitem (nnheader-parse-nov)) + (unless novitem + (pop-to-buffer nntp-server-buffer) + (error + "nnheader-parse-nov returned nil for article %s in group %s" + artno artfullgroup))) + (headers + (goto-char (point-min)) + (setq novitem (nnheader-parse-head)) + (unless novitem + (pop-to-buffer nntp-server-buffer) + (error + "nnheader-parse-head returned nil for article %s in group %s" + artno artfullgroup))) + (t (error "Unknown header type %s while requesting article %s of group %s" + foo artno artfullgroup))))) ;; replace article number in original group with article number ;; in nnir group (mail-header-set-number novitem art)
--- a/lisp/gnus/pop3.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/gnus/pop3.el Tue Mar 23 20:32:31 2010 +0100 @@ -98,6 +98,12 @@ :type 'boolean :group 'pop3) +(defcustom pop3-display-message-size-flag t + "*If non-nil, display the size of the message that is being fetched." + :version "22.1" ;; Oort Gnus + :type 'boolean + :group 'pop3) + (defvar pop3-timestamp nil "Timestamp returned when initially connected to the POP server. Used for APOP authentication.") @@ -135,6 +141,7 @@ (crashbuf (get-buffer-create " *pop3-retr*")) (n 1) message-count + message-sizes (pop3-password pop3-password)) ;; for debugging only (if pop3-debug (switch-to-buffer (process-buffer process))) @@ -149,10 +156,18 @@ (pop3-pass process)) (t (error "Invalid POP3 authentication scheme"))) (setq message-count (car (pop3-stat process))) + (when (and pop3-display-message-size-flag + (> message-count 0)) + (setq message-sizes (pop3-list process))) (unwind-protect (while (<= n message-count) - (message "Retrieving message %d of %d from %s..." - n message-count pop3-mailhost) + (if pop3-display-message-size-flag + (message "Retrieving message %d of %d from %s... (%.1fk)" + n message-count pop3-mailhost + (/ (cdr (assoc n message-sizes)) + 1024.0)) + (message "Retrieving message %d of %d from %s..." + n message-count pop3-mailhost)) (pop3-retr process n crashbuf) (save-excursion (set-buffer crashbuf) @@ -451,8 +466,28 @@ )) (defun pop3-list (process &optional msg) - "Scan listing of available messages. -This function currently does nothing.") + "If MSG is nil, return an alist of (MESSAGE-ID . SIZE) pairs. +Otherwise, return the size of the message-id MSG" + (pop3-send-command process (if msg + (format "LIST %d" msg) + "LIST")) + (let ((response (pop3-read-response process t))) + (if msg + (string-to-number (nth 2 (split-string response " "))) + (let ((start pop3-read-point) end) + (save-excursion + (set-buffer (process-buffer process)) + (while (not (re-search-forward "^\\.\r\n" nil t)) + (pop3-accept-process-output process) + (goto-char start)) + (setq pop3-read-point (point-marker)) + (goto-char (match-beginning 0)) + (setq end (point-marker)) + (mapcar #'(lambda (s) (let ((split (split-string s " "))) + (cons (string-to-number (nth 0 split)) + (string-to-number (nth 1 split))))) + (delete "" (split-string (buffer-substring start end) + "\r\n")))))))) (defun pop3-retr (process msg crashbuf) "Retrieve message-id MSG to buffer CRASHBUF."
--- a/lisp/info.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/info.el Tue Mar 23 20:32:31 2010 +0100 @@ -3362,7 +3362,8 @@ (insert (format "* %-14s %s.\n" (concat (symbol-name keyword) "::") (cdr assoc))))) - (cons '(unknown . "unknown keywords") + (append '((all . "All package info") + (unknown . "unknown keywords")) finder-known-keywords))) ((equal nodename "unknown") ;; Display unknown keywords @@ -3377,6 +3378,22 @@ (concat (symbol-name (car assoc)) "::") (cdr assoc)))) (finder-unknown-keywords))) + ((equal nodename "all") + ;; Display all package info. + (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" + Info-finder-file nodename)) + (insert "Finder Package Info\n") + (insert "*******************\n\n") + (mapc (lambda (package) + (insert (format "%s - %s\n" + (format "*Note %s::" (nth 0 package)) + (nth 1 package))) + (insert "Keywords: " + (mapconcat (lambda (keyword) + (format "*Note %s::" (symbol-name keyword))) + (nth 2 package) ", ") + "\n\n")) + finder-package-info)) ((string-match-p "\\.el\\'" nodename) ;; Display commentary section (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" @@ -3401,6 +3418,7 @@ (buffer-string)))))) (t ;; Display packages that match the keyword + ;; or the list of keywords separated by comma. (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" Info-finder-file nodename)) (insert "Finder Packages\n") @@ -3408,21 +3426,39 @@ (insert "The following packages match the keyword `" nodename "':\n\n") (insert "* Menu:\n\n") - (let ((id (intern nodename))) + (let ((keywords + (mapcar 'intern (if (string-match-p "," nodename) + (split-string nodename ",[ \t\n]*" t) + (list nodename))))) (mapc - (lambda (x) - (when (memq id (cadr (cdr x))) + (lambda (package) + (unless (memq nil (mapcar (lambda (k) (memq k (nth 2 package))) + keywords)) (insert (format "* %-16s %s.\n" - (concat (car x) "::") - (cadr x))))) + (concat (nth 0 package) "::") + (nth 1 package))))) finder-package-info))))) ;;;###autoload -(defun info-finder () - "Display descriptions of the keywords in the Finder virtual manual." - (interactive) +(defun info-finder (&optional keywords) + "Display descriptions of the keywords in the Finder virtual manual. +In interactive use, a prefix argument directs this command to read +a list of keywords separated by comma. After that, it displays a node +with a list packages that contain all specified keywords." + (interactive + (when current-prefix-arg + (require 'finder) + (list + (completing-read-multiple + "Keywords (separated by comma): " + (mapcar 'symbol-name (mapcar 'car (append finder-known-keywords + (finder-unknown-keywords)))) + nil t)))) (require 'finder) - (Info-find-node Info-finder-file "Top")) + (if keywords + (Info-find-node Info-finder-file (mapconcat 'identity keywords ", ")) + (Info-find-node Info-finder-file "Top"))) + (defun Info-undefined () "Make command be undefined in Info."
--- a/lisp/midnight.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/midnight.el Tue Mar 23 20:32:31 2010 +0100 @@ -3,8 +3,8 @@ ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. -;; Author: Sam Steingold <sds@usa.net> -;; Maintainer: Sam Steingold <sds@usa.net> +;; Author: Sam Steingold <sds@gnu.org> +;; Maintainer: Sam Steingold <sds@gnu.org> ;; Created: 1998-05-18 ;; Keywords: utilities @@ -205,7 +205,7 @@ (defun midnight-next () "Return the number of seconds till the next midnight." - (multiple-value-bind (sec min hrs) + (multiple-value-bind (sec min hrs) (values-list (decode-time)) (- (* 24 60 60) (* 60 60 hrs) (* 60 min) sec)))
--- a/lisp/progmodes/compile.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/progmodes/compile.el Tue Mar 23 20:32:31 2010 +0100 @@ -733,6 +733,9 @@ "If non-nil, automatically jump to the next error encountered.") (make-variable-buffer-local 'compilation-auto-jump-to-next) +(defvar buffer-modtime nil + "The buffer modification time, for buffers not associated with files.") +(make-variable-buffer-local 'buffer-modtime) (defvar compilation-skip-to-next-location t "*If non-nil, skip multiple error messages for the same source location.") @@ -1566,6 +1569,7 @@ mode-name (or name-of-mode "Compilation")) (set (make-local-variable 'page-delimiter) compilation-page-delimiter) + (set (make-local-variable 'buffer-modtime) nil) (compilation-setup) (setq buffer-read-only t) (run-mode-hooks 'compilation-mode-hook)) @@ -1781,6 +1785,7 @@ (unless comint-inhibit-carriage-motion (comint-carriage-motion (process-mark proc) (point))) (set-marker (process-mark proc) (point)) + (set (make-local-variable buffer-modtime) (current-time)) (run-hooks 'compilation-filter-hook)) (goto-char pos) (narrow-to-region min max) @@ -1954,9 +1959,7 @@ ;; There may be no timestamp info if the loc is a `fake-loc', ;; but we just checked that the file has been visited before! (equal (nth 4 loc) - (setq timestamp - (with-current-buffer (marker-buffer (nth 3 loc)) - (visited-file-modtime))))) + (setq timestamp buffer-modtime))) (with-current-buffer (compilation-find-file marker (caar (nth 2 loc)) (cadr (car (nth 2 loc)))) (save-restriction
--- a/lisp/replace.el Tue Mar 23 08:04:35 2010 +0100 +++ b/lisp/replace.el Tue Mar 23 20:32:31 2010 +0100 @@ -1016,18 +1016,7 @@ (setq count (+ count (if forwardp -1 1))) (setq beg (line-beginning-position) end (line-end-position)) - (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode) - (text-property-not-all beg end 'fontified t)) - (if (fboundp 'jit-lock-fontify-now) - (jit-lock-fontify-now beg end))) - (push - (if (and keep-props (not (eq occur-excluded-properties t))) - (let ((str (buffer-substring beg end))) - (remove-list-of-text-properties - 0 (length str) occur-excluded-properties str) - str) - (buffer-substring-no-properties beg end)) - result) + (push (occur-engine-line beg end keep-props) result) (forward-line (if forwardp 1 -1))) (nreverse result)))) @@ -1056,7 +1045,7 @@ (defun occur (regexp &optional nlines) "Show all lines in the current buffer containing a match for REGEXP. -This function can not handle matches that span more than one line. +If a match spreads across multiple lines, all those lines are shown. Each line is displayed with NLINES lines before and after, or -NLINES before if NLINES is negative. @@ -1221,24 +1210,17 @@ (when (setq endpt (re-search-forward regexp nil t)) (setq matches (1+ matches)) ;; increment match count (setq matchbeg (match-beginning 0)) - (setq lines (+ lines (1- (count-lines origpt endpt)))) + ;; Get beginning of first match line and end of the last. (save-excursion (goto-char matchbeg) - (setq begpt (line-beginning-position) - endpt (line-end-position))) + (setq begpt (line-beginning-position)) + (goto-char endpt) + (setq endpt (line-end-position))) + ;; Sum line numbers up to the first match line. + (setq lines (+ lines (count-lines origpt begpt))) (setq marker (make-marker)) (set-marker marker matchbeg) - (if (and keep-props - (if (boundp 'jit-lock-mode) jit-lock-mode) - (text-property-not-all begpt endpt 'fontified t)) - (if (fboundp 'jit-lock-fontify-now) - (jit-lock-fontify-now begpt endpt))) - (if (and keep-props (not (eq occur-excluded-properties t))) - (progn - (setq curstring (buffer-substring begpt endpt)) - (remove-list-of-text-properties - 0 (length curstring) occur-excluded-properties curstring)) - (setq curstring (buffer-substring-no-properties begpt endpt))) + (setq curstring (occur-engine-line begpt endpt keep-props)) ;; Highlight the matches (let ((len (length curstring)) (start 0)) @@ -1255,24 +1237,33 @@ curstring) (setq start (match-end 0)))) ;; Generate the string to insert for this match - (let* ((out-line + (let* ((match-prefix + ;; Using 7 digits aligns tabs properly. + (apply #'propertize (format "%7d:" lines) + (append + (when prefix-face + `(font-lock-face prefix-face)) + `(occur-prefix t mouse-face (highlight) + occur-target ,marker follow-link t + help-echo "mouse-2: go to this occurrence")))) + (match-str + ;; We don't put `mouse-face' on the newline, + ;; because that loses. And don't put it + ;; on context lines to reduce flicker. + (propertize curstring 'mouse-face (list 'highlight) + 'occur-target marker + 'follow-link t + 'help-echo + "mouse-2: go to this occurrence")) + (out-line (concat - ;; Using 7 digits aligns tabs properly. - (apply #'propertize (format "%7d:" lines) - (append - (when prefix-face - `(font-lock-face prefix-face)) - `(occur-prefix t mouse-face (highlight) - occur-target ,marker follow-link t - help-echo "mouse-2: go to this occurrence"))) - ;; We don't put `mouse-face' on the newline, - ;; because that loses. And don't put it - ;; on context lines to reduce flicker. - (propertize curstring 'mouse-face (list 'highlight) - 'occur-target marker - 'follow-link t - 'help-echo - "mouse-2: go to this occurrence") + match-prefix + ;; Add non-numeric prefix to all non-first lines + ;; of multi-line matches. + (replace-regexp-in-string + "\n" + "\n :" + match-str) ;; Add marker at eol, but no mouse props. (propertize "\n" 'occur-target marker))) (data @@ -1291,7 +1282,11 @@ (goto-char endpt)) (if endpt (progn - (setq lines (1+ lines)) + ;; Sum line numbers between first and last match lines. + (setq lines (+ lines (count-lines begpt endpt) + ;; Add 1 for empty last match line since + ;; count-lines returns 1 line less. + (if (and (bolp) (eolp)) 1 0))) ;; On to the next match... (forward-line 1)) (goto-char (point-max)))))) @@ -1335,6 +1330,18 @@ ;; Return the number of matches globalcount))) +(defun occur-engine-line (beg end &optional keep-props) + (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode) + (text-property-not-all beg end 'fontified t)) + (if (fboundp 'jit-lock-fontify-now) + (jit-lock-fontify-now beg end))) + (if (and keep-props (not (eq occur-excluded-properties t))) + (let ((str (buffer-substring beg end))) + (remove-list-of-text-properties + 0 (length str) occur-excluded-properties str) + str) + (buffer-substring-no-properties beg end))) + ;; Generate context display for occur. ;; OUT-LINE is the line where the match is. ;; NLINES and KEEP-PROPS are args to occur-engine.
--- a/test/ChangeLog Tue Mar 23 08:04:35 2010 +0100 +++ b/test/ChangeLog Tue Mar 23 20:32:31 2010 +0100 @@ -1,3 +1,7 @@ +2010-03-23 Juri Linkov <juri@jurta.org> + + * occur-testsuite.el: New file. + 2010-03-10 Chong Yidong <cyd@stupidchicken.com> * Branch for 23.2.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/occur-testsuite.el Tue Mar 23 20:32:31 2010 +0100 @@ -0,0 +1,140 @@ +;;; occur-testsuite.el --- Test suite for occur. + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Juri Linkov <juri@jurta.org> +;; Keywords: matching, internal + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Type M-x test-occur RET to test the functionality of `occur'. + +;;; Code: + +(defconst occur-tests + '( + ;; * Test one-line matches (at bob, eob, bol, eol). + ("x" 0 "\ +xa +b +cx +xd +xex +fx +" "\ +5 matches for \"x\" in buffer: *temp* + 1:xa + 3:cx + 4:xd + 5:xex + 6:fx +") + ;; * Test multi-line matches, this is the first test from + ;; http://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html + ;; where numbers are replaced with letters. + ("a\na" 0 "\ +a +a +a +a +a +" "\ +2 matches for \"a^Ja\" in buffer: *temp* + 1:a + :a + 3:a + :a +") + ;; * Test multi-line matches, this is the second test from + ;; http://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html + ;; where numbers are replaced with letters. + ("a\nb" 0 "\ +a +b +c +a +b +" "\ +2 matches for \"a^Jb\" in buffer: *temp* + 1:a + :b + 4:a + :b +") + ;; * Test line numbers for multi-line matches with empty last match line. + ("a\n" 0 "\ +a + +c +a + +" "\ +2 matches for \"a^J\" in buffer: *temp* + 1:a + : + 4:a + : +") + ;; * Test multi-line matches with 3 match lines. + ("x\n.x\n" 0 "\ +ax +bx +c +d +ex +fx +" "\ +2 matches for \"x^J.x^J\" in buffer: *temp* + 1:ax + :bx + :c + 5:ex + :fx + : +") + ) + "List of tests for `occur'. +Each element has the format: +\(REGEXP NLINES INPUT-BUFFER-STRING OUTPUT-BUFFER-STRING).") + +(defun test-occur () + (interactive) + (let ((count 1) + failed + (occur-hook nil)) + (dolist (test occur-tests) + (let ((regexp (nth 0 test)) + (nlines (nth 1 test)) + (input-buffer-string (nth 2 test)) + (output-buffer-string (nth 3 test))) + (save-excursion + (with-temp-buffer + (insert input-buffer-string) + (occur regexp nlines) + (unless (equal output-buffer-string + (with-current-buffer "*Occur*" + (buffer-string))) + (setq failed (cons count failed)))))) + (setq count (1+ count))) + (if failed + (message "FAILED TESTS: %S" (reverse failed)) + (message "SUCCESS")))) + +(provide 'occur-testsuite) + +;;; occur-testsuite.el ends here