Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 102251. ------------------------------------------------------------ revno: 102251 committer: Glenn Morris branch nick: trunk timestamp: Thu 2010-11-04 17:01:59 -0700 message: ChangeLog fix. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-11-04 22:37:06 +0000 +++ src/ChangeLog 2010-11-05 00:01:59 +0000 @@ -1,7 +1,7 @@ 2010-11-04 Lars Magne Ingebrigtsen - * Refer to set-coding-system-priority instead of the obsolete - set-coding-priority in the doc string. + * coding.c (coding-category-list): Refer to set-coding-system-priority + instead of the obsolete set-coding-priority in the doc string. 2010-11-04 Adrian Robert Ismail Donmez (tiny change) ------------------------------------------------------------ revno: 102250 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Thu 2010-11-04 23:37:06 +0100 message: Refer to set-coding-system-priority instead of the obsolete set-coding-priority in the doc string. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-11-04 18:22:12 +0000 +++ src/ChangeLog 2010-11-04 22:37:06 +0000 @@ -1,3 +1,8 @@ +2010-11-04 Lars Magne Ingebrigtsen + + * Refer to set-coding-system-priority instead of the obsolete + set-coding-priority in the doc string. + 2010-11-04 Adrian Robert Ismail Donmez (tiny change) === modified file 'src/coding.c' --- src/coding.c 2010-11-01 04:09:26 +0000 +++ src/coding.c 2010-11-04 22:37:06 +0000 @@ -10559,7 +10559,7 @@ one algorithm agrees with a byte sequence of source text, the coding system bound to the corresponding coding-category is selected. -Don't modify this variable directly, but use `set-coding-priority'. */); +Don't modify this variable directly, but use `set-coding-system-priority'. */); { int i; ------------------------------------------------------------ revno: 102249 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2010-11-04 22:18:09 +0000 message: Merge changes made in Gnus trunk. mm-decode.el (mm-save-part): Put the entire path in the `M-n' slot. nnimap.el (nnimap-find-article-by-message-id): Don't EXAMINE a group if it's already selected. gnus.texi (Customizing the IMAP Connection): Document `nnimap-expunge' and remove `nnimap-expunge-inbox' from example. gnus.texi (Customizing the IMAP Connection): Remove nnir mention, since that works by default. gnus-sum.el (gnus-summary-show-article): Take `t' as the arg to mean "raw". gnus-html.el (gnus-html-browse-url): Implement mailto: URLs. shr.el (shr-browse-url): Implement mailto: URLs. nnir.el, gnus-sum.el: Improve thread-referral. message.el (message-send-mail): Use the value of message-courtesy-message from the message buffer. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-11-04 13:30:20 +0000 +++ doc/misc/ChangeLog 2010-11-04 22:18:09 +0000 @@ -1,3 +1,13 @@ +2010-11-04 Lars Magne Ingebrigtsen + + * gnus.texi (Customizing the IMAP Connection): Remove nnir mention, + since that works by default. + +2010-11-03 Kan-Ru Chen (tiny change) + + * gnus.texi (Customizing the IMAP Connection): Document + `nnimap-expunge' and remove `nnimap-expunge-inbox' from example. + 2010-11-04 Michael Albinus * tramp.texi (Remote shell setup): New item "Interactive shell === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2010-11-03 03:53:12 +0000 +++ doc/misc/gnus.texi 2010-11-04 22:18:09 +0000 @@ -14845,9 +14845,7 @@ (nnimap-inbox "INBOX") (nnimap-split-methods default) (nnimap-expunge t) - (nnimap-stream ssl) - (nnir-search-engine imap) - (nnimap-expunge-inbox t)) + (nnimap-stream ssl)) @end example @table @code @@ -14883,6 +14881,11 @@ Some @acronym{IMAP} servers allow anonymous logins. In that case, this should be set to @code{anonymous}. +@item nnimap-expunge +If non-@code{nil}, expunge articles after deleting them. This is always done +if the server supports UID EXPUNGE, but it's not done by default on +servers that doesn't support that command. + @item nnimap-streaming Virtually all @code{IMAP} server support fast streaming of data. If you have problems connecting to the server, try setting this to @code{nil}. === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-11-04 11:00:25 +0000 +++ lisp/gnus/ChangeLog 2010-11-04 22:18:09 +0000 @@ -1,3 +1,32 @@ +2010-11-04 Andrew Cohen + + * nnir.el (gnus-summary-nnir-goto-thread): limiting work done by + gnus-summary-refer-thread. + + * gnus-sum.el (gnus-build-all-threads): force updating of dependency + headers. + (gnus-summary-limit-include-thread): prevent articles in thread from + being cut in gnus-cut-threads. + (gnus-summary-refer-thread): limit retrieved headers to those in + thread. + +2010-11-04 Lars Magne Ingebrigtsen + + * message.el (message-send-mail): Use the value of + message-courtesy-message from the message buffer. + + * gnus-html.el (gnus-html-browse-url): Implement mailto: URLs. + + * shr.el (shr-browse-url): Implement mailto: URLs. + + * gnus-sum.el (gnus-summary-show-article): Take `t' as the arg to mean + "raw". + + * nnimap.el (nnimap-find-article-by-message-id): Don't EXAMINE a group + if it's already selected. + + * mm-decode.el (mm-save-part): Put the entire path in the `M-n' slot. + 2010-11-04 Katsumi Yamaoka * shr.el (shr-tag-img): Use string-width and truncate-string-to-width === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-11-02 04:08:43 +0000 +++ lisp/gnus/gnus-html.el 2010-11-04 22:18:09 +0000 @@ -350,9 +350,13 @@ "Browse the image under point." (interactive) (let ((url (get-text-property (point) 'gnus-string))) - (if (not url) - (message "No URL at point") - (browse-url url)))) + (cond + ((not url) + (message "No link under point")) + ((string-match "^mailto:" url) + (gnus-url-mailto url)) + (t + (browse-url url))))) (defun gnus-html-schedule-image-fetching (buffer image) "Retrieve IMAGE, and place it into BUFFER on arrival." === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2010-11-01 23:11:37 +0000 +++ lisp/gnus/gnus-sum.el 2010-11-04 22:18:09 +0000 @@ -4506,7 +4506,7 @@ (while (not (eobp)) (ignore-errors (setq article (read (current-buffer)) - header (gnus-nov-parse-line article dependencies))) + header (gnus-nov-parse-line article dependencies t))) (when header (with-current-buffer gnus-summary-buffer (push header gnus-newsgroup-headers) @@ -8445,7 +8445,11 @@ article." (interactive (list (mail-header-id (gnus-summary-article-header)))) (let ((articles (gnus-articles-in-thread - (gnus-id-to-thread (gnus-root-id id))))) + (gnus-id-to-thread (gnus-root-id id)))) + ;;we REALLY want the whole thread---this prevents cut-threads + ;;from removing the thread we want to include. + (gnus-fetch-old-headers nil) + (gnus-build-sparse-threads nil)) (prog1 (gnus-summary-limit (nconc articles gnus-newsgroup-limit)) (gnus-summary-limit-include-matching-articles @@ -8832,7 +8836,13 @@ variable." (interactive "P") (let ((id (mail-header-id (gnus-summary-article-header))) + (subject (gnus-simplify-subject + (mail-header-subject (gnus-summary-article-header)))) + (refs (split-string (or (mail-header-references + (gnus-summary-article-header)) ""))) (gnus-summary-ignore-duplicates t) + (gnus-inhibit-demon t) + (gnus-read-all-available-headers t) (limit (if limit (prefix-numeric-value limit) gnus-refer-thread-limit))) (if (gnus-check-backend-function 'request-thread gnus-newsgroup-name) @@ -8859,6 +8869,11 @@ (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)))) (when (eq gnus-headers-retrieved-by 'nov) + ;; might as well restrict the headers to the relevant ones. this + ;; should save time when building threads. + (with-current-buffer nntp-server-buffer + (goto-char (point-min)) + (keep-lines (regexp-opt (append refs (list id subject))))) (gnus-build-all-threads)) (gnus-summary-limit-include-thread id))) @@ -9423,7 +9438,8 @@ ((not arg) ;; Select the article the normal way. (gnus-summary-select-article nil 'force)) - ((equal arg '(16)) + ((or (equal arg '(16)) + (eq arg t)) ;; C-u C-u g ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. === modified file 'lisp/gnus/message.el' --- lisp/gnus/message.el 2010-10-31 22:49:28 +0000 +++ lisp/gnus/message.el 2010-11-04 22:18:09 +0000 @@ -4498,7 +4498,9 @@ (string= "base64" (message-fetch-field "content-transfer-encoding"))))))) - (message-insert-courtesy-copy)) + (message-insert-courtesy-copy + (with-current-buffer mailbuf + message-courtesy-message))) ;; Let's make sure we encoded all the body. (assert (save-excursion (goto-char (point-min)) @@ -5939,7 +5941,7 @@ ;; Check for IDNA (message-idna-to-ascii-rhs)))) -(defun message-insert-courtesy-copy () +(defun message-insert-courtesy-copy (message) "Insert a courtesy message in mail copies of combined messages." (let (newsgroups) (save-excursion @@ -5949,12 +5951,12 @@ (goto-char (point-max)) (insert "Posted-To: " newsgroups "\n"))) (forward-line 1) - (when message-courtesy-message + (when message (cond - ((string-match "%s" message-courtesy-message) - (insert (format message-courtesy-message newsgroups))) + ((string-match "%s" message) + (insert (format message newsgroups))) (t - (insert message-courtesy-message))))))) + (insert message))))))) ;;; ;;; Setting up a message buffer === modified file 'lisp/gnus/mm-decode.el' --- lisp/gnus/mm-decode.el 2010-11-01 01:45:47 +0000 +++ lisp/gnus/mm-decode.el 2010-11-04 22:18:09 +0000 @@ -1251,11 +1251,13 @@ (setq filename (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)))) (setq file - (read-file-name (or prompt - (format "Save MIME part to (default %s): " - (or filename ""))) - (or mm-default-directory default-directory) - (or filename ""))) + (read-file-name + (or prompt + (format "Save MIME part to (default %s): " + (or filename ""))) + (or mm-default-directory default-directory) + (expand-file-name (or filename "") + (or mm-default-directory default-directory)))) (if (file-directory-p file) (setq file (expand-file-name filename file)) (setq file (expand-file-name === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2010-11-01 22:21:10 +0000 +++ lisp/gnus/nnimap.el 2010-11-04 22:18:09 +0000 @@ -731,8 +731,6 @@ ;; to examine a mailbox that doesn't exist. This seems to be ;; the only way that allows us to reliably go back to unselected ;; state on Courier. - (nnimap-command "EXAMINE DOES.NOT.EXIST") - (setf (nnimap-group nnimap-object) nil) (car (nnimap-command "RENAME %S %S" (utf7-encode group t) (utf7-encode new-name t)))))) @@ -863,8 +861,9 @@ (defun nnimap-find-article-by-message-id (group message-id) (with-current-buffer (nnimap-buffer) (erase-buffer) - (setf (nnimap-group nnimap-object) nil) - (nnimap-send-command "EXAMINE %S" (utf7-encode group t)) + (unless (equal group (nnimap-group nnimap-object)) + (setf (nnimap-group nnimap-object) nil) + (nnimap-send-command "EXAMINE %S" (utf7-encode group t))) (let ((sequence (nnimap-send-command "UID SEARCH HEADER Message-Id %S" message-id)) article result) === modified file 'lisp/gnus/nnir.el' --- lisp/gnus/nnir.el 2010-11-03 01:06:33 +0000 +++ lisp/gnus/nnir.el 2010-11-04 22:18:09 +0000 @@ -510,7 +510,6 @@ (cdr (assoc "SEARCH" (cdr result)))))))))) (gnus-summary-read-group-1 group t t gnus-summary-buffer nil (list backend-number)) - (gnus-summary-limit (list backend-number)) (gnus-summary-refer-thread)))) === modified file 'lisp/gnus/shr.el' --- lisp/gnus/shr.el 2010-11-04 11:00:25 +0000 +++ lisp/gnus/shr.el 2010-11-04 22:18:09 +0000 @@ -340,9 +340,13 @@ "Browse the URL under point." (interactive) (let ((url (get-text-property (point) 'shr-url))) - (if (not url) - (message "No link under point") - (browse-url url)))) + (cond + ((not url) + (message "No link under point")) + ((string-match "^mailto:" url) + (gnus-url-mailto url)) + (t + (browse-url url))))) (defun shr-save-contents (directory) "Save the contents from URL in a file." ------------------------------------------------------------ revno: 102248 committer: Glenn Morris branch nick: trunk timestamp: Thu 2010-11-04 11:22:12 -0700 message: ChangeLog fix. Ref: http://lists.gnu.org/archive/html/emacs-devel/2010-11/msg00133.html diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-11-04 18:10:50 +0000 +++ src/ChangeLog 2010-11-04 18:22:12 +0000 @@ -1,9 +1,10 @@ 2010-11-04 Adrian Robert + Ismail Donmez (tiny change) * nsfont.m (nsfont_draw) * nsimage.m (EmacsImage-setXBMColor:) * nsterm.m (EmacsView-performDragOperation:): Correct empty return - statements. Based on a patch by Ismail Donmez . + statements. 2010-11-03 Julien Danjou ------------------------------------------------------------ revno: 102247 committer: Sam Steingold branch nick: trunk timestamp: Thu 2010-11-04 14:17:38 -0400 message: identify "refentry" as DocBook diff: === modified file 'etc/schema/schemas.xml' --- etc/schema/schemas.xml 2010-01-13 08:35:10 +0000 +++ etc/schema/schemas.xml 2010-11-04 18:17:38 +0000 @@ -22,7 +22,7 @@ - + @@ -39,10 +39,11 @@ + - + ------------------------------------------------------------ revno: 102246 committer: Adrian Robert branch nick: trunk timestamp: Thu 2010-11-04 20:10:50 +0200 message: * nsfont.m (nsfont_draw) * nsimage.m (EmacsImage-setXBMColor:) * nsterm.m (EmacsView-performDragOperation:): Correct empty return statements. Based on a patch by Ismail Donmez . diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-11-03 20:08:48 +0000 +++ src/ChangeLog 2010-11-04 18:10:50 +0000 @@ -1,3 +1,10 @@ +2010-11-04 Adrian Robert + + * nsfont.m (nsfont_draw) + * nsimage.m (EmacsImage-setXBMColor:) + * nsterm.m (EmacsView-performDragOperation:): Correct empty return + statements. Based on a patch by Ismail Donmez . + 2010-11-03 Julien Danjou * image.c (gif_load): Add support for transparency and specified === modified file 'src/nsfont.m' --- src/nsfont.m 2010-08-11 08:58:56 +0000 +++ src/nsfont.m 2010-11-04 18:10:50 +0000 @@ -1211,7 +1211,6 @@ DPSstroke (context); DPSgrestore (context); - return to-from; } #else /* NS_IMPL_COCOA */ @@ -1280,10 +1279,9 @@ } CGContextRestoreGState (gcontext); - return; } #endif /* NS_IMPL_COCOA */ - + return to-from; } === modified file 'src/nsimage.m' --- src/nsimage.m 2010-09-04 19:39:34 +0000 +++ src/nsimage.m 2010-11-04 18:10:50 +0000 @@ -336,7 +336,7 @@ NSColor *rgbColor; if (bmRep == nil || color == nil) - return; + return self; if ([color colorSpaceName] != NSCalibratedRGBColorSpace) rgbColor = [color colorUsingColorSpaceName: NSCalibratedRGBColorSpace]; @@ -361,6 +361,8 @@ planes[2][i] = bb; } } + + return self; } === modified file 'src/nsterm.m' --- src/nsterm.m 2010-10-29 00:50:13 +0000 +++ src/nsterm.m 2010-11-04 18:10:50 +0000 @@ -5436,7 +5436,7 @@ NSTRACE (performDragOperation); if (!emacs_event) - return; + return NO; position = [self convertPoint: [sender draggingLocation] fromView: nil]; x = lrint (position.x); y = lrint (position.y); ------------------------------------------------------------ revno: 102245 committer: Chong Yidong branch nick: trunk timestamp: Thu 2010-11-04 13:00:43 -0400 message: Notes about elpa.gnu.org for maintainers. diff: === added file 'admin/notes/elpa' --- admin/notes/elpa 1970-01-01 00:00:00 +0000 +++ admin/notes/elpa 2010-11-04 17:00:43 +0000 @@ -0,0 +1,42 @@ +NOTES ON THE EMACS PACKAGE ARCHIVE + +Here are instructions on uploading files to the package archive at +elpa.gnu.org, for Emacs maintainers. (If you are not a maintainer, +contact us if you want to submit a package.) + +1. You will need login access to elpa.gnu.org. You will also need to + get the FSF sysadmins to allow ssh access through the FSF firewall + for your local machine. Ensure that your uid, USER, is in the + `elpa' group on elpa.gnu.org; this gives you write access to the + bzr repository from which the packages are managed. + +2. Go to your bzr repository on your local machine. Of, if you don't + have one (you should, if you're tracking Emacs bzr), make one: + + cd $DEVHOME + bzr init-repo elpa/ + cd elpa + + Create a branch for elpa: + + bzr branch bzr+ssh://USER@elpa.gnu.org/home/elpa/package-repo package-repo + + Bind the branch: + + cd package-repo/ + echo "public_branch = bzr+ssh://USER@elpa.gnu.org/home/elpa/package-repo" >> .bzr/branch/branch.conf + bzr bind bzr+ssh://USER@elpa.gnu.org/home/elpa/package-repo + + Now you should be able to do `bzr up' and `bzr commit'. + +3. Changes in bzr do not immediately propagate to the user-facing tree + (i.e., what users see when they do `M-x list-packages'). That tree + is created by a (daily) cron job that does "bzr export". If for + some reason you need to refresh the user-facing tree immediately, + run /home/elpa/bin/package-update.sh as the "elpa" user. + + The Org mode dailies are not part of the repository. After the + package-update.sh script creates the user-facing tree, it copies + the daily tarfile hosted on orgmode.org directly into that tree. + +4. FIXME: How to actually upload a package file. ------------------------------------------------------------ revno: 102244 committer: Michael Albinus branch nick: trunk timestamp: Thu 2010-11-04 14:30:20 +0100 message: * tramp.texi (Remote shell setup): New item "Interactive shell prompt". Reported by Christian Millour . (Remote shell setup, Remote processes): Use @code{} for environment variables. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-11-03 03:53:12 +0000 +++ doc/misc/ChangeLog 2010-11-04 13:30:20 +0000 @@ -1,3 +1,10 @@ +2010-11-04 Michael Albinus + + * tramp.texi (Remote shell setup): New item "Interactive shell + prompt". Reported by Christian Millour . + (Remote shell setup, Remote processes): Use @code{} for + environment variables. + 2010-11-03 Glenn Morris * ediff.texi (Quick Help Commands, Miscellaneous): === modified file 'doc/misc/tramp.texi' --- doc/misc/tramp.texi 2010-10-03 15:09:11 +0000 +++ doc/misc/tramp.texi 2010-11-04 13:30:20 +0000 @@ -1942,7 +1942,7 @@ this line. Another example is the tilde (@code{~}) character, say when adding -@file{~/bin} to @code{$PATH}. Many Bourne shells will not expand this +@file{~/bin} to @code{PATH}. Many Bourne shells will not expand this character, and since there is usually no directory whose name consists of the single character tilde, strange things will happen. @@ -1969,6 +1969,38 @@ @command{exec /bin/sh} step. But how to find out if the shell is Bourne-ish? + +@item Interactive shell prompt + +@value{tramp} redefines the shell prompt in order to parse the shell's +output robustly. When calling an interactive shell by @kbd{M-x +shell}, this doesn't look nice. + +You can redefine the shell prompt by checking the environment variable +@code{INSIDE_EMACS}, which is set by @value{tramp}, in your startup +script @file{~/.emacs_SHELLNAME}. @code{SHELLNAME} might be the string +@code{bash} or similar, in case of doubt you could set it the +environment variable @code{ESHELL} in your @file{.emacs}: + +@lisp +(setenv "ESHELL" "bash") +@end lisp + +Your file @file{~/.emacs_SHELLNAME} could contain code like + +@example +# Reset the prompt for remote Tramp shells. +if [ "$@{INSIDE_EMACS/*tramp*/tramp@}" == "tramp" ] ; then + PS1="[\u@@\h \w]$ " +fi +@end example + +@ifinfo +@ifset emacs +@xref{Interactive Shell, , , @value{emacsdir}}. +@end ifset +@end ifinfo + @end table @@ -2493,7 +2525,7 @@ Changing or removing an existing entry is not encouraged. The default values are chosen for proper @value{tramp} work. Nevertheless, if for example a paranoid system administrator disallows changing the -@var{$HISTORY} environment variable, you can customize +@code{HISTORY} environment variable, you can customize @code{tramp-remote-process-environment}, or you can apply the following code in your @file{.emacs}: @@ -2512,7 +2544,7 @@ If you want to run a remote program, which shall connect the X11 server you are using with your local host, you can set the -@var{$DISPLAY} environment variable on the remote host: +@code{DISPLAY} environment variable on the remote host: @lisp (add-to-list 'tramp-remote-process-environment ------------------------------------------------------------ revno: 102243 committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2010-11-04 11:00:25 +0000 message: shr.el (shr-tag-img): Use string-width and truncate-string-to-width to measure the length and truncate alt text. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-11-03 03:25:23 +0000 +++ lisp/gnus/ChangeLog 2010-11-04 11:00:25 +0000 @@ -1,3 +1,8 @@ +2010-11-04 Katsumi Yamaoka + + * shr.el (shr-tag-img): Use string-width and truncate-string-to-width + to measure the length and truncate alt text. + 2010-11-03 Glenn Morris * nndiary.el (nndiary-generate-nov-databases-1) === modified file 'lisp/gnus/shr.el' --- lisp/gnus/shr.el 2010-11-01 06:16:46 +0000 +++ lisp/gnus/shr.el 2010-11-04 11:00:25 +0000 @@ -551,8 +551,8 @@ (string-match shr-blocked-images url))) (setq shr-start (point)) (let ((shr-state 'space)) - (if (> (length alt) 8) - (shr-insert (substring alt 0 8)) + (if (> (string-width alt) 8) + (shr-insert (truncate-string-to-width alt 8)) (shr-insert alt)))) ((url-is-cached (shr-encode-url url)) (shr-put-image (shr-get-image-data url) alt)) ------------------------------------------------------------ revno: 102242 committer: Chong Yidong branch nick: trunk timestamp: Wed 2010-11-03 19:21:51 -0400 message: * emacs-lisp/package.el (package-unpack): Remove no-op. (package--builtins, package--dir): Doc fix. (package-activate-1, package-activate, package-install) (package-compute-transaction): Fix error message. (package-delete): Use delete-directory. Omit system packages. (package-initialize): Set package-alist to nil first. (package-menu-mark-delete, package-menu-mark-install): Don't add symbols that are inconsistent with the package state. (package-menu-execute): Perform deletions and installations as single batch operations. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-11-03 08:03:42 +0000 +++ lisp/ChangeLog 2010-11-03 23:21:51 +0000 @@ -1,3 +1,16 @@ +2010-11-03 Chong Yidong + + * emacs-lisp/package.el (package-unpack): Remove no-op. + (package--builtins, package--dir): Doc fix. + (package-activate-1, package-activate, package-install) + (package-compute-transaction): Fix error message. + (package-delete): Use delete-directory. Omit system packages. + (package-initialize): Set package-alist to nil first. + (package-menu-mark-delete, package-menu-mark-install): Don't add + symbols that are inconsistent with the package state. + (package-menu-execute): Perform deletions and installations as + single batch operations. + 2010-11-03 Glenn Morris * progmodes/idlwave.el (idlwave-pset): Only used on XEmacs. === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2010-11-03 03:25:36 +0000 +++ lisp/emacs-lisp/package.el 2010-11-03 23:21:51 +0000 @@ -77,7 +77,7 @@ ;; Other external functions you may want to use: ;; -;; M-x package-list-packages +;; M-x list-packages ;; Enters a mode similar to buffer-menu which lets you manage ;; packages. You can choose packages for install (mark with "i", ;; then "x" to execute) or deletion (not implemented yet), and you @@ -215,7 +215,6 @@ (declare-function url-http-parse-response "url-http" ()) (declare-function lm-header "lisp-mnt" (header)) (declare-function lm-commentary "lisp-mnt" (&optional file)) -(declare-function dired-delete-file "dired" (file &optional recursive trash)) (defvar url-http-end-of-headers) (defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/")) @@ -278,9 +277,12 @@ ;; until it's needed (i.e. when `package-intialize' is called). (defvar package--builtins nil "Alist of built-in packages. +The actual value is initialized by loading the library +`finder-inf'; this is not done until it is needed, e.g. by the +function `package-built-in-p'. + Each element has the form (PKG . DESC), where PKG is a package name (a symbol) and DESC is a vector that describes the package. - The vector DESC has the form [VERSION REQS DOCSTRING]. VERSION is a version list. REQS is a list of packages (symbols) required by the package. @@ -389,8 +391,10 @@ "Extract the kind of download from an archive package description vector." (aref desc 3)) -(defun package--dir (name version-string) - (let* ((subdir (concat name "-" version-string)) +(defun package--dir (name version) + "Return the directory where a package is installed, or nil if none. +NAME and VERSION are both strings." + (let* ((subdir (concat name "-" version)) (dir-list (cons package-user-dir package-directory-list)) pkg-dir) (while dir-list @@ -406,7 +410,7 @@ (version-str (package-version-join (package-desc-vers pkg-vec))) (pkg-dir (package--dir name version-str))) (unless pkg-dir - (error "Internal error: could not find directory for %s-%s" + (error "Internal error: unable to find directory for `%s-%s'" name version-str)) ;; Add info node. (when (file-exists-p (expand-file-name "dir" pkg-dir)) @@ -457,7 +461,7 @@ (throw 'dep-failure req)))))) (if fail (warn "Unable to activate package `%s'. -Required package `%s', version %s, is unavailable" +Required package `%s-%s' is unavailable" package (car fail) (package-version-join (cadr fail))) ;; If all goes well, activate the package itself. (package-activate-1 package pkg-vec))))))) @@ -565,12 +569,8 @@ (defun package-unpack (name version) (let ((pkg-dir (expand-file-name (concat (symbol-name name) "-" version) package-user-dir))) - ;; Be careful!! (make-directory package-user-dir t) - (if (file-directory-p pkg-dir) - (mapc (lambda (file) nil) ; 'delete-file -- FIXME: when we're - ; more confident - (directory-files pkg-dir t "^[^.]"))) + ;; FIXME: should we delete PKG-DIR if it exists? (let* ((default-directory (file-name-as-directory package-user-dir))) (package-untar-buffer) (package-generate-autoloads (symbol-name name) pkg-dir) @@ -608,7 +608,7 @@ (mapcar (lambda (elt) (list (car elt) - (package-version-join (car (cdr elt))))) + (package-version-join (cadr elt)))) requires)))) "\n") nil @@ -698,18 +698,18 @@ ((null (stringp hold)) (error "Invalid element in `package-load-list'")) ((version-list-< (version-to-list hold) next-version) - (error "Package '%s' held at version %s, \ + (error "Package `%s' held at version %s, \ but version %s required" (symbol-name next-pkg) hold (package-version-join next-version))))) (unless pkg-desc - (error "Package '%s', version %s, unavailable for installation" + (error "Package `%s-%s' is unavailable" (symbol-name next-pkg) (package-version-join next-version))) (unless (version-list-<= next-version (package-desc-vers (cdr pkg-desc))) (error - "Need package '%s' with version %s, but only %s is available" + "Need package `%s-%s', but only %s is available" (symbol-name next-pkg) (package-version-join next-version) (package-version-join (package-desc-vers (cdr pkg-desc))))) ;; Only add to the transaction if we don't already have it. @@ -819,7 +819,7 @@ nil t)))) (let ((pkg-desc (assq name package-archive-contents))) (unless pkg-desc - (error "Package '%s' is not available for installation" + (error "Package `%s' is not available for installation" (symbol-name name))) (package-download-transaction (package-compute-transaction (list name) @@ -976,11 +976,16 @@ (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) (defun package-delete (name version) - (require 'dired) ; for dired-delete-file - (dired-delete-file (expand-file-name (concat name "-" version) - package-user-dir) - ;; FIXME: query user? - 'always)) + (let ((dir (package--dir name version))) + (if (string-equal (file-name-directory dir) + (file-name-as-directory + (expand-file-name package-user-dir))) + (progn + (delete-directory dir t t) + (message "Package `%s-%s' deleted." name version)) + ;; Don't delete "system" packages + (error "Package `%s-%s' is a system package, not deleting" + name version)))) (defun package-archive-url (name) "Return the archive containing the package NAME." @@ -1030,7 +1035,8 @@ The variable `package-load-list' controls which packages to load. If optional arg NO-ACTIVATE is non-nil, don't activate packages." (interactive) - (setq package-obsolete-alist nil) + (setq package-alist nil + package-obsolete-alist nil) (package-load-all-descriptors) (package-read-all-archive-contents) (unless no-activate @@ -1361,12 +1367,16 @@ (defun package-menu-mark-delete (num) "Mark a package for deletion and move to the next line." (interactive "p") - (package-menu-mark-internal "D")) + (if (string-equal (package-menu-get-status) "installed") + (package-menu-mark-internal "D") + (forward-line))) (defun package-menu-mark-install (num) "Mark a package for installation and move to the next line." (interactive "p") - (package-menu-mark-internal "I")) + (if (string-equal (package-menu-get-status) "available") + (package-menu-mark-internal "I") + (forward-line))) (defun package-menu-mark-unmark (num) "Clear any marks on a package and move to the next line." @@ -1420,34 +1430,58 @@ ""))) (defun package-menu-execute () - "Perform all the marked actions. -Packages marked for installation will be downloaded and -installed. Packages marked for deletion will be removed. -Note that after installing packages you will want to restart -Emacs." + "Perform marked Package Menu actions. +Packages marked for installation are downloaded and installed; +packages marked for deletion are removed." (interactive) - (goto-char (point-min)) - (while (not (eobp)) - (let ((cmd (char-after)) - (pkg-name (package-menu-get-package)) - (pkg-vers (package-menu-get-version)) - (pkg-status (package-menu-get-status))) - (cond - ((eq cmd ?D) - (when (and (string= pkg-status "installed") - (string= pkg-name "package")) - ;; FIXME: actually, we could be tricky and remove all info. - ;; But that is drastic and the user can do that instead. - (error "Can't delete most recent version of `package'")) - ;; Ask for confirmation here? Maybe if package status is ""? - ;; Or if any lisp from package is actually loaded? - (message "Deleting %s-%s..." pkg-name pkg-vers) - (package-delete pkg-name pkg-vers) - (message "Deleting %s-%s... done" pkg-name pkg-vers)) - ((eq cmd ?I) - (package-install (intern pkg-name))))) - (forward-line)) - (package-menu-revert)) + (let (install-list delete-list cmd) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (setq cmd (char-after)) + (cond + ((eq cmd ?\s) t) + ((eq cmd ?D) + (push (cons (package-menu-get-package) + (package-menu-get-version)) + delete-list)) + ((eq cmd ?I) + (push (package-menu-get-package) install-list))) + (forward-line))) + ;; Delete packages, prompting if necessary. + (when delete-list + (if (yes-or-no-p + (if (= (length delete-list) 1) + (format "Delete package `%s-%s'? " + (caar delete-list) + (cdr (car delete-list))) + (format "Delete these %d packages (%s)? " + (length delete-list) + (mapconcat (lambda (elt) + (concat (car elt) "-" (cdr elt))) + delete-list + ", ")))) + (dolist (elt delete-list) + (condition-case err + (package-delete (car elt) (cdr elt)) + (error (message (cadr err))))) + (error "Aborted"))) + (when install-list + (if (yes-or-no-p + (if (= (length install-list) 1) + (format "Install package `%s'? " (car install-list)) + (format "Install these %d packages (%s)? " + (length install-list) + (mapconcat 'identity install-list ", ")))) + (dolist (elt install-list) + (package-install (intern elt))))) + ;; If we deleted anything, regenerate `package-alist'. This is done + ;; automatically if we installed a package. + (and delete-list (null install-list) + (package-initialize)) + (if (or delete-list install-list) + (package-menu-revert) + (message "No operations specified.")))) (defun package-print-package (package version key desc) (let ((face