Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 103251. ------------------------------------------------------------ revno: 103251 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-02-12 22:07:53 -0500 message: Use simple buttons, instead of widget buttons, in vc-log. * lisp/vc/vc.el (vc-print-log-setup-buttons): Instead of using the widget library for buttons, just use button.el. * lisp/vc/log-view.el (log-view-mode-map): Don't inherit from widget-keymap. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-13 01:01:11 +0000 +++ lisp/ChangeLog 2011-02-13 03:07:53 +0000 @@ -1,3 +1,11 @@ +2011-02-13 Chong Yidong + + * vc/vc.el (vc-print-log-setup-buttons): Instead of using the + widget library for buttons, just use button.el. + + * vc/log-view.el (log-view-mode-map): Don't inherit from + widget-keymap. + 2011-02-12 Glenn Morris * emacs-lisp/cl-seq.el (union, nunion, intersection) === modified file 'lisp/vc/log-view.el' --- lisp/vc/log-view.el 2011-02-01 21:22:21 +0000 +++ lisp/vc/log-view.el 2011-02-13 03:07:53 +0000 @@ -147,7 +147,6 @@ ("\M-n" . log-view-file-next) ("\M-p" . log-view-file-prev)) "Log-View's keymap." - :inherit widget-keymap :group 'log-view) (easy-menu-define log-view-mode-menu log-view-mode-map === modified file 'lisp/vc/vc.el' --- lisp/vc/vc.el 2011-01-29 03:12:32 +0000 +++ lisp/vc/vc.el 2011-02-13 03:07:53 +0000 @@ -2014,22 +2014,20 @@ (goto-char (point-max)) (lexical-let ((working-revision working-revision) (limit limit)) - (widget-create 'push-button - :notify (lambda (&rest ignore) - (vc-print-log-internal - log-view-vc-backend log-view-vc-fileset - working-revision nil (* 2 limit))) - :help-echo "Show the log again, and double the number of log entries shown" - "Show 2X entries") - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (vc-print-log-internal - log-view-vc-backend log-view-vc-fileset - working-revision nil nil)) - :help-echo "Show the log again, showing all entries" - "Show unlimited entries")) - (widget-setup))) + (insert "\n") + (insert-text-button "Show 2X entries" + 'action (lambda (&rest ignore) + (vc-print-log-internal + log-view-vc-backend log-view-vc-fileset + working-revision nil (* 2 limit))) + 'help-echo "Show the log again, and double the number of log entries shown") + (insert " ") + (insert-text-button "Show unlimited entries" + 'action (lambda (&rest ignore) + (vc-print-log-internal + log-view-vc-backend log-view-vc-fileset + working-revision nil nil)) + 'help-echo "Show the log again, including all entries")))) (defun vc-print-log-internal (backend files working-revision &optional is-start-revision limit) ------------------------------------------------------------ revno: 103250 committer: Glenn Morris branch nick: trunk timestamp: Sat 2011-02-12 18:21:30 -0800 message: Add @top to some misc/*.texi files. * ada-mode.texi, dired-x.texi, ebrowse.texi, ediff.texi, eudc.texi: * idlwave.texi, reftex.texi, sc.texi, speedbar.texi: Add @top. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2011-02-13 00:25:29 +0000 +++ doc/misc/ChangeLog 2011-02-13 02:21:30 +0000 @@ -1,3 +1,8 @@ +2011-02-13 Glenn Morris + + * ada-mode.texi, dired-x.texi, ebrowse.texi, ediff.texi, eudc.texi: + * idlwave.texi, reftex.texi, sc.texi, speedbar.texi: Add @top. + 2011-02-12 Glenn Morris * sc.texi (Getting Connected): Remove old index entries. @@ -8,7 +13,8 @@ 2011-02-11 Teodor Zlatanov - * auth.texi (Overview, Help for users, Help for developers): Update docs. + * auth.texi (Overview, Help for users, Help for developers): + Update docs. (Help for users): Talk about spaces. 2011-02-09 Paul Eggert === modified file 'doc/misc/ada-mode.texi' --- doc/misc/ada-mode.texi 2011-01-25 04:08:28 +0000 +++ doc/misc/ada-mode.texi 2011-02-13 02:21:30 +0000 @@ -39,6 +39,7 @@ @contents @node Top, Overview, (dir), (dir) +@top Ada Mode @ifnottex @insertcopying === modified file 'doc/misc/dired-x.texi' --- doc/misc/dired-x.texi 2011-01-25 04:08:28 +0000 +++ doc/misc/dired-x.texi 2011-02-13 02:21:30 +0000 @@ -69,6 +69,7 @@ @ifnottex @node Top +@top Dired Extra @comment node-name, next, previous, up @noindent === modified file 'doc/misc/ebrowse.texi' --- doc/misc/ebrowse.texi 2011-01-25 04:08:28 +0000 +++ doc/misc/ebrowse.texi 2011-02-13 02:21:30 +0000 @@ -46,6 +46,7 @@ @ifnottex @node Top, Overview, (dir), (dir) +@top Ebrowse You can browse C++ class hierarchies from within Emacs by using Ebrowse. === modified file 'doc/misc/ediff.texi' --- doc/misc/ediff.texi 2011-01-25 04:08:28 +0000 +++ doc/misc/ediff.texi 2011-02-13 02:21:30 +0000 @@ -63,6 +63,7 @@ @contents @node Top, Introduction, (dir), (dir) +@top Ediff @insertcopying @@ -2540,4 +2541,3 @@ @printindex cp @bye - === modified file 'doc/misc/eudc.texi' --- doc/misc/eudc.texi 2011-01-25 04:08:28 +0000 +++ doc/misc/eudc.texi 2011-02-13 02:21:30 +0000 @@ -50,6 +50,7 @@ @ifnottex @node Top, Overview, (dir), (dir) +@top Emacs Unified Directory Client @comment node-name, next, previous, up @insertcopying === modified file 'doc/misc/idlwave.texi' --- doc/misc/idlwave.texi 2011-01-25 04:08:28 +0000 +++ doc/misc/idlwave.texi 2011-02-13 02:21:30 +0000 @@ -57,6 +57,7 @@ @ifnottex @node Top, Introduction, (dir), (dir) +@top IDLWAVE IDLWAVE is a package which supports editing source code written in the Interactive Data Language (IDL), and running IDL as an inferior shell. === modified file 'doc/misc/reftex.texi' --- doc/misc/reftex.texi 2011-01-25 04:08:28 +0000 +++ doc/misc/reftex.texi 2011-02-13 02:21:30 +0000 @@ -79,6 +79,7 @@ @ifnottex @node Top,,,(dir) +@top RefTeX @b{Ref@TeX{}} is a package for managing Labels, References, Citations and index entries with GNU Emacs. === modified file 'doc/misc/sc.texi' --- doc/misc/sc.texi 2011-02-12 23:40:43 +0000 +++ doc/misc/sc.texi 2011-02-13 02:21:30 +0000 @@ -53,6 +53,7 @@ @ifnottex @node Top, Introduction, (dir), (dir) +@top Supercite @comment node-name, next, previous, up @insertcopying === modified file 'doc/misc/speedbar.texi' --- doc/misc/speedbar.texi 2011-01-25 04:08:28 +0000 +++ doc/misc/speedbar.texi 2011-02-13 02:21:30 +0000 @@ -40,6 +40,7 @@ @node Top, , , (dir)Top @comment node-name, next, previous, up +@top Speedbar Speedbar is a program for Emacs which can be used to summarize information related to the current buffer. Its original inspiration ------------------------------------------------------------ revno: 103249 committer: Glenn Morris branch nick: trunk timestamp: Sat 2011-02-12 18:07:25 -0800 message: lwlib trivia. * lwlib/lwlib-utils.c (index, rindex): Don't undef (neither used in lwlib/, nor set in config.h). diff: === modified file 'lwlib/ChangeLog' --- lwlib/ChangeLog 2011-02-11 03:41:17 +0000 +++ lwlib/ChangeLog 2011-02-13 02:07:25 +0000 @@ -1,3 +1,8 @@ +2011-02-13 Glenn Morris + + * lwlib-utils.c (index, rindex): Don't undef (neither used in lwlib/, + nor set in config.h). + 2011-02-11 Glenn Morris * Makefile.in (USE_X_TOOLKIT, RM, TOOLKIT_DEFINES): Remove. === modified file 'lwlib/lwlib-utils.c' --- lwlib/lwlib-utils.c 2011-02-10 05:03:29 +0000 +++ lwlib/lwlib-utils.c 2011-02-13 02:07:25 +0000 @@ -24,13 +24,6 @@ #include #endif -/* Definitions of these in config.h can cause - declaration conflicts later on between declarations for index - and declarations for strchr. This file doesn't use - index and rindex, so cancel them. */ -#undef index -#undef rindex - #include #include ------------------------------------------------------------ revno: 103248 committer: Glenn Morris branch nick: trunk timestamp: Sat 2011-02-12 18:04:18 -0800 message: * make-dist: Exclude generated file src/globals.h. diff: === modified file 'ChangeLog' --- ChangeLog 2011-02-10 03:56:30 +0000 +++ ChangeLog 2011-02-13 02:04:18 +0000 @@ -1,3 +1,7 @@ +2011-02-13 Glenn Morris + + * make-dist: Exclude generated file src/globals.h. + 2011-02-10 Paul Eggert * arg-nonnull.h, c++defs.h, warn-on-use.h: Fix licenses. === modified file 'make-dist' --- make-dist 2011-01-31 08:12:52 +0000 +++ make-dist 2011-02-13 02:04:18 +0000 @@ -359,7 +359,7 @@ ln makefile.w32-in ../${tempdir}/src ln .gdbinit .dbxinit ../${tempdir}/src cd ../${tempdir}/src - rm -f config.h epaths.h Makefile buildobj.h) + rm -f globals.h config.h epaths.h Makefile buildobj.h) echo "Making links to \`src/bitmaps'" (cd src/bitmaps ------------------------------------------------------------ revno: 103247 committer: Glenn Morris branch nick: trunk timestamp: Sat 2011-02-12 17:01:11 -0800 message: Fix date of merged ChangeLog entries. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-13 00:25:29 +0000 +++ lisp/ChangeLog 2011-02-13 01:01:11 +0000 @@ -1,4 +1,4 @@ -2011-02-10 Glenn Morris +2011-02-12 Glenn Morris * emacs-lisp/cl-seq.el (union, nunion, intersection) (nintersection, set-difference, nset-difference) @@ -6,13 +6,9 @@ * ediff-ptch.el (ediff-fixup-patch-map): Doc fix. -2011-02-08 Glenn Morris - * faces.el (face-attr-match-p): Handle the obsolete :bold and :italic props, so that frame-set-background-mode works. (Bug#7966) -2011-02-07 Glenn Morris - * simple.el (next-error): Doc fix. 2011-02-12 Thierry Volpiatto ------------------------------------------------------------ revno: 103246 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2011-02-13 00:25:29 +0000 message: Merge changes made in Gnus trunk. auth.texi (Overview, Help for users, Help for developers): Update docs. (Help for users): Talk about spaces. sieve-manage.el: Autoload `auth-source-search'. (sieve-sasl-auth): Use it. nnimap.el: Autoload `auth-source-forget+'. (nnimap-open-connection-1): Use it if the connection fails. auth-source.el: Require `password-cache'. (auth-source-hide-passwords, auth-source-cache): Remove and mark obsolete. (auth-source-magic): Marker for `password-cache' keys. (auth-source-do-cache): Update docstring. (auth-source-search): Use and check cache. (auth-source-forget-all-cached, auth-source-remember) (auth-source-recall, auth-source-forget, auth-source-forget+) (auth-source-specmatchp): Caching support functions. (auth-source-forget-user-or-password, auth-source-forget-all-cached): Remove and obsolete. (auth-source-user-or-password): Remove caching to further discourage using it. Always hide passwords. password-cache.el (password-cache-remove): Accept secrets that are not strings. mail-source.el: Autoload `auth-source-search'. (mail-source-keyword-map): Note order matters. (mail-source-set-1): Get all the mail-source source values and defaults and search auth-source on those if needed. This can all probably be simplified. nnimap.el: Autoload `auth-source-search'. (nnimap-credentials): Use it. (nnimap-open-connection-1): Ask for the virtual server and physical address in one shot. nntp.el: Autoload `auth-source-search'. (nntp-send-authinfo): Use it. Note TODO. auth-source.el (auth-source-secrets-search, auth-source-user-or-password): Use `append' instead of `nconc'. (auth-source-user-or-password): Build return list better and protect against nil :secret. auth-source.el (top): Require 'eieio unconditionally. Autoload `secrets-get-attributes' instead of `secrets-get-attribute'. (auth-source-secrets-search): Limit search when `max' is greater than number of results. auth-source.el (auth-source-secrets-search): Add examples. auth-source.el (auth-sources): Allow for simpler defaults for Secrets API with a string "secrets:collection-name" and with 'default. (auth-source-backend-parse): Parse "secrets:collection-name" and 'default. Recurse on parses instead of repeating code. Use the Secrets API is the source is not nil and 'ignore otherwise. Emit a message when ignoring a source. (auth-source-search): List ignored search keys at the top level. (auth-source-netrc-create): Use `case' instead of `cond'. (auth-source-secrets-search): Created with TODOs. (auth-source-secrets-create): Created with TODOs. (auth-source-retrieve, auth-source-create, auth-source-delete) (auth-source-protocol-defaults, auth-source-user-or-password-imap) (auth-source-user-or-password-pop3, auth-source-user-or-password-ssh) (auth-source-user-or-password-sftp) (auth-source-user-or-password-smtp): Removed. (auth-source-user-or-password): Deprecated and modified to be a wrapper around `auth-source-search'. Not tested thoroughly. auth-source.el: Bring in assoc and eioeio libraries. (secrets-enabled): New variable to track the status of the Secrets API. (auth-source-backend): New EIOEIO class to represent a backend. (auth-source-creation-defaults): New variable to set prompt defaults during token creation (see the `auth-source-search' docstring for details). (auth-sources): Simplify to allow a simple string as a netrc backend spec. (auth-source-backend-parse): Parse a backend from an `auth-sources' spec. (auth-source-backend-parse-parameters): Fill in the backend parameters. (auth-source-search): Main auth-source API entry point. (auth-source-delete): Wrapper around `auth-source-search' for deletion. (auth-source-search-collection): Helper function for searching. (auth-source-netrc-parse, auth-source-netrc-normalize) (auth-source-netrc-search, auth-source-netrc-create): Netrc backend. Supports search, create, and delete. (auth-source-secrets-search, auth-source-secrets-create): Secrets API backend stubs. (auth-source-user-or-password): Call `auth-source-search' but it's not ready yet. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2011-02-12 23:40:43 +0000 +++ doc/misc/ChangeLog 2011-02-13 00:25:29 +0000 @@ -6,6 +6,11 @@ * url.texi: Remove duplicate @dircategory (Bug#7942). +2011-02-11 Teodor Zlatanov + + * auth.texi (Overview, Help for users, Help for developers): Update docs. + (Help for users): Talk about spaces. + 2011-02-09 Paul Eggert * texinfo.tex: Update to version 2011-02-07.16. === modified file 'doc/misc/auth.texi' --- doc/misc/auth.texi 2011-02-06 00:25:41 +0000 +++ doc/misc/auth.texi 2011-02-13 00:25:29 +0000 @@ -5,7 +5,7 @@ @setfilename ../../info/auth @settitle Emacs auth-source Library @value{VERSION} -@set VERSION 0.2 +@set VERSION 0.3 @copying This file describes the Emacs auth-source library. @@ -78,15 +78,19 @@ @chapter Overview The auth-source library is simply a way for Emacs and Gnus, among -others, to answer the old burning question ``I have a server name and -a port, what are my user name and password?'' - -The auth-source library actually supports more than just the user name -(known as the login) or the password, but only those two are in use -today in Emacs or Gnus. Similarly, the auth-source library supports -multiple storage formats, currently either the classic ``netrc'' -format, examples of which you can see later in this document, or the -Secret Service API. +others, to answer the old burning question ``What are my user name and +password?'' + +(This is different from the old question about burning ``Where is the +fire extinguisher, please?''.) + +The auth-source library supports more than just the user name or the +password (known as the secret). + +Similarly, the auth-source library supports multiple storage backend, +currently either the classic ``netrc'' backend, examples of which you +can see later in this document, or the Secret Service API. This is +done with EIEIO-based backends and you can write your own if you want. @node Help for users @chapter Help for users @@ -96,25 +100,41 @@ machine @var{mymachine} login @var{myloginname} password @var{mypassword} port @var{myport} @end example -The machine is the server (either a DNS name or an IP address). - -The port is optional. If it's missing, auth-source will assume any -port is OK. Actually the port is a protocol name or a port number so -you can have separate entries for port @var{143} and for protocol -@var{imap} if you fancy that. Anyway, you can just omit the port if -you don't need it. - -The login and password are simply your login credentials to the server. +The @code{machine} is the server (either a DNS name or an IP address). +It's known as @var{:host} in @code{auth-source-search} queries. You +can also use @code{host}. + +The @code{port} is the connection port or protocol. It's known as +@var{:port} in @code{auth-source-search} queries. You can also use +@code{protocol}. + +The @code{user} is the user name. It's known as @var{:user} in +@code{auth-source-search} queries. You can also use @code{login} and +@code{account}. + +Spaces are always OK as far as auth-source is concerned (but other +programs may not like them). Just put the data in quotes, escaping +quotes as you'd expect with @code{\}. + +All these are optional. You could just say (but we don't recommend +it, we're just showing that it's possible) + +@example +password @var{mypassword} +@end example + +to use the same password everywhere. Again, @emph{DO NOT DO THIS} or +you will be pwned as the kids say. ``Netrc'' files are usually called @code{.authinfo} or @code{.netrc}; nowadays @code{.authinfo} seems to be more popular and the auth-source library encourages this confusion by making it the default, as you'll see later. -If you have problems with the port, set @code{auth-source-debug} to -@code{t} and see what port the library is checking in the -@code{*Messages*} buffer. Ditto for any other problems, your first -step is always to see what's being checked. The second step, of +If you have problems with the search, set @code{auth-source-debug} to +@code{t} and see what host, port, and user the library is checking in +the @code{*Messages*} buffer. Ditto for any other problems, your +first step is always to see what's being checked. The second step, of course, is to write a blog entry about it and wait for the answer in the comments. @@ -139,56 +159,36 @@ (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))) ;;; mostly equivalent (see below about fallbacks) but shorter: (setq auth-sources '((:source "~/.authinfo.gpg"))) +;;; even shorter and the @emph{default}: +(setq auth-sources '("~/.authinfo.gpg" "~/.authinfo")) +;;; use the Secrets API @var{login} collection (@pxref{Secret Service API}) +(setq auth-sources '("secrets:login")) @end lisp -This says ``for any host and any protocol, use just that one file.'' -Sweet simplicity. In fact, the latter is already the default, so -unless you want to move your netrc file, it will just work if you have -that file. Make sure it exists. - By adding multiple entries to @code{auth-sources} with a particular host or protocol, you can have specific netrc files for that host or protocol. Usually this is unnecessary but may make sense if you have shared netrc files or some other unusual setup (90% of Emacs users have unusual setups and the remaining 10% are @emph{really} unusual). -Here's an example that uses the Secret Service API for all lookups, -using the default collection: - -@lisp -(setq auth-sources '((:source (:secrets default)))) -@end lisp - -And here's a mixed example, using two sources: +Here's a mixed example using two sources: @lisp (setq auth-sources '((:source (:secrets default) :host "myserver" :user "joe") - (:source "~/.authinfo.gpg"))) + "~/.authinfo.gpg")) @end lisp -The best match is determined by order (starts from the bottom) only -for the first pass, where things are checked exactly. In the example -above, the first pass would find a single match for host -@code{myserver}. The netrc choice would fail because it matches any -host and protocol implicitly (as a @emph{fallback}). A specified -value of @code{:host t} in @code{auth-sources} is considered a match -on the first pass, unlike a missing @code{:host}. - -Now if you look for host @code{missing}, it won't match either source -explicitly. The second pass (the @emph{fallback} pass) will look at -all the implicit matches and collect them. They will be scored and -returned sorted by score. The score is based on the number of -explicit parameters that matched. See the @code{auth-pick} function -for details. - @end defvar If you don't customize @code{auth-sources}, you'll have to live with the defaults: any host and any port are looked up in the netrc file @code{~/.authinfo.gpg}, which is a GnuPG encrypted file -(@pxref{GnuPG and EasyPG Assistant Configuration}). - -The simplest working netrc line example is one without a port. +(@pxref{GnuPG and EasyPG Assistant Configuration}). + +If that fails, the unencrypted netrc file @code{~/.authinfo} will +be used. + +The typical netrc line example is without a port. @example machine YOURMACHINE login YOU password YOURPASSWORD @@ -233,42 +233,29 @@ @node Help for developers @chapter Help for developers -The auth-source library only has one function for external use. - -@defun auth-source-user-or-password mode host port &optional username - -Retrieve appropriate authentication tokens, determined by @var{mode}, -for host @var{host} and @var{port}. If @var{username} is provided it -will also be checked. If @code{auth-source-debug} is t, debugging -messages will be printed. Set @code{auth-source-debug} to a function -to use that function for logging. The parameters passed will be the -same that the @code{message} function takes, that is, a string -formatting spec and optional parameters. - -If @var{mode} is a list of strings, the function will return a list of -strings or @code{nil} objects (thus you can avoid parsing the netrc -file or checking the Secret Service API more than once). If it's a -string, the function will return a string or a @code{nil} object. -Currently only the modes ``login'' and ``password'' are recognized but -more may be added in the future. - -@var{host} is a string containing the host name. - -@var{port} contains the protocol name (e.g. ``imap'') or -a port number. It must be a string, corresponding to the port in the -users' netrc files. - -@var{username} contains the user name (e.g. ``joe'') as a string. - -@example -;; IMAP example -(setq auth (auth-source-user-or-password - '("login" "password") - "anyhostnamehere" - "imap")) -(nth 0 auth) ; the login name -(nth 1 auth) ; the password -@end example +The auth-source library only has a few functions for external use. + +@defun auth-source-search SPEC + +TODO: how to include docstring? + +@end defun + +@defun auth-source-delete SPEC + +TODO: how to include docstring? + +@end defun + +@defun auth-source-forget SPEC + +TODO: how to include docstring? + +@end defun + +@defun auth-source-forget+ SPEC + +TODO: how to include docstring? @end defun === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-12 23:40:43 +0000 +++ lisp/ChangeLog 2011-02-13 00:25:29 +0000 @@ -191,6 +191,11 @@ (allout-after-copy-or-kill-hook): No arguments - hook implementers should concentrate on the kill ring. +2011-02-09 Teodor Zlatanov + + * password-cache.el (password-cache-remove): Accept secrets that are + not strings. + 2011-02-09 Stefan Monnier * progmodes/sh-script.el (sh-font-lock-open-heredoc): Fix case === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-02-10 22:43:21 +0000 +++ lisp/gnus/ChangeLog 2011-02-13 00:25:29 +0000 @@ -7,6 +7,30 @@ * gnus-sum.el (gnus-summary-save-parts): Use read-directory-name. +2011-02-10 Teodor Zlatanov + + * sieve-manage.el: Autoload `auth-source-search'. + (sieve-sasl-auth): Use it. + +2011-02-09 Teodor Zlatanov + + * nnimap.el: Autoload `auth-source-forget+'. + (nnimap-open-connection-1): Use it if the connection fails. + + * auth-source.el: Require `password-cache'. + (auth-source-hide-passwords, auth-source-cache): Remove and mark + obsolete. + (auth-source-magic): Marker for `password-cache' keys. + (auth-source-do-cache): Update docstring. + (auth-source-search): Use and check cache. + (auth-source-forget-all-cached, auth-source-remember) + (auth-source-recall, auth-source-forget, auth-source-forget+) + (auth-source-specmatchp): Caching support functions. + (auth-source-forget-user-or-password, auth-source-forget-all-cached): + Remove and obsolete. + (auth-source-user-or-password): Remove caching to further discourage + using it. Always hide passwords. + 2011-02-09 Lars Ingebrigtsen * nntp.el (nntp-retrieve-group-data-early-disabled): Disable the async @@ -17,6 +41,22 @@ * message.el (message-options): Make message-options really buffer local. +2011-02-08 Teodor Zlatanov + + * mail-source.el: Autoload `auth-source-search'. + (mail-source-keyword-map): Note order matters. + (mail-source-set-1): Get all the mail-source source values and + defaults and search auth-source on those if needed. This can all + probably be simplified. + + * nnimap.el: Autoload `auth-source-search'. + (nnimap-credentials): Use it. + (nnimap-open-connection-1): Ask for the virtual server and physical + address in one shot. + + * nntp.el: Autoload `auth-source-search'. + (nntp-send-authinfo): Use it. Note TODO. + 2011-02-08 Julien Danjou * shr.el (shr-tag-body): Add support for text attribute in body @@ -24,6 +64,13 @@ * message.el (message-options): Make message-options a local variable. +2011-02-07 Teodor Zlatanov + + * auth-source.el (auth-source-secrets-search) + (auth-source-user-or-password): Use `append' instead of `nconc'. + (auth-source-user-or-password): Build return list better and protect + against nil :secret. + 2011-02-07 Lars Ingebrigtsen * nnimap.el (nnimap-update-info): Refactor slightly. @@ -35,6 +82,13 @@ (nnimap-update-info): Fix macrology bug-out. (nnimap-update-info): Simplify split history test. +2011-02-06 Michael Albinus + + * auth-source.el (top): Require 'eieio unconditionally. Autoload + `secrets-get-attributes' instead of `secrets-get-attribute'. + (auth-source-secrets-search): Limit search when `max' is greater than + number of results. + 2011-02-06 Lars Ingebrigtsen * nntp.el (nntp-finish-retrieve-group-infos): Protect against the first @@ -42,11 +96,58 @@ * proto-stream.el (open-protocol-stream): Document the return value. +2011-02-06 Teodor Zlatanov + + * auth-source.el (auth-source-secrets-search): Add examples. + 2011-02-06 Julien Danjou * message.el (message-setup-1): Handle message-generate-headers-first set to t. +2011-02-06 Teodor Zlatanov + + * auth-source.el (auth-sources): Allow for simpler defaults for Secrets + API with a string "secrets:collection-name" and with 'default. + (auth-source-backend-parse): Parse "secrets:collection-name" and + 'default. Recurse on parses instead of repeating code. Use the + Secrets API is the source is not nil and 'ignore otherwise. Emit a + message when ignoring a source. + (auth-source-search): List ignored search keys at the top level. + (auth-source-netrc-create): Use `case' instead of `cond'. + (auth-source-secrets-search): Created with TODOs. + (auth-source-secrets-create): Created with TODOs. + (auth-source-retrieve, auth-source-create, auth-source-delete) + (auth-source-protocol-defaults, auth-source-user-or-password-imap) + (auth-source-user-or-password-pop3, auth-source-user-or-password-ssh) + (auth-source-user-or-password-sftp) + (auth-source-user-or-password-smtp): Removed. + (auth-source-user-or-password): Deprecated and modified to be a wrapper + around `auth-source-search'. Not tested thoroughly. + +2011-02-04 Teodor Zlatanov + + * auth-source.el: Bring in assoc and eioeio libraries. + (secrets-enabled): New variable to track the status of the Secrets API. + (auth-source-backend): New EIOEIO class to represent a backend. + (auth-source-creation-defaults): New variable to set prompt defaults + during token creation (see the `auth-source-search' docstring for + details). + (auth-sources): Simplify to allow a simple string as a netrc backend + spec. + (auth-source-backend-parse): Parse a backend from an `auth-sources' spec. + (auth-source-backend-parse-parameters): Fill in the backend parameters. + (auth-source-search): Main auth-source API entry point. + (auth-source-delete): Wrapper around `auth-source-search' for deletion. + (auth-source-search-collection): Helper function for searching. + (auth-source-netrc-parse, auth-source-netrc-normalize) + (auth-source-netrc-search, auth-source-netrc-create): Netrc backend. + Supports search, create, and delete. + (auth-source-secrets-search, auth-source-secrets-create): Secrets API + backend stubs. + (auth-source-user-or-password): Call `auth-source-search' but it's not + ready yet. + 2011-02-04 Lars Ingebrigtsen * message.el (message-setup-1): Remove the read-only stuff, since it === modified file 'lisp/gnus/auth-source.el' --- lisp/gnus/auth-source.el 2011-01-25 04:08:28 +0000 +++ lisp/gnus/auth-source.el 2011-02-13 00:25:29 +0000 @@ -39,23 +39,64 @@ ;;; Code: +(require 'password-cache) (require 'gnus-util) (require 'netrc) - +(require 'assoc) (eval-when-compile (require 'cl)) +(require 'eieio) + (autoload 'secrets-create-item "secrets") (autoload 'secrets-delete-item "secrets") (autoload 'secrets-get-alias "secrets") -(autoload 'secrets-get-attribute "secrets") +(autoload 'secrets-get-attributes "secrets") (autoload 'secrets-get-secret "secrets") (autoload 'secrets-list-collections "secrets") (autoload 'secrets-search-items "secrets") +(defvar secrets-enabled) + (defgroup auth-source nil "Authentication sources." :version "23.1" ;; No Gnus :group 'gnus) +(defclass auth-source-backend () + ((type :initarg :type + :initform 'netrc + :type symbol + :custom symbol + :documentation "The backend type.") + (source :initarg :source + :type string + :custom string + :documentation "The backend source.") + (host :initarg :host + :initform t + :type t + :custom string + :documentation "The backend host.") + (user :initarg :user + :initform t + :type t + :custom string + :documentation "The backend user.") + (protocol :initarg :protocol + :initform t + :type t + :custom string + :documentation "The backend protocol.") + (create-function :initarg :create-function + :initform ignore + :type function + :custom function + :documentation "The create function.") + (search-function :initarg :search-function + :initform ignore + :type function + :custom function + :documentation "The search function."))) + (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993") (pop3 "pop3" "pop" "pop3s" "110" "995") (ssh "ssh" "22") @@ -81,11 +122,15 @@ p))) auth-source-protocols)) -(defvar auth-source-cache (make-hash-table :test 'equal) - "Cache for auth-source data") +(defvar auth-source-creation-defaults nil + "Defaults for creating token values. Usually let-bound.") + +(make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1") + +(defvar auth-source-magic "auth-source-magic ") (defcustom auth-source-do-cache t - "Whether auth-source should cache information." + "Whether auth-source should cache information with `password-cache'." :group 'auth-source :version "23.2" ;; No Gnus :type `boolean) @@ -108,65 +153,71 @@ (function :tag "Function that takes arguments like `message'") (const :tag "Don't log anything" nil))) -(defcustom auth-source-hide-passwords t - "Whether auth-source should hide passwords in log messages. -Only relevant if `auth-source-debug' is not nil." - :group 'auth-source - :version "23.2" ;; No Gnus - :type `boolean) - -(defcustom auth-sources '((:source "~/.authinfo.gpg") - (:source "~/.authinfo")) +(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo") "List of authentication sources. -The default will get login and password information from a .gpg -file, which you should set up with the EPA/EPG packages to be -encrypted. See the auth.info manual for details. +The default will get login and password information from +\"~/.authinfo.gpg\", which you should set up with the EPA/EPG +packages to be encrypted. If that file doesn't exist, it will +try the unencrypted version \"~/.authinfo\". + +See the auth.info manual for details. 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.2" ;; No Gnus + :version "24.1" ;; No Gnus :type `(repeat :tag "Authentication Sources" - (list :tag "Source definition" - (const :format "" :value :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 "Login" "login") - (const :tag "Temporary" "session")))) - (repeat :tag "Extra Parameters" :inline t - (choice :tag "Extra parameter" - (list :tag "Host (omit to match as a fallback)" - (const :format "" :value :host) - (choice :tag "Host (machine) choice" - (const :tag "Any" t) - (regexp :tag "Host (machine) regular expression"))) - (list :tag "Protocol (omit to match as a fallback)" - (const :format "" :value :protocol) - (choice :tag "Protocol" - (const :tag "Any" t) - ,@auth-source-protocols-customize)) - (list :tag "User (omit to match as a fallback)" :inline t - (const :format "" :value :user) - (choice :tag "Personality or username" - (const :tag "Any" t) - (string :tag "Specific user name")))))))) + (choice + (string :tag "Just a file") + (const :tag "Default Secrets API Collection" 'default) + (const :tag "Login Secrets API Collection" "secrets:login") + (const :tag "Temp Secrets API Collection" "secrets:session") + (list :tag "Source definition" + (const :format "" :value :source) + (choice :tag "Authentication backend choice" + (string :tag "Authentication Source (file)") + (list + :tag "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 "Login" "login") + (const + :tag "Temporary" "session")))) + (repeat :tag "Extra Parameters" :inline t + (choice :tag "Extra parameter" + (list + :tag "Host" + (const :format "" :value :host) + (choice :tag "Host (machine) choice" + (const :tag "Any" t) + (regexp + :tag "Regular expression"))) + (list + :tag "Protocol" + (const :format "" :value :protocol) + (choice + :tag "Protocol" + (const :tag "Any" t) + ,@auth-source-protocols-customize)) + (list :tag "User" :inline t + (const :format "" :value :user) + (choice :tag "Personality/Username" + (const :tag "Any" t) + (string :tag "Name"))))))))) (defcustom auth-source-gpg-encrypt-to t "List of recipient keys that `authinfo.gpg' encrypted to. If the value is not a list, symmetric encryption will be used." :group 'auth-source - :version "23.2" ;; No Gnus + :version "24.1" ;; No Gnus :type '(choice (const :tag "Symmetric encryption" t) - (repeat :tag "Recipient public keys" - (string :tag "Recipient public key")))) + (repeat :tag "Recipient public keys" + (string :tag "Recipient public key")))) ;; temp for debugging ;; (unintern 'auth-source-protocols) @@ -211,229 +262,799 @@ ;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))) -(defun auth-get-source (entry) - "Return the source string of ENTRY, which is one entry in `auth-sources'. -If it is a Secret Service API, return the collection name, otherwise -the file name." - (let ((source (plist-get entry :source))) - (if (stringp source) - source - ;; Secret Service API. - (setq source (plist-get source :secrets)) - (when (eq source 'default) - (setq source (or (secrets-get-alias "default") "login"))) - (or source "session")))) - -(defun auth-source-pick (&rest spec) - "Parse `auth-sources' for matches of the SPEC plist. - -Common keys are :host, :protocol, and :user. A value of t in -SPEC means to always succeed in the match. A string value is -matched as a regex." - (let ((keys (loop for i below (length spec) by 2 collect (nth i spec))) - choices) - (dolist (choice (copy-tree auth-sources) choices) - (let ((source (plist-get choice :source)) - (match t)) - (when - (and - ;; Check existence of source. - (if (consp source) - ;; Secret Service API. - (member (auth-get-source choice) (secrets-list-collections)) - ;; authinfo file. - (file-exists-p source)) - - ;; Check keywords. - (dolist (k keys match) - (let* ((v (plist-get spec k)) - (choicev (if (plist-member choice k) - (plist-get choice k) t))) - (setq match - (and match - (or - ;; source always matches spec key - (eq t choicev) - ;; source key gives regex to match against spec - (and (stringp choicev) (string-match choicev v)) - ;; source key gives symbol to match against spec - (and (symbolp choicev) (eq choicev v)))))))) - - (add-to-list 'choices choice 'append)))))) - -(defun auth-source-retrieve (mode entry &rest spec) - "Retrieve MODE credentials according to SPEC from ENTRY." - (catch 'no-password - (let ((host (plist-get spec :host)) - (user (plist-get spec :user)) - (prot (plist-get spec :protocol)) - (source (plist-get entry :source)) - result) - (cond - ;; Secret Service API. - ((consp source) - (let ((coll (auth-get-source entry)) - item) - ;; Loop over candidates with a matching host attribute. - (dolist (elt (secrets-search-items coll :host host) item) - (when (and (or (not user) - (string-equal - user (secrets-get-attribute coll elt :user))) - (or (not prot) - (string-equal - prot (secrets-get-attribute coll elt :protocol)))) - (setq item elt) - (return elt))) - ;; Compose result. - (when item - (setq result - (mapcar (lambda (m) - (if (string-equal "password" m) - (or (secrets-get-secret coll item) - ;; When we do not find a password, - ;; we return nil anyway. - (throw 'no-password nil)) - (or (secrets-get-attribute coll item :user) - user))) - (if (consp mode) mode (list mode))))) - (if (consp mode) result (car result)))) - ;; Anything else is netrc. - (t - (let ((search (list source (list host) (list (format "%s" prot)) - (auth-source-protocol-defaults prot)))) - (setq result - (mapcar (lambda (m) - (if (string-equal "password" m) - (or (apply - 'netrc-machine-user-or-password m search) - ;; When we do not find a password, we - ;; return nil anyway. - (throw 'no-password nil)) - (or (apply - 'netrc-machine-user-or-password m search) - user))) - (if (consp mode) mode (list mode))))) - (if (consp mode) result (car result))))))) - -(defun auth-source-create (mode entry &rest spec) - "Create interactively credentials according to SPEC in ENTRY. -Return structure as specified by MODE." - (let* ((host (plist-get spec :host)) - (user (plist-get spec :user)) - (prot (plist-get spec :protocol)) - (source (plist-get entry :source)) - (name (concat (if user (format "%s@" user)) - host - (if prot (format ":%s" prot)))) - result) - (setq result - (mapcar - (lambda (m) - (cons - m - (cond - ((equal "password" m) - (let ((passwd (read-passwd - (format "Password for %s on %s: " prot host)))) - (cond - ;; Secret Service API. - ((consp source) - (apply - 'secrets-create-item - (auth-get-source entry) name passwd spec)) - (t)) ;; netrc not implemented yes. - passwd)) - ((equal "login" m) - (or user - (read-string - (format "User name for %s on %s (default %s): " prot host - (user-login-name)) - nil nil (user-login-name)))) - (t - "unknownuser")))) - (if (consp mode) mode (list mode)))) - ;; Allow the source to save the data. - (cond - ((consp source) - ;; Secret Service API -- not implemented. - ) - (t - ;; netrc interface. - (when (y-or-n-p (format "Do you want to save this password in %s? " - source)) - ;; the code below is almost same as `netrc-store-data' except - ;; the `epa-file-encrypt-to' hack (see bug#7487). - (with-temp-buffer - (when (file-exists-p source) - (insert-file-contents source)) - (when auth-source-gpg-encrypt-to - ;; making `epa-file-encrypt-to' local to this buffer lets - ;; epa-file skip the key selection query (see the - ;; `local-variable-p' check in `epa-file-write-region'). - (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) - (make-local-variable 'epa-file-encrypt-to)) - (if (listp auth-source-gpg-encrypt-to) - (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (insert (format "machine %s login %s password %s port %s\n" - host - (or user (cdr (assoc "login" result))) - (cdr (assoc "password" result)) - prot)) - (write-region (point-min) (point-max) source nil 'silent))))) - (if (consp mode) - (mapcar #'cdr result) - (cdar result)))) - -(defun auth-source-delete (entry &rest spec) - "Delete credentials according to SPEC in ENTRY." - (let ((host (plist-get spec :host)) - (user (plist-get spec :user)) - (prot (plist-get spec :protocol)) - (source (plist-get entry :source))) - (cond - ;; Secret Service API. - ((consp source) - (let ((coll (auth-get-source entry))) - ;; Loop over candidates with a matching host attribute. - (dolist (elt (secrets-search-items coll :host host)) - (when (and (or (not user) - (string-equal - user (secrets-get-attribute coll elt :user))) - (or (not prot) - (string-equal - prot (secrets-get-attribute coll elt :protocol)))) - (secrets-delete-item coll elt))))) - (t)))) ;; netrc not implemented yes. - -(defun auth-source-forget-user-or-password - (mode host protocol &optional username) - "Remove cached authentication token." - (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing - (remhash - (if username - (format "%s %s:%s %s" mode host protocol username) - (format "%s %s:%s" mode host protocol)) - auth-source-cache)) +;; (auth-source-backend-parse "myfile.gpg") +;; (auth-source-backend-parse 'default) +;; (auth-source-backend-parse "secrets:login") + +(defun auth-source-backend-parse (entry) + "Creates an auth-source-backend from an ENTRY in `auth-sources'." + (auth-source-backend-parse-parameters + entry + (cond + ;; take 'default and recurse to get it as a Secrets API default collection + ;; matching any user, host, and protocol + ((eq entry 'default) + (auth-source-backend-parse '(:source (:secrets default)))) + ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ" + ;; matching any user, host, and protocol + ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry)) + (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry))))) + ;; take just a file name and recurse to get it as a netrc file + ;; matching any user, host, and protocol + ((stringp entry) + (auth-source-backend-parse `(:source ,entry))) + + ;; a file name with parameters + ((stringp (plist-get entry :source)) + (auth-source-backend + (plist-get entry :source) + :source (plist-get entry :source) + :type 'netrc + :search-function 'auth-source-netrc-search + :create-function 'auth-source-netrc-create)) + + ;; the Secrets API. We require the package, in order to have a + ;; defined value for `secrets-enabled'. + ((and + (not (null (plist-get entry :source))) ; the source must not be nil + (listp (plist-get entry :source)) ; and it must be a list + (require 'secrets nil t) ; and we must load the Secrets API + secrets-enabled) ; and that API must be enabled + + ;; the source is either the :secrets key in ENTRY or + ;; if that's missing or nil, it's "session" + (let ((source (or (plist-get (plist-get entry :source) :secrets) + "session"))) + + ;; if the source is a symbol, we look for the alias named so, + ;; and if that alias is missing, we use "login" + (when (symbolp source) + (setq source (or (secrets-get-alias (symbol-name source)) + "login"))) + + (auth-source-backend + (format "Secrets API (%s)" source) + :source source + :type 'secrets + :search-function 'auth-source-secrets-search + :create-function 'auth-source-secrets-create))) + + ;; none of them + (t + (auth-source-do-debug + "auth-source-backend-parse: invalid backend spec: %S" entry) + (auth-source-backend + "Empty" + :source "" + :type 'ignore))))) + +(defun auth-source-backend-parse-parameters (entry backend) + "Fills in the extra auth-source-backend parameters of ENTRY. +Using the plist ENTRY, get the :host, :protocol, and :user search +parameters. Accepts :port as an alias to :protocol. Sets all +the parameters to t if they are missing." + (let (val) + (when (setq val (plist-get entry :host)) + (oset backend host val)) + (when (setq val (plist-get entry :user)) + (oset backend user val)) + ;; accept :port as an alias for :protocol + (when (setq val (or (plist-get entry :protocol) (plist-get entry :port))) + (oset backend protocol val))) + backend) + +;; (mapcar 'auth-source-backend-parse auth-sources) + +(defun* auth-source-search (&rest spec + &key type max host user protocol secret + create delete + &allow-other-keys) + "Search or modify authentication backends according to SPEC. + +This function parses `auth-sources' for matches of the SPEC +plist. It can optionally create or update an authentication +token if requested. A token is just a standard Emacs property +list with a :secret property that can be a function; all the +other properties will always hold scalar values. + +Typically the :secret property, if present, contains a password. + +Common search keys are :max, :host, :protocol, and :user. In +addition, :create specifies how tokens will be or created. +Finally, :type can specify which backend types you want to check. + +A string value is always matched literally. A symbol is matched +as its string value, literally. All the SPEC values can be +single values (symbol or string) or lists thereof (in which case +any of the search terms matches). + +:create t means to create a token if possible. + +A new token will be created if no matching tokens were found. +The new token will have only the keys the backend requires. For +the netrc backend, for instance, that's the user, host, and +protocol keys. + +Here's an example: + +\(let ((auth-source-creation-defaults '((user . \"defaultUser\") + (A . \"default A\")))) + (auth-source-search :host \"mine\" :type 'netrc :max 1 + :P \"pppp\" :Q \"qqqq\" + :create t)) + +which says: + +\"Search for any entry matching host 'mine' in backends of type + 'netrc', maximum one result. + + Create a new entry if you found none. The netrc backend will + automatically require host, user, and protocol. The host will be + 'mine'. We prompt for the user with default 'defaultUser' and + for the protocol without a default. We will not prompt for A, Q, + or P. The resulting token will only have keys user, host, and + protocol.\" + +:create '(A B C) also means to create a token if possible. + +The behavior is like :create t but if the list contains any +parameter, that parameter will be required in the resulting +token. The value for that parameter will be obtained from the +search parameters or from user input. If any queries are needed, +the alist `auth-source-creation-defaults' will be checked for the +default prompt. + +Here's an example: + +\(let ((auth-source-creation-defaults '((user . \"defaultUser\") + (A . \"default A\")))) + (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1 + :P \"pppp\" :Q \"qqqq\" + :create '(A B Q))) + +which says: + +\"Search for any entry matching host 'nonesuch' + or 'twosuch' in backends of type 'netrc', maximum one result. + + Create a new entry if you found none. The netrc backend will + automatically require host, user, and protocol. The host will be + 'nonesuch' and Q will be 'qqqq'. We prompt for A with default + 'default A', for B and protocol with default nil, and for the + user with default 'defaultUser'. We will not prompt for Q. The + resulting token will have keys user, host, protocol, A, B, and Q. + It will not have P with any value, even though P is used in the + search to find only entries that have P set to 'pppp'.\" + +When multiple values are specified in the search parameter, the +first one is used for creation. So :host (X Y Z) would create a +token for host X, for instance. + +This creation can fail if the search was not specific enough to +create a new token (it's up to the backend to decide that). You +should `catch' the backend-specific error as usual. Some +backends (netrc, at least) will prompt the user rather than throw +an error. + +:delete t means to delete any found entries. nil by default. +Use `auth-source-delete' in ELisp code instead of calling +`auth-source-search' directly with this parameter. + +:type (X Y Z) will check only those backend types. 'netrc and +'secrets are the only ones supported right now. + +:max N means to try to return at most N items (defaults to 1). +When 0 the function will return just t or nil to indicate if any +matches were found. More than N items may be returned, depending +on the search and the backend. + +:host (X Y Z) means to match only hosts X, Y, or Z according to +the match rules above. Defaults to t. + +:user (X Y Z) means to match only users X, Y, or Z according to +the match rules above. Defaults to t. + +:protocol (P Q R) means to match only protocols P, Q, or R. +Defaults to t. + +:K (V1 V2 V3) for any other key K will match values V1, V2, or +V3 (note the match rules above). + +The return value is a list with at most :max tokens. Each token +is a plist with keys :backend :host :protocol :user, plus any other +keys provided by the backend (notably :secret). But note the +exception for :max 0, which see above. + +The token's :secret key can hold a function. In that case you +must call it to obtain the actual value." + (let* ((backends (mapcar 'auth-source-backend-parse auth-sources)) + (max (or max 1)) + (ignored-keys '(:create :delete :max)) + (keys (loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) + (found (auth-source-recall spec)) + filtered-backends accessor-key found-here goal) + + (if (and found auth-source-do-cache) + (auth-source-do-debug + "auth-source-search: found %d CACHED results matching %S" + (length found) spec) + + (assert + (or (eq t create) (listp create)) t + "Invalid auth-source :create parameter (must be nil, t, or a list)") + + (setq filtered-backends (copy-list backends)) + (dolist (backend backends) + (dolist (key keys) + ;; ignore invalid slots + (condition-case signal + (unless (eval `(auth-source-search-collection + (plist-get spec key) + (oref backend ,key))) + (setq filtered-backends (delq backend filtered-backends)) + (return)) + (invalid-slot-name)))) + + (auth-source-do-debug + "auth-source-search: found %d backends matching %S" + (length filtered-backends) spec) + + ;; (debug spec "filtered" filtered-backends) + (setq goal max) + (dolist (backend filtered-backends) + (setq found-here (apply + (slot-value backend 'search-function) + :backend backend + :create create + :delete delete + spec)) + + ;; if max is 0, as soon as we find something, return it + (when (and (zerop max) (> 0 (length found-here))) + (return t)) + + ;; decrement the goal by the number of new results + (decf goal (length found-here)) + ;; and append the new results to the full list + (setq found (append found found-here)) + + (auth-source-do-debug + "auth-source-search: found %d results (max %d/%d) in %S matching %S" + (length found-here) max goal backend spec) + + ;; return full list if the goal is 0 or negative + (when (zerop (max 0 goal)) + (return found)) + + ;; change the :max parameter in the spec to the goal + (setq spec (plist-put spec :max goal))) + + (when (and found auth-source-do-cache) + (auth-source-remember spec found))) + + found)) + +;;; (auth-source-search :max 1) +;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret)) +;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1) +;;; (auth-source-search :host "nonesuch" :type 'secrets) + +(defun* auth-source-delete (&rest spec + &key delete + &allow-other-keys) + "Delete entries from the authentication backends according to SPEC. +Calls `auth-source-search' with the :delete property in SPEC set to t. +The backend may not actually delete the entries. + +Returns the deleted entries." + (auth-source-search (plist-put spec :delete t))) + +(defun auth-source-search-collection (collection value) + "Returns t is VALUE is t or COLLECTION is t or contains VALUE." + (when (and (atom collection) (not (eq t collection))) + (setq collection (list collection))) + + ;; (debug :collection collection :value value) + (or (eq collection t) + (eq value t) + (equal collection value) + (member value collection))) (defun auth-source-forget-all-cached () - "Forget all cached auth-source authentication tokens." + "Forget all cached auth-source data." (interactive) - (setq auth-source-cache (make-hash-table :test 'equal))) - -;; (progn -;; (auth-source-forget-all-cached) -;; (list -;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other") -;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "tzz") -;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "joe"))) + (loop for sym being the symbols of password-data + ;; when the symbol name starts with auth-source-magic + when (string-match (concat "^" auth-source-magic) + (symbol-name sym)) + ;; remove that key + do (password-cache-remove (symbol-name sym)))) + +(defun auth-source-remember (spec found) + "Remember FOUND search results for SPEC." + (password-cache-add + (concat auth-source-magic (format "%S" spec)) found)) + +(defun auth-source-recall (spec) + "Recall FOUND search results for SPEC." + (password-read-from-cache + (concat auth-source-magic (format "%S" spec)))) + +(defun auth-source-forget (spec) + "Forget any cached data matching SPEC exactly. + +This is the same SPEC you passed to `auth-source-search'. +Returns t or nil for forgotten or not found." + (password-cache-remove (concat auth-source-magic (format "%S" spec)))) + +;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym)) + +;;; (auth-source-remember '(:host "wedd") '(4 5 6)) +;;; (auth-source-remember '(:host "xedd") '(1 2 3)) +;;; (auth-source-recall '(:host "xedd")) +;;; (auth-source-recall '(:host t)) +;;; (auth-source-forget+ :host t) + +(defun* auth-source-forget+ (&rest spec &allow-other-keys) + "Forget any cached data matching SPEC. Returns forgotten count. + +This is not a full `auth-source-search' spec but works similarly. +For instance, \(:host \"myhost\" \"yourhost\") would find all the +cached data that was found with a search for those two hosts, +while \(:host t) would find all host entries." + (let ((count 0) + sname) + (loop for sym being the symbols of password-data + ;; when the symbol name matches with auth-source-magic + when (and (setq sname (symbol-name sym)) + (string-match (concat "^" auth-source-magic "\\(.+\\)") + sname) + ;; and the spec matches what was stored in the cache + (auth-source-specmatchp spec (read (match-string 1 sname)))) + ;; remove that key + do (progn + (password-cache-remove sname) + (incf count))) + count)) + +(defun auth-source-specmatchp (spec stored) + (let ((keys (loop for i below (length spec) by 2 + collect (nth i spec)))) + (not (eq + (dolist (key keys) + (unless (auth-source-search-collection (plist-get stored key) + (plist-get spec key)) + (return 'no))) + 'no)))) + +;;; Backend specific parsing: netrc/authinfo backend + +;;; (auth-source-netrc-parse "~/.authinfo.gpg") +(defun* auth-source-netrc-parse (&rest + spec + &key file max host user protocol delete + &allow-other-keys) + "Parse FILE and return a list of all entries in the file. +Note that the MAX parameter is used so we can exit the parse early." + (if (listp file) + ;; We got already parsed contents; just return it. + file + (when (file-exists-p file) + (with-temp-buffer + (let ((tokens '("machine" "host" "default" "login" "user" + "password" "account" "macdef" "force" + "port" "protocol")) + (max (or max 5000)) ; sanity check: default to stop at 5K + (modified 0) + alist elem result pair) + (insert-file-contents file) + (goto-char (point-min)) + ;; Go through the file, line by line. + (while (and (not (eobp)) + (> max 0)) + + (narrow-to-region (point) (point-at-eol)) + ;; For each line, get the tokens and values. + (while (not (eobp)) + (skip-chars-forward "\t ") + ;; Skip lines that begin with a "#". + (if (eq (char-after) ?#) + (goto-char (point-max)) + (unless (eobp) + (setq elem + (if (= (following-char) ?\") + (read (current-buffer)) + (buffer-substring + (point) (progn (skip-chars-forward "^\t ") + (point))))) + (cond + ((equal elem "macdef") + ;; We skip past the macro definition. + (widen) + (while (and (zerop (forward-line 1)) + (looking-at "$"))) + (narrow-to-region (point) (point))) + ((member elem tokens) + ;; Tokens that don't have a following value are ignored, + ;; except "default". + (when (and pair (or (cdr pair) + (equal (car pair) "default"))) + (push pair alist)) + (setq pair (list elem))) + (t + ;; Values that haven't got a preceding token are ignored. + (when pair + (setcdr pair elem) + (push pair alist) + (setq pair nil))))))) + + (when (and alist + (> max 0) + (auth-source-search-collection + host + (or + (aget alist "machine") + (aget alist "host"))) + (auth-source-search-collection + user + (or + (aget alist "login") + (aget alist "account") + (aget alist "user"))) + (auth-source-search-collection + protocol + (or + (aget alist "port") + (aget alist "protocol")))) + (decf max) + (push (nreverse alist) result) + ;; to delete a line, we just comment it out + (when delete + (goto-char (point-min)) + (insert "#") + (incf modified))) + (setq alist nil + pair nil) + (widen) + (forward-line 1)) + + (when (< 0 modified) + (when auth-source-gpg-encrypt-to + ;; (see bug#7487) making `epa-file-encrypt-to' local to + ;; this buffer lets epa-file skip the key selection query + ;; (see the `local-variable-p' check in + ;; `epa-file-write-region'). + (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) + (make-local-variable 'epa-file-encrypt-to)) + (if (listp auth-source-gpg-encrypt-to) + (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) + + ;; ask AFTER we've successfully opened the file + (when (y-or-n-p (format "Save file %s? (%d modifications)" + file modified)) + (write-region (point-min) (point-max) file nil 'silent) + (auth-source-do-debug + "auth-source-netrc-parse: modified %d lines in %s" + modified file))) + + (nreverse result)))))) + +(defun auth-source-netrc-normalize (alist) + (mapcar (lambda (entry) + (let (ret item) + (while (setq item (pop entry)) + (let ((k (car item)) + (v (cdr item))) + + ;; apply key aliases + (setq k (cond ((member k '("machine")) "host") + ((member k '("login" "account")) "user") + ((member k '("protocol")) "port") + ((member k '("password")) "secret") + (t k))) + + ;; send back the secret in a function (lexical binding) + (when (equal k "secret") + (setq v (lexical-let ((v v)) + (lambda () v)))) + + (setq ret (plist-put ret + (intern (concat ":" k)) + v)) + )) + ret)) + alist)) + +;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret)) +;;; (funcall secret) + +(defun* auth-source-netrc-search (&rest + spec + &key backend create delete + type max host user protocol + &allow-other-keys) +"Given a property list SPEC, return search matches from the :backend. +See `auth-source-search' for details on SPEC." + ;; just in case, check that the type is correct (null or same as the backend) + (assert (or (null type) (eq type (oref backend type))) + t "Invalid netrc search") + + (let ((results (auth-source-netrc-normalize + (auth-source-netrc-parse + :max max + :delete delete + :file (oref backend source) + :host (or host t) + :user (or user t) + :protocol (or protocol t))))) + + ;; if we need to create an entry AND none were found to match + (when (and create + (= 0 (length results))) + + ;; create based on the spec + (apply (slot-value backend 'create-function) spec) + ;; turn off the :create key + (setq spec (plist-put spec :create nil)) + ;; run the search again to get the updated data + ;; the result will be returned, even if the search fails + (setq results (apply 'auth-source-netrc-search spec))) + + results)) + +;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) +;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) + +(defun* auth-source-netrc-create (&rest spec + &key backend + secret host user protocol create + &allow-other-keys) + (let* ((base-required '(host user protocol secret)) + ;; we know (because of an assertion in auth-source-search) that the + ;; :create parameter is either t or a list (which includes nil) + (create-extra (if (eq t create) nil create)) + (required (append base-required create-extra)) + (file (oref backend source)) + (add "") + ;; `valist' is an alist + valist) + + ;; only for base required elements (defined as function parameters): + ;; fill in the valist with whatever data we may have from the search + ;; we take the first value if it's a list, the whole value otherwise + (dolist (br base-required) + (when (symbol-value br) + (aput 'valist br (if (listp (symbol-value br)) + (nth 0 (symbol-value br)) + (symbol-value br))))) + + ;; for extra required elements, see if the spec includes a value for them + (dolist (er create-extra) + (let ((name (concat ":" (symbol-name er))) + (keys (loop for i below (length spec) by 2 + collect (nth i spec)))) + (dolist (k keys) + (when (equal (symbol-name k) name) + (aput 'valist er (plist-get spec k)))))) + + ;; for each required element + (dolist (r required) + (let* ((data (aget valist r)) + (given-default (aget auth-source-creation-defaults r)) + ;; the defaults are simple + (default (cond + ((and (not given-default) (eq r 'user)) + (user-login-name)) + ;; note we need this empty string + ((and (not given-default) (eq r 'protocol)) + "") + (t given-default))) + ;; the prompt's default string depends on the data so far + (default-string (if (and default (< 0 (length default))) + (format " (default %s)" default) + " (no default)")) + ;; the prompt should also show what's entered so far + (user-value (aget valist 'user)) + (host-value (aget valist 'host)) + (protocol-value (aget valist 'protocol)) + (info-so-far (concat (if user-value + (format "%s@" user-value) + "[USER?]") + (if host-value + (format "%s" host-value) + "[HOST?]") + (if protocol-value + ;; this distinguishes protocol between + (if (zerop (length protocol-value)) + "" ; 'entered as "no default"' vs. + (format ":%s" protocol-value)) ; given + ;; and this is when the protocol is unknown + "[PROTOCOL?]")))) + + ;; now prompt if the search SPEC did not include a required key; + ;; take the result and put it in `data' AND store it in `valist' + (aput 'valist r + (setq data + (cond + ((and (null data) (eq r 'secret)) + ;; special case prompt for passwords + (read-passwd (format "Password for %s: " info-so-far))) + ((null data) + (read-string + (format "Enter %s for %s%s: " + r info-so-far default-string) + nil nil default)) + (t data)))) + + ;; when r is not an empty string... + (when (and (stringp data) + (< 0 (length data))) + ;; append the key (the symbol name of r) and the value in r + (setq add (concat add + (format "%s%s %S" + ;; prepend a space + (if (zerop (length add)) "" " ") + ;; remap auth-source tokens to netrc + (case r + ('user "login") + ('host "machine") + ('secret "password") + ('protocol "port") + (t (symbol-name r))) + ;; the value will be printed in %S format + data)))))) + + (with-temp-buffer + (when (file-exists-p file) + (insert-file-contents file)) + (when auth-source-gpg-encrypt-to + ;; (see bug#7487) making `epa-file-encrypt-to' local to + ;; this buffer lets epa-file skip the key selection query + ;; (see the `local-variable-p' check in + ;; `epa-file-write-region'). + (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) + (make-local-variable 'epa-file-encrypt-to)) + (if (listp auth-source-gpg-encrypt-to) + (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) + (goto-char (point-max)) + + ;; ask AFTER we've successfully opened the file + (when (y-or-n-p (format "Add to file %s: line [%s]" file add)) + (unless (bolp) + (insert "\n")) + (insert add "\n") + (write-region (point-min) (point-max) file nil 'silent) + (auth-source-do-debug + "auth-source-netrc-create: wrote 1 new line to %s" + file))))) + +;;; Backend specific parsing: Secrets API backend + +;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t)) +;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t)) +;;; (let ((auth-sources '(default))) (auth-source-search :max 1)) +;;; (let ((auth-sources '(default))) (auth-source-search)) +;;; (let ((auth-sources '("secrets:login"))) (auth-source-search :max 1)) +;;; (let ((auth-sources '("secrets:login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git")) + +(defun* auth-source-secrets-search (&rest + spec + &key backend create delete label + type max host user protocol + &allow-other-keys) + "Search the Secrets API; spec is like `auth-source'. + +The :label key specifies the item's label. It is the only key +that can specify a substring. Any :label value besides a string +will allow any label. + +All other search keys must match exactly. If you need substring +matching, do a wider search and narrow it down yourself. + +You'll get back all the properties of the token as a plist. + +Here's an example that looks for the first item in the 'login' +Secrets collection: + + \(let ((auth-sources '(\"secrets:login\"))) + (auth-source-search :max 1) + +Here's another that looks for the first item in the 'login' +Secrets collection whose label contains 'gnus': + + \(let ((auth-sources '(\"secrets:login\"))) + (auth-source-search :max 1 :label \"gnus\") + +And this one looks for the first item in the 'login' Secrets +collection that's a Google Chrome entry for the git.gnus.org site +login: + + \(let ((auth-sources '(\"secrets:login\"))) + (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\")) +" + + ;; TODO + (assert (not create) nil + "The Secrets API auth-source backend doesn't support creation yet") + ;; TODO + ;; (secrets-delete-item coll elt) + (assert (not delete) nil + "The Secrets API auth-source backend doesn't support deletion yet") + + (let* ((coll (oref backend source)) + (max (or max 5000)) ; sanity check: default to stop at 5K + (ignored-keys '(:create :delete :max :backend :label)) + (search-keys (loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) + ;; build a search spec without the ignored keys + ;; if a search key is nil or t (match anything), we skip it + (search-spec (mapcan (lambda (k) (if (or (null (plist-get spec k)) + (eq t (plist-get spec k))) + nil + (list k (plist-get spec k)))) + search-keys)) + ;; needed keys (always including host, login, protocol, and secret) + (returned-keys (remove-duplicates (append + '(:host :login :protocol :secret) + search-keys))) + (items (loop for item in (apply 'secrets-search-items coll search-spec) + unless (and (stringp label) + (not (string-match label item))) + collect item)) + ;; TODO: respect max in `secrets-search-items', not after the fact + (items (subseq items 0 (min (length items) max))) + ;; convert the item name to a full plist + (items (mapcar (lambda (item) + (append + ;; make an entry for the secret (password) element + (list + :secret + (lexical-let ((v (secrets-get-secret coll item))) + (lambda () v))) + ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist + (mapcan (lambda (entry) + (list (car entry) (cdr entry))) + (secrets-get-attributes coll item)))) + items)) + ;; ensure each item has each key in `returned-keys' + (items (mapcar (lambda (plist) + (append + (mapcan (lambda (req) + (if (plist-get plist req) + nil + (list req nil))) + returned-keys) + plist)) + items))) + items)) + +(defun* auth-source-secrets-create (&rest + spec + &key backend type max host user protocol + &allow-other-keys) + ;; TODO + ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec) + (debug spec)) + +;;; older API + +;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz") + +;; deprecate the old interface +(make-obsolete 'auth-source-user-or-password + 'auth-source-search "Emacs 24.1") +(make-obsolete 'auth-source-forget-user-or-password + 'auth-source-forget "Emacs 24.1") (defun auth-source-user-or-password (mode host protocol &optional username create-missing delete-existing) "Find MODE (string or list of strings) matching HOST and PROTOCOL. +DEPRECATED in favor of `auth-source-search'! + USERNAME is optional and will be used as \"login\" in a search across the Secret Service API (see secrets.el) if the resulting items don't have a username. This means that if you search for @@ -452,8 +1073,9 @@ MODE can be \"login\" or \"password\"." (auth-source-do-debug - "auth-source-user-or-password: get %s for %s (%s) + user=%s" + "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s" mode host protocol username) + (let* ((listy (listp mode)) (mode (if listy mode (list mode))) (cname (if username @@ -461,70 +1083,44 @@ (format "%s %s:%s" mode host protocol))) (search (list :host host :protocol protocol)) (search (if username (append search (list :user username)) search)) - (found (if (not delete-existing) - (gethash cname auth-source-cache) - (remhash cname auth-source-cache) - nil))) + (search (if create-missing + (append search (list :create t)) + search)) + (search (if delete-existing + (append search (list :delete t)) + search)) + ;; (found (if (not delete-existing) + ;; (gethash cname auth-source-cache) + ;; (remhash cname auth-source-cache) + ;; nil))) + (found nil)) (if found (progn (auth-source-do-debug - "auth-source-user-or-password: cached %s=%s for %s (%s) + %s" + "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s" mode ;; don't show the password - (if (and (member "password" mode) auth-source-hide-passwords) + (if (and (member "password" mode) t) "SECRET" found) host protocol username) found) ; return the found data - ;; else, if not found - (let ((choices (apply 'auth-source-pick search))) - (dolist (choice choices) - (if delete-existing - (apply 'auth-source-delete choice search) - (setq found (apply 'auth-source-retrieve mode choice search))) - (and found (return found))) - - ;; We haven't found something, so we will create it interactively. - (when (and (not found) create-missing) - (setq found (apply 'auth-source-create - mode (if choices - (car choices) - (car auth-sources)) - search))) - - ;; Cache the result. - (when found - (auth-source-do-debug - "auth-source-user-or-password: found %s=%s for %s (%s) + %s" - mode - ;; don't show the password - (if (and (member "password" mode) auth-source-hide-passwords) - "SECRET" found) - host protocol username) - (setq found (if listy found (car-safe found))) - (when auth-source-do-cache - (puthash cname found auth-source-cache))) - - found)))) - -(defun auth-source-protocol-defaults (protocol) - "Return a list of default ports and names for PROTOCOL." - (cdr-safe (assoc protocol auth-source-protocols))) - -(defun auth-source-user-or-password-imap (mode host) - (auth-source-user-or-password mode host 'imap)) - -(defun auth-source-user-or-password-pop3 (mode host) - (auth-source-user-or-password mode host 'pop3)) - -(defun auth-source-user-or-password-ssh (mode host) - (auth-source-user-or-password mode host 'ssh)) - -(defun auth-source-user-or-password-sftp (mode host) - (auth-source-user-or-password mode host 'sftp)) - -(defun auth-source-user-or-password-smtp (mode host) - (auth-source-user-or-password mode host 'smtp)) + ;; else, if not found, search with a max of 1 + (let ((choice (nth 0 (apply 'auth-source-search + (append '(:max 1) search))))) + (when choice + (dolist (m mode) + (cond + ((equal "password" m) + (push (if (plist-get choice :secret) + (funcall (plist-get choice :secret)) + nil) found)) + ((equal "login" m) + (push (plist-get choice :user) found))))) + (setq found (nreverse found)) + (setq found (if listy found (car-safe found))))) + + found)) (provide 'auth-source) === modified file 'lisp/gnus/mail-source.el' --- lisp/gnus/mail-source.el 2011-01-25 04:08:28 +0000 +++ lisp/gnus/mail-source.el 2011-02-13 00:25:29 +0000 @@ -32,7 +32,7 @@ (eval-when-compile (require 'cl) (require 'imap)) -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") (autoload 'pop3-movemail "pop3") (autoload 'pop3-get-message-count "pop3") (autoload 'nnheader-cancel-timer "nnheader") @@ -332,6 +332,7 @@ (:prescript) (:prescript-delay) (:postscript) + ;; note server and port need to come before user and password (:server (getenv "MAILHOST")) (:port 110) (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER"))) @@ -345,6 +346,7 @@ (:subdirs ("cur" "new")) (:function)) (imap + ;; note server and port need to come before user and password (:server (getenv "MAILHOST")) (:port) (:stream) @@ -417,42 +419,66 @@ (put 'mail-source-bind 'lisp-indent-function 1) (put 'mail-source-bind 'edebug-form-spec '(sexp body)) -;; TODO: use the list format for auth-source-user-or-password modes (defun mail-source-set-1 (source) (let* ((type (pop source)) - (defaults (cdr (assq type mail-source-keyword-map))) - default value keyword auth-info user-auth pass-auth) + (defaults (cdr (assq type mail-source-keyword-map))) + (search '(:max 1)) + found default value keyword auth-info user-auth pass-auth) + + ;; append to the search the useful info from the source and the defaults: + ;; user, host, and port + + ;; the msname is the mail-source parameter + (dolist (msname '(:server :user :port)) + ;; the asname is the auth-source parameter + (let* ((asname (case msname + (:server :host) ; auth-source uses :host + (t msname))) + ;; this is the mail-source default + (msdef1 (or (plist-get source msname) + (nth 1 (assoc msname defaults)))) + ;; ...evaluated + (msdef (mail-source-value msdef1))) + (setq search (append (list asname + (if msdef msdef t)) + search)))) + ;; if the port is unknown yet, get it from the mail-source type + (unless (plist-get search :port) + (setq search (append (list :port (symbol-name type))))) + (while (setq default (pop defaults)) ;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL ;; using `mail-source-value' to evaluate the plist value (set (mail-source-strip-keyword (setq keyword (car default))) - ;; note the following reasons for this structure: - ;; 1) the auth-sources user and password override everything - ;; 2) it avoids macros, so it's cleaner - ;; 3) it falls through to the mail-sources and then default values - (cond - ((and - (eq keyword :user) - (setq user-auth - (nth 0 (auth-source-user-or-password - '("login" "password") - ;; this is "host" in auth-sources - (if (boundp 'server) (symbol-value 'server) "") - type)))) - user-auth) - ((and - (eq keyword :password) - (setq pass-auth - (nth 1 - (auth-source-user-or-password - '("login" "password") - ;; this is "host" in auth-sources - (if (boundp 'server) (symbol-value 'server) "") - type)))) - pass-auth) - (t (if (setq value (plist-get source keyword)) - (mail-source-value value) - (mail-source-value (cadr default))))))))) + ;; note the following reasons for this structure: + ;; 1) the auth-sources user and password override everything + ;; 2) it avoids macros, so it's cleaner + ;; 3) it falls through to the mail-sources and then default values + (cond + ((and + (eq keyword :user) + (setq user-auth (plist-get + ;; cache the search result in `found' + (or found + (setq found (nth 0 (apply 'auth-source-search + search)))) + :user))) + user-auth) + ((and + (eq keyword :password) + (setq pass-auth (plist-get + ;; cache the search result in `found' + (or found + (setq found (nth 0 (apply 'auth-source-search + search)))) + :secret))) + ;; maybe set the password to the return of the :secret function + (if (functionp pass-auth) + (setq pass-auth (funcall pass-auth)) + pass-auth)) + (t (if (setq value (plist-get source keyword)) + (mail-source-value value) + (mail-source-value (cadr default))))))))) (eval-and-compile (defun mail-source-bind-common-1 () === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2011-02-07 22:49:38 +0000 +++ lisp/gnus/nnimap.el 2011-02-13 00:25:29 +0000 @@ -47,8 +47,8 @@ (require 'nnmail) (require 'proto-stream) -(autoload 'auth-source-forget-user-or-password "auth-source") -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-forget+ "auth-source") +(autoload 'auth-source-search "auth-source") (nnoo-declare nnimap) @@ -275,18 +275,18 @@ (current-buffer))) (defun nnimap-credentials (address ports &optional inhibit-create) - (let (port credentials) - ;; Request the credentials from all ports, but only query on the - ;; last port if all the previous ones have failed. - (while (and (null credentials) - (setq port (pop ports))) - (setq credentials - (auth-source-user-or-password - '("login" "password") address port nil - (if inhibit-create - nil - (null ports))))) - credentials)) + (let* ((found (nth 0 (auth-source-search :max 1 + :host address + :port ports + :create (if inhibit-create + nil + (null ports))))) + (user (plist-get found :user)) + (secret (plist-get found :secret)) + (secret (if (functionp secret) (funcall secret) secret))) + (if found + (list user secret) + nil))) (defun nnimap-keepalive () (let ((now (current-time))) @@ -381,14 +381,13 @@ (if (eq nnimap-authenticator 'anonymous) (list "anonymous" (message-make-address)) - (or - ;; First look for the credentials based - ;; on the virtual server name. - (nnimap-credentials - (nnoo-current-server 'nnimap) ports t) - ;; Then look them up based on the - ;; physical address. - (nnimap-credentials nnimap-address ports))))) + ;; Look for the credentials based on + ;; the virtual server name and the address + (nnimap-credentials + (list + (nnoo-current-server 'nnimap) + nnimap-address) + ports t)))) (setq nnimap-object nil) (setq login-result (nnimap-login (car credentials) (cadr credentials))) @@ -398,9 +397,7 @@ (dolist (host (list (nnoo-current-server 'nnimap) nnimap-address)) (dolist (port ports) - (dolist (element '("login" "password")) - (auth-source-forget-user-or-password - element host port)))) + (auth-source-forget+ :host host :protocol port))) (delete-process (nnimap-process nnimap-object)) (setq nnimap-object nil)))) (when nnimap-object === modified file 'lisp/gnus/nntp.el' --- lisp/gnus/nntp.el 2011-02-09 22:16:29 +0000 +++ lisp/gnus/nntp.el 2011-02-13 00:25:29 +0000 @@ -40,7 +40,7 @@ (eval-when-compile (require 'cl)) -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") (defgroup nntp nil "NNTP access for Gnus." @@ -1231,10 +1231,16 @@ (let* ((list (netrc-parse nntp-authinfo-file)) (alist (netrc-machine list nntp-address "nntp")) (force (or (netrc-get alist "force") nntp-authinfo-force)) - (auth-info - (auth-source-user-or-password '("login" "password") nntp-address "nntp")) - (auth-user (nth 0 auth-info)) - (auth-passwd (nth 1 auth-info)) + (auth-info + (nth 0 (auth-source-search :max 1 + ;; TODO: allow the virtual server name too + :host nntp-address + :port '("119" "nntp")))) + (auth-user (plist-get auth-info :user)) + (auth-passwd (plist-get auth-info :secret)) + (auth-passwd (if (functionp auth-passwd) + (funcall auth-passwd) + auth-passwd)) (user (or ;; this is preferred to netrc-* auth-user === modified file 'lisp/gnus/sieve-manage.el' --- lisp/gnus/sieve-manage.el 2011-01-25 04:08:28 +0000 +++ lisp/gnus/sieve-manage.el 2011-02-13 00:25:29 +0000 @@ -83,7 +83,7 @@ (require 'starttls)) (autoload 'sasl-find-mechanism "sasl") (autoload 'starttls-open-stream "starttls") -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") ;; User customizable variables: @@ -273,16 +273,20 @@ "Login to server using the SASL MECH method." (message "sieve: Authenticating using %s..." mech) (with-current-buffer buffer - (let* ((user-password (auth-source-user-or-password - '("login" "password") - sieve-manage-server - "sieve" nil t)) + (let* ((auth-info (auth-source-search :host sieve-manage-server + :port "sieve" + :max 1)) + (user-name (plist-get (nth 0 auth-info) :user)) + (user-password (plist-get (nth 0 auth-info) :secret)) + (user-password (if (functionp user-password) + (funcall user-password) + user-password)) (client (sasl-make-client (sasl-find-mechanism (list mech)) - (car user-password) "sieve" sieve-manage-server)) + user-name "sieve" sieve-manage-server)) (sasl-read-passphrase ;; We *need* to copy the password, because sasl will modify it ;; somehow. - `(lambda (prompt) ,(copy-sequence (cadr user-password)))) + `(lambda (prompt) ,(copy-sequence user-password))) (step (sasl-next-step client nil)) (tag (sieve-manage-send (concat === modified file 'lisp/password-cache.el' --- lisp/password-cache.el 2011-01-25 04:08:28 +0000 +++ lisp/password-cache.el 2011-02-13 00:25:29 +0000 @@ -111,9 +111,10 @@ user again." (let ((password (symbol-value (intern-soft key password-data)))) (when password - (if (fboundp 'clear-string) - (clear-string password) - (fillarray password ?_)) + (when (stringp password) + (if (fboundp 'clear-string) + (clear-string password) + (fillarray password ?_))) (unintern key password-data)))) (defun password-cache-add (key password) ------------------------------------------------------------ revno: 103245 [merge] committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-02-12 19:16:28 -0500 message: Merge changes from emacs-23 branch diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2011-02-09 01:40:01 +0000 +++ doc/misc/ChangeLog 2011-02-12 23:40:43 +0000 @@ -1,3 +1,11 @@ +2011-02-12 Glenn Morris + + * sc.texi (Getting Connected): Remove old index entries. + +2011-02-12 Ulrich Mueller + + * url.texi: Remove duplicate @dircategory (Bug#7942). + 2011-02-09 Paul Eggert * texinfo.tex: Update to version 2011-02-07.16. === modified file 'doc/misc/sc.texi' --- doc/misc/sc.texi 2011-01-25 04:08:28 +0000 +++ doc/misc/sc.texi 2011-02-12 23:40:43 +0000 @@ -751,8 +751,6 @@ @cindex .emacs file @findex sc-cite-original @findex cite-original (sc-) -@findex sc-submit-bug-report -@findex submit-bug-report (sc-) The first thing that everyone should do, regardless of the MUA you are using is to set up Emacs so it will load Supercite at the appropriate time. This happens automatically if Supercite is distributed with your === modified file 'doc/misc/url.texi' --- doc/misc/url.texi 2011-01-25 04:08:28 +0000 +++ doc/misc/url.texi 2011-02-12 23:40:43 +0000 @@ -12,7 +12,6 @@ \overfullrule=0pt %\global\baselineskip 30pt % for printing in double space @end tex -@dircategory World Wide Web @dircategory Emacs @direntry * URL: (url). URL loading package. === modified file 'etc/ChangeLog' --- etc/ChangeLog 2011-02-12 23:10:18 +0000 +++ etc/ChangeLog 2011-02-12 23:40:43 +0000 @@ -386,7 +386,7 @@ * srecode/doc-default.srt (section-comment, function-comment) (variable-same-line-comment, group-comment-start, group-comment-end): * srecode/doc-java.srt (function-comment, variable-same-line-comment) - (group-comment-start, gropu-comment-end): + (group-comment-start, group-comment-end): Fix typos in template docstrings. 2010-01-14 Kenichi Handa === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-12 22:55:28 +0000 +++ lisp/ChangeLog 2011-02-12 23:40:43 +0000 @@ -1,3 +1,20 @@ +2011-02-10 Glenn Morris + + * emacs-lisp/cl-seq.el (union, nunion, intersection) + (nintersection, set-difference, nset-difference) + (set-exclusive-or, nset-exclusive-or): Doc fix. + + * ediff-ptch.el (ediff-fixup-patch-map): Doc fix. + +2011-02-08 Glenn Morris + + * faces.el (face-attr-match-p): Handle the obsolete :bold and + :italic props, so that frame-set-background-mode works. (Bug#7966) + +2011-02-07 Glenn Morris + + * simple.el (next-error): Doc fix. + 2011-02-12 Thierry Volpiatto * dired-aux.el (dired-create-files): Adapt destination name to @@ -1651,7 +1668,7 @@ (rmail-mime-insert-text): Call rmail-mime-insert-decoded-text. (rmail-mime-insert-image): Argument changed. Caller changed. (rmail-mime-image): Call rmail-mime-toggle-hidden. - (rmail-mime-set-bulk-data): New funciton. + (rmail-mime-set-bulk-data): New function. (rmail-mime-insert-bulk): Argument changed. (rmail-mime-multipart-handler): Return t. (rmail-mime-process-multipart): Argument changed. @@ -4145,7 +4162,7 @@ is indented differently if it is after a begin..end clock. (verilog-in-attribute-p, verilog-skip-backward-comments) (verilog-skip-forward-comment-p): Support proper treatment of - attributes by indent code. Reported by Jeff Steele. + attributes by indent code. Reported by Jeff Steele. (verilog-in-directive-p): Fix comment to correctly describe function. (verilog-backward-up-list, verilog-in-struct-region-p) (verilog-backward-token, verilog-in-struct-p) @@ -4156,9 +4173,9 @@ (verilog-property-re, verilog-endcomment-reason-re) (verilog-beg-of-statement, verilog-set-auto-endcomments) (verilog-calc-1 ): Fix for assert a; else b; indentation (new form - of if). Reported by Max Bjurling and + of if). Reported by Max Bjurling and (verilog-calc-1): Fix for clocking block in modport - declaration. Reported by Brian Hunter. + declaration. Reported by Brian Hunter. 2010-10-24 Wilson Snyder @@ -4174,7 +4191,7 @@ (verilog-read-always-signals-recurse, verilog-read-decls): Fix not treating `elsif similar to `endif inside AUTOSENSE. (verilog-do-indent): Implement correct automatic or static task or - function end comment highlight. Reported by Steve Pearlmutter. + function end comment highlight. Reported by Steve Pearlmutter. (verilog-font-lock-keywords-2): Fix highlighting of single character pins, bug264. Reported by Michael Laajanen. (verilog-auto-inst, verilog-read-decls, verilog-read-sub-decls) @@ -4185,7 +4202,7 @@ Reported by Mark Johnson. (verilog-auto-tieoff, verilog-auto-tieoff-ignore-regexp): Add 'verilog-auto-tieoff-ignore-regexp' for AUTOTIEOFF, - bug269. Suggested by Gary Delp. + bug269. Suggested by Gary Delp. (verilog-mode-map, verilog-preprocess, verilog-preprocess-history) (verilog-preprocessor, verilog-set-compile-command): Create verilog-preprocess and verilog-preprocessor to show @@ -4193,7 +4210,7 @@ (verilog-get-beg-of-line, verilog-get-end-of-line) (verilog-modi-file-or-buffer, verilog-modi-name) (verilog-modi-point, verilog-within-string): Move defmacro's - before first use to avoid warning. Reported by Steve Pearlmutter. + before first use to avoid warning. Reported by Steve Pearlmutter. (verilog-colorize-buffer, verilog-colorize-include-files-buffer) (verilog-colorize-region, verilog-highlight-buffer) (verilog-highlight-includes, verilog-highlight-modules) @@ -4225,7 +4242,7 @@ (verilog-alw-get-temps, verilog-auto-reset) (verilog-auto-sense-sigs, verilog-read-always-signals) (verilog-read-always-signals-recurse): Fix loop indexes being - AUTORESET. AUTORESET now assumes any variables in the + AUTORESET. AUTORESET now assumes any variables in the initialization section of a for() should be ignored. Reported by Dan Dever. (verilog-error-font-lock-keywords) === modified file 'lisp/dired.el' --- lisp/dired.el 2011-02-02 16:21:52 +0000 +++ lisp/dired.el 2011-02-13 00:16:28 +0000 @@ -3570,7 +3570,7 @@ ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff -;;;;;; dired-diff) "dired-aux" "dired-aux.el" "9f5fc434fa6c2607b6e66060862c9caf") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "e66465bcd1687d66cfb1202c9963d567") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ === modified file 'lisp/emacs-lisp/checkdoc.el' --- lisp/emacs-lisp/checkdoc.el 2011-01-25 04:08:28 +0000 +++ lisp/emacs-lisp/checkdoc.el 2011-02-12 23:40:43 +0000 @@ -1797,7 +1797,7 @@ (let ((found nil) (start (point)) (msg nil) (ms nil)) (while (and (not msg) (re-search-forward - ;; Ignore manual page refereces like + ;; Ignore manual page references like ;; git-config(1). "[^-([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^](']" e t)) === modified file 'lisp/emacs-lisp/cl-loaddefs.el' --- lisp/emacs-lisp/cl-loaddefs.el 2011-02-08 06:54:37 +0000 +++ lisp/emacs-lisp/cl-loaddefs.el 2011-02-13 00:16:28 +0000 @@ -754,7 +754,7 @@ ;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not ;;;;;; substitute-if substitute delete-duplicates remove-duplicates ;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove* -;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "43e0c1183e738e1e1038cdd84fde8366") +;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "df375ddc313f0c1c262cacab5cffd3e4") ;;; Generated autoloads from cl-seq.el (autoload 'reduce "cl-seq" "\ @@ -1080,7 +1080,7 @@ (autoload 'union "cl-seq" "\ Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. +The resulting list contains all items that appear in either LIST1 or LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. @@ -1090,7 +1090,7 @@ (autoload 'nunion "cl-seq" "\ Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. +The resulting list contains all items that appear in either LIST1 or LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. @@ -1100,7 +1100,7 @@ (autoload 'intersection "cl-seq" "\ Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. +The resulting list contains all items that appear in both LIST1 and LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. @@ -1110,7 +1110,7 @@ (autoload 'nintersection "cl-seq" "\ Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. +The resulting list contains all items that appear in both LIST1 and LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. @@ -1120,7 +1120,7 @@ (autoload 'set-difference "cl-seq" "\ Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. +The resulting list contains all items that appear in LIST1 but not LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. @@ -1130,7 +1130,7 @@ (autoload 'nset-difference "cl-seq" "\ Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. +The resulting list contains all items that appear in LIST1 but not LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. @@ -1140,7 +1140,7 @@ (autoload 'set-exclusive-or "cl-seq" "\ Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. +The resulting list contains all items appearing in exactly one of LIST1, LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. @@ -1150,7 +1150,7 @@ (autoload 'nset-exclusive-or "cl-seq" "\ Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. +The resulting list contains all items appearing in exactly one of LIST1, LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. === modified file 'lisp/emacs-lisp/cl-seq.el' --- lisp/emacs-lisp/cl-seq.el 2011-01-25 04:08:28 +0000 +++ lisp/emacs-lisp/cl-seq.el 2011-02-12 23:40:43 +0000 @@ -770,7 +770,7 @@ ;;;###autoload (defun union (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. +The resulting list contains all items that appear in either LIST1 or LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. \nKeywords supported: :test :test-not :key @@ -791,7 +791,7 @@ ;;;###autoload (defun nunion (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. +The resulting list contains all items that appear in either LIST1 or LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. \nKeywords supported: :test :test-not :key @@ -802,7 +802,7 @@ ;;;###autoload (defun intersection (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. +The resulting list contains all items that appear in both LIST1 and LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. \nKeywords supported: :test :test-not :key @@ -825,7 +825,7 @@ ;;;###autoload (defun nintersection (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. +The resulting list contains all items that appear in both LIST1 and LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. \nKeywords supported: :test :test-not :key @@ -835,7 +835,7 @@ ;;;###autoload (defun set-difference (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. +The resulting list contains all items that appear in LIST1 but not LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. \nKeywords supported: :test :test-not :key @@ -855,7 +855,7 @@ ;;;###autoload (defun nset-difference (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. +The resulting list contains all items that appear in LIST1 but not LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. \nKeywords supported: :test :test-not :key @@ -866,7 +866,7 @@ ;;;###autoload (defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. +The resulting list contains all items appearing in exactly one of LIST1, LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. \nKeywords supported: :test :test-not :key @@ -879,7 +879,7 @@ ;;;###autoload (defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. +The resulting list contains all items appearing in exactly one of LIST1, LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. \nKeywords supported: :test :test-not :key === modified file 'lisp/emulation/cua-base.el' --- lisp/emulation/cua-base.el 2011-01-25 04:08:28 +0000 +++ lisp/emulation/cua-base.el 2011-02-12 23:40:43 +0000 @@ -246,7 +246,7 @@ ;; [C-d] Moves (i.e. deletes and inserts) a single character to the ;; global mark. ;; [backspace] deletes the character before the global mark, while -;; [delete] deltes the character after the global mark. +;; [delete] deletes the character after the global mark. ;; [S-C-space] Jumps to and cancels the global mark. ;; [C-u S-C-space] Cancels the global mark (stays in current buffer). === modified file 'lisp/faces.el' --- lisp/faces.el 2011-02-05 22:30:14 +0000 +++ lisp/faces.el 2011-02-12 23:40:43 +0000 @@ -1577,13 +1577,25 @@ is used. If nil or omitted, use the selected frame." (unless frame (setq frame (selected-frame))) - (let ((list face-attribute-name-alist) - (match t)) + (let* ((list face-attribute-name-alist) + (match t) + (bold (and (plist-member attrs :bold) + (not (plist-member attrs :weight)))) + (italic (and (plist-member attrs :italic) + (not (plist-member attrs :slant)))) + (plist (if (or bold italic) + (copy-sequence attrs) + attrs))) + ;; Handle the Emacs 20 :bold and :italic properties. + (if bold + (plist-put plist :weight (if bold 'bold 'normal))) + (if italic + (plist-put plist :slant (if italic 'italic 'normal))) (while (and match list) (let* ((attr (caar list)) (specified-value - (if (plist-member attrs attr) - (plist-get attrs attr) + (if (plist-member plist attr) + (plist-get plist attr) 'unspecified)) (value-now (face-attribute face attr frame))) (setq match (equal specified-value value-now)) === modified file 'lisp/gnus/ChangeLog.2' --- lisp/gnus/ChangeLog.2 2011-01-26 08:36:39 +0000 +++ lisp/gnus/ChangeLog.2 2011-02-12 23:40:43 +0000 @@ -6088,7 +6088,7 @@ (nntp-retrieve-groups): Ditto for groups. (nntp-retrieve-articles): Ditto for articles. (*): Replaced nntp-possibly-change-group calls to - nntp-with-open-group forms in all, but one, occurrance. + nntp-with-open-group forms in all, but one, occurrence. (nntp-accept-process-output): Bug fix. Detect when called with null process. === modified file 'lisp/mh-e/ChangeLog.1' --- lisp/mh-e/ChangeLog.1 2011-01-26 08:36:39 +0000 +++ lisp/mh-e/ChangeLog.1 2011-02-12 23:40:43 +0000 @@ -3499,7 +3499,7 @@ 2003-05-08 Satyaki Das - * mh-seq.el (mh-translate-range): Take into account differnt + * mh-seq.el (mh-translate-range): Take into account different semantics of split-string in Emacs and XEmacs. (mh-read-pick-regexp, mh-narrow-to-from, mh-narrow-to-cc) (mh-narrow-to-to, mh-narrow-to-header-field) === modified file 'lisp/simple.el' --- lisp/simple.el 2011-02-11 18:25:06 +0000 +++ lisp/simple.el 2011-02-12 23:40:43 +0000 @@ -304,8 +304,8 @@ until you use it in some other buffer which uses Compilation mode or Compilation Minor mode. -See variables `compilation-parse-errors-function' and -\`compilation-error-regexp-alist' for customization ideas." +To control which errors are matched, customize the variable +`compilation-error-regexp-alist'." (interactive "P") (if (consp arg) (setq reset t arg nil)) (when (setq next-error-last-buffer (next-error-find-buffer)) === modified file 'lisp/textmodes/reftex-index.el' --- lisp/textmodes/reftex-index.el 2011-01-25 04:08:28 +0000 +++ lisp/textmodes/reftex-index.el 2011-02-12 23:40:43 +0000 @@ -1957,7 +1957,7 @@ ((equal char ?\C-g) (keyboard-quit)) ((member char '(?o ?O)) - ;; Select a differnt macro + ;; Select a different macro (let* ((nc (reftex-index-select-phrases-macro 2)) (macro-data (cdr (assoc nc reftex-index-phrases-macro-data))) === modified file 'lisp/vc/ediff-mult.el' --- lisp/vc/ediff-mult.el 2011-01-25 04:08:28 +0000 +++ lisp/vc/ediff-mult.el 2011-02-12 23:40:43 +0000 @@ -306,7 +306,7 @@ (nth 3 elt)) (defsubst ediff-get-session-objC (elt) (nth 4 elt)) -;; Take the "name" component of the object into acount. ObjA/C/B is of the form +;; Take the "name" component of the object into account. ObjA/C/B is of the form ;; (name . equality-indicator) (defsubst ediff-get-session-objA-name (elt) (car (nth 2 elt))) === modified file 'lisp/vc/ediff-ptch.el' --- lisp/vc/ediff-ptch.el 2011-01-26 08:36:39 +0000 +++ lisp/vc/ediff-ptch.el 2011-02-12 23:40:43 +0000 @@ -417,7 +417,7 @@ are two possible targets for applying the patch. Both files seem to be plausible alternatives. -Please advice: +Please advise: Type `y' to use %s as the target; Type `n' to use %s as the target. " === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-12 22:36:22 +0000 +++ src/ChangeLog 2011-02-13 00:16:28 +0000 @@ -1,3 +1,20 @@ +2011-02-12 Martin Rudalics + + * window.c (select_window): Check inhibit_point_swap argument when + deciding whether to return immediately. + +2011-02-12 Jan Djärv + + * nsterm.m (setFrame, initFrame): Make sure pixel_height doesn't become + zero (Bug#7348). + +2011-02-12 Chong Yidong + + * config.in (TERMINFO): New definition. + + * s/netbsd.h: Use it to choose between terminfo and termcap + (Bug#7642). + 2011-02-12 Paul Eggert * md5.c (md5_process_bytes): Use sizeof, not __alignof__. @@ -1610,7 +1627,7 @@ * gtkutil.c (menubar_map_cb): New function (Bug#7425). (xg_update_frame_menubar): Connect signal map to menubar_map_cb. - Use 23 as menubar height if 0. (Bug#7425). + Use 23 as menubar height if 0. (Bug#7425). 2010-11-26 Eli Zaretskii @@ -2617,7 +2634,7 @@ is more portable. * keyboard.c (gobble_input): Move call of xd_read_queued_messages ... - (kbd_buffer_get_event): ... here. This is needed for cygwin, which + (kbd_buffer_get_event): ... here. This is needed for cygwin, which has not defined SIGIO. 2010-10-08 Chong Yidong === modified file 'src/nsterm.m' --- src/nsterm.m 2011-01-25 04:08:28 +0000 +++ src/nsterm.m 2011-02-12 23:40:43 +0000 @@ -5783,6 +5783,7 @@ win = nwin; condemned = NO; pixel_height = NSHeight (r); + if (pixel_height == 0) pixel_height = 1; min_portion = 20 / pixel_height; frame = XFRAME (XWINDOW (win)->frame); @@ -5812,6 +5813,7 @@ NSTRACE (EmacsScroller_setFrame); /* BLOCK_INPUT; */ pixel_height = NSHeight (newRect); + if (pixel_height == 0) pixel_height = 1; min_portion = 20 / pixel_height; [super setFrame: newRect]; [self display]; === modified file 'src/window.c' --- src/window.c 2011-02-05 22:30:14 +0000 +++ src/window.c 2011-02-12 23:40:43 +0000 @@ -3517,7 +3517,7 @@ record_buffer (w->buffer); } - if (EQ (window, selected_window)) + if (EQ (window, selected_window) && !inhibit_point_swap) return window; sf = SELECTED_FRAME (); ------------------------------------------------------------ revno: 103244 committer: Glenn Morris branch nick: trunk timestamp: Sat 2011-02-12 15:43:42 -0800 message: * admin/notes/bzr: Mention the helpful changelog_merge plugin. diff: === modified file 'admin/notes/bzr' --- admin/notes/bzr 2011-01-22 19:44:38 +0000 +++ admin/notes/bzr 2011-02-12 23:43:42 +0000 @@ -65,11 +65,26 @@ The following description uses bound branches, presumably it works in a similar way with unbound ones. +0) (First time only) Get the bzr changelog_merge plugin: + +cd ~/.bazaar/plugins +bzr branch lp:bzr-changelog-merge +mv bzr-changelog-merge changelog_merge + +This will make merging ChangeLogs a lot smoother. It merges new +entries to the top of the file, rather than trying to fit them in +mid-way through. + 1) Get clean, up-to-date copies of the emacs-23 and trunk branches. Check for any uncommitted changes with bzr status. 2) M-x cd /path/to/trunk +The first time only, do this: +cd .bzr/branch +Add the following line to branch.conf: +changelog_merge_files = ChangeLog + 3) load admin/bzrmerge.el 4) M-x bzrmerge RET /path/to/emacs-23 RET ------------------------------------------------------------ revno: 103243 committer: Glenn Morris branch nick: trunk timestamp: Sat 2011-02-12 15:37:43 -0800 message: * admin/bzrmerge.el (bzrmerge-resolve): Fix bzr revert call. diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2011-02-05 22:46:34 +0000 +++ admin/ChangeLog 2011-02-12 23:37:43 +0000 @@ -1,3 +1,7 @@ +2011-02-12 Glenn Morris + + * bzrmerge.el (bzrmerge-resolve): Fix bzr revert call. + 2011-02-05 Glenn Morris * bzrmerge.el (bzrmerge-warning-buffer): New constant. === modified file 'admin/bzrmerge.el' --- admin/bzrmerge.el 2011-02-05 22:46:34 +0000 +++ admin/bzrmerge.el 2011-02-12 23:37:43 +0000 @@ -187,7 +187,9 @@ (cond ((member file '("configure" "lisp/ldefs-boot.el" "lisp/emacs-lisp/cl-loaddefs.el")) - (call-process "bzr" nil t nil "revert" file) + ;; We are in the file's buffer, so names are relative. + (call-process "bzr" nil t nil "revert" + (file-name-nondirectory file)) (revert-buffer nil 'noconfirm)) (t (goto-char (point-max)) ------------------------------------------------------------ revno: 103242 author: Drew Adams committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-02-12 18:10:18 -0500 message: * themes/light-blue-theme.el: New file. diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2011-02-01 07:23:48 +0000 +++ etc/ChangeLog 2011-02-12 23:10:18 +0000 @@ -1,3 +1,7 @@ +2011-02-12 Drew Adams + + * themes/light-blue-theme.el: New file. + 2011-02-01 Paul Eggert format-time-string now supports subsecond time stamp resolution === added file 'etc/themes/light-blue-theme.el' --- etc/themes/light-blue-theme.el 1970-01-01 00:00:00 +0000 +++ etc/themes/light-blue-theme.el 2011-02-12 23:10:18 +0000 @@ -0,0 +1,67 @@ +;;; light-blue-theme.el --- Custom theme for faces + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Drew Adams + +;; 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 . + +;;; Commentary: + +;; Extracted from the settings in oneonone.el by Drew Adams. + +;;; Code: + +(deftheme light-blue + "Theme with a light blue backgound.") + +(let ((class '((class color) (min-colors 89)))) + (custom-theme-set-faces + 'light-blue + `(default ((,class (:background "LightBlue" :foreground "black")))) + `(cursor ((,class (:background "red")))) + `(fringe ((,class (:background "gray85")))) + ;; Highlighting faces + `(highlight ((,class (:background "cyan")))) + `(region ((,class (:background "MediumAquamarine")))) + `(secondary-selection ((,class (:background "white" :foreground "black")))) + `(isearch ((,class (:background "green" :foreground "Black")))) + `(lazy-highlight ((,class (:background "dark turquoise")))) + `(query-replace ((,class (:inherit isearch :background "white" :foreground "black")))) + `(match ((,class (:background "SkyBlue")))) + ;; Mode line faces + `(mode-line ((,class (:background "PaleGoldenrod" :foreground "black" :box (:line-width -1 :style released-button))))) + `(mode-line-buffer-id ((,class (:overline "red" :underline "red")))) + `(mode-line-inactive ((,class (:inherit mode-line :background "LightGray" :foreground "grey20" :box (:line-width -1 :color "grey75") :weight light)))) + ;; Escape and prompt faces + `(escape-glyph ((,class (:background "gold" :foreground "blue" :box (:line-width 1 :color "blue" :style released-button))))) + ;; Font lock faces + `(font-lock-builtin-face ((,class (:foreground "#b35caf")))) + `(font-lock-constant-face ((,class (:foreground "#00006DE06DE0")))) + `(font-lock-function-name-face ((,class (:foreground "red")))) + `(font-lock-keyword-face ((,class (:foreground "Blue3")))) + `(font-lock-string-face ((,class (:foreground "Magenta4")))) + `(font-lock-warning-face ((,class (:foreground "orange red" :weight bold)))) + ;; Compilation faces + `(next-error ((,class (:inherit region :background "SkyBlue")))))) + +(provide-theme 'light-blue) + +;; Local Variables: +;; no-byte-compile: t +;; End: + +;;; light-blue-theme.el ends here ------------------------------------------------------------ revno: 103241 author: Thierry Volpiatto committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-02-12 17:55:28 -0500 message: Adapt dired-create-files to copy-directory changes. * dired-aux.el (dired-create-files): Adapt destination name to match the new behavior of copy-directory. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-12 21:45:42 +0000 +++ lisp/ChangeLog 2011-02-12 22:55:28 +0000 @@ -1,3 +1,8 @@ +2011-02-12 Thierry Volpiatto + + * dired-aux.el (dired-create-files): Adapt destination name to + match the new behavior of copy-directory. + 2011-02-12 Chong Yidong * mail/mail-utils.el (mail-dont-reply-to-names): New variable, === modified file 'lisp/dired-aux.el' --- lisp/dired-aux.el 2011-01-25 04:08:28 +0000 +++ lisp/dired-aux.el 2011-02-12 22:55:28 +0000 @@ -1383,6 +1383,10 @@ (cond ((integerp marker-char) marker-char) (marker-char (dired-file-marker from)) ; slow (t nil)))) + (when (and (file-directory-p from) + (file-directory-p to) + (eq file-creator 'dired-copy-file)) + (setq to (file-name-directory to))) (condition-case err (progn (funcall file-creator from to dired-overwrite-confirmed) ------------------------------------------------------------ revno: 103240 committer: Paul Eggert branch nick: trunk timestamp: Sat 2011-02-12 14:36:22 -0800 message: * md5.c (md5_process_bytes): Use sizeof, not __alignof__. The difference doesn't matter here, in practice, and sizeof is more portable to non-GCC compilers. Also, this makes the code match the already-existing comment. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-12 18:53:24 +0000 +++ src/ChangeLog 2011-02-12 22:36:22 +0000 @@ -1,3 +1,10 @@ +2011-02-12 Paul Eggert + + * md5.c (md5_process_bytes): Use sizeof, not __alignof__. + The difference doesn't matter here, in practice, and sizeof is + more portable to non-GCC compilers. Also, this makes the code + match the already-existing comment. + 2011-02-12 Andreas Schwab * process.c (create_process): Reset SIGPIPE handler in the child. === modified file 'src/md5.c' --- src/md5.c 2011-01-15 23:16:57 +0000 +++ src/md5.c 2011-02-12 22:36:22 +0000 @@ -216,7 +216,7 @@ size_t add = 128 - left_over > len ? len : 128 - left_over; /* Only put full words in the buffer. */ - add -= add % __alignof__ (md5_uint32); + add -= add % sizeof (md5_uint32); memcpy (&ctx->buffer[left_over], buffer, add); ctx->buflen += add; @@ -427,4 +427,3 @@ ctx->C = C; ctx->D = D; } - ------------------------------------------------------------ revno: 103239 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-02-12 17:23:06 -0500 message: Minor commentary fix (Bug#8024). diff: === modified file 'lisp/bs.el' --- lisp/bs.el 2011-01-25 04:08:28 +0000 +++ lisp/bs.el 2011-02-12 22:23:06 +0000 @@ -42,14 +42,10 @@ ;;; Quick Installation und Customization: -;; Use +;; To display the bs menu, do ;; M-x bs-show -;; for buffer selection or optional bind a key to main function `bs-show' -;; (global-set-key "\C-x\C-b" 'bs-show) ;; or another key -;; -;; For customization use -;; M-x bs-customize - +;; To customize its behavior, do +;; M-x bs-customize ;;; More Commentary: ------------------------------------------------------------ revno: 103238 committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-02-12 16:45:42 -0500 message: Make rmail-default-dont-reply-to-names nil (Bug#7888); rename rmail-dont-reply-*. * lisp/mail/mail-utils.el (mail-dont-reply-to-names): New variable, from rmail-dont-reply-to-names. Callers changed. (mail-dont-reply-to): Rename from mail-dont-reply-to. (rmail-dont-reply-to): Make it an obsolete alias. * lisp/mail/rmail.el (rmail-default-dont-reply-to-names): Default to nil, and make obsolete. (rmail-dont-reply-to-names): Alias to mail-dont-reply-to-names. * lisp/mail/rmailsum.el (rmail-summary-sort-by-correspondent): Doc fix. * lisp/mail/rmailsort.el (rmail-sort-by-correspondent) (rmail-select-correspondent): Doc fix. Use mail-dont-reply-to. * lisp/mail/rmail.el (rmail-reply): Use mail-dont-reply-to. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-12 19:34:50 +0000 +++ lisp/ChangeLog 2011-02-12 21:45:42 +0000 @@ -1,3 +1,21 @@ +2011-02-12 Chong Yidong + + * mail/mail-utils.el (mail-dont-reply-to-names): New variable, + from rmail-dont-reply-to-names. Callers changed. + (mail-dont-reply-to): Rename from mail-dont-reply-to. + (rmail-dont-reply-to): Make it an obsolete alias. + + * mail/rmail.el (rmail-default-dont-reply-to-names): Default to + nil, and make obsolete (Bug#7888). + (rmail-dont-reply-to-names): Alias to mail-dont-reply-to-names. + + * mail/rmailsum.el (rmail-summary-sort-by-correspondent): Doc fix. + + * mail/rmailsort.el (rmail-sort-by-correspondent) + (rmail-select-correspondent): Doc fix. Use mail-dont-reply-to. + + * mail/rmail.el (rmail-reply): Use mail-dont-reply-to. + 2011-02-12 Thierry Volpiatto * files.el (copy-directory): New argument COPY-CONTENTS for === modified file 'lisp/mail/mail-utils.el' --- lisp/mail/mail-utils.el 2011-01-25 04:08:28 +0000 +++ lisp/mail/mail-utils.el 2011-02-12 21:45:42 +0000 @@ -35,6 +35,17 @@ :type 'boolean :group 'mail) +;;;###autoload +(defcustom mail-dont-reply-to-names nil + "Regexp specifying addresses to prune from a reply message. +If this is nil, it is set the first time you compose a reply, to +a value which excludes your own email address. + +Matching addresses are excluded from the CC field in replies, and +also the To field, unless this would leave an empty To field." + :type '(choice regexp (const :tag "Your Name" nil)) + :group 'mail) + ;; Returns t if file FILE is an Rmail file. ;;;###autoload (defun mail-file-babyl-p (file) @@ -213,36 +224,31 @@ nil 'literal address 2))) address)))) -;; The following piece of ugliness is legacy code. The name was an -;; unfortunate choice --- a flagrant violation of the Emacs Lisp -;; coding conventions. `mail-dont-reply-to' would have been -;; infinitely better. Also, `rmail-dont-reply-to-names' might have -;; been better named `mail-dont-reply-to-names' and sourced from this -;; file instead of in rmail.el. Yuck. -pmr -(defun rmail-dont-reply-to (destinations) +(defun mail-dont-reply-to (destinations) "Prune addresses from DESTINATIONS, a list of recipient addresses. -All addresses matching `rmail-dont-reply-to-names' are removed from -the comma-separated list. The pruned list is returned." +Remove all addresses matching `mail-dont-reply-to-names' from the +comma-separated list, and return the pruned list." ;; FIXME this (setting a user option the first time a command is used) ;; is somewhat strange. Normally one would never set the option, ;; but instead fall back to the default so long as it was nil. ;; Or just set the default directly in the defcustom. - (if (null rmail-dont-reply-to-names) - (setq rmail-dont-reply-to-names - (concat (if rmail-default-dont-reply-to-names - (concat rmail-default-dont-reply-to-names "\\|") - "") - (if (and user-mail-address - (not (equal user-mail-address user-login-name))) - ;; Anchor the login name and email address so - ;; that we don't match substrings: if the - ;; login name is "foo", we shouldn't match - ;; "barfoo@baz.com". - (concat "\\`" - (regexp-quote user-mail-address) - "\\'\\|") - "") - (concat "\\`" (regexp-quote user-login-name) "@")))) + (if (null mail-dont-reply-to-names) + (setq mail-dont-reply-to-names + (concat + ;; `rmail-default-dont-reply-to-names' is obsolete. + (if rmail-default-dont-reply-to-names + (concat rmail-default-dont-reply-to-names "\\|") + "") + (if (and user-mail-address + (not (equal user-mail-address user-login-name))) + ;; Anchor the login name and email address so that we + ;; don't match substrings: if the login name is + ;; "foo", we shouldn't match "barfoo@baz.com". + (concat "\\`" + (regexp-quote user-mail-address) + "\\'\\|") + "") + (concat "\\`" (regexp-quote user-login-name) "@")))) ;; Split up DESTINATIONS and match each element separately. (let ((start-pos 0) (cur-pos 0) (case-fold-search t)) @@ -262,7 +268,7 @@ (setq cur-pos start-pos))) (let* ((address (substring destinations start-pos cur-pos)) (naked-address (mail-strip-quoted-names address))) - (if (string-match rmail-dont-reply-to-names naked-address) + (if (string-match mail-dont-reply-to-names naked-address) (setq destinations (concat (substring destinations 0 start-pos) (and cur-pos (substring destinations (1+ cur-pos)))) @@ -278,6 +284,9 @@ (substring destinations (match-end 0)) destinations)) +;; Legacy name +(define-obsolete-function-alias 'rmail-dont-reply-to 'mail-dont-reply-to "24.1") + ;;;###autoload (defun mail-fetch-field (field-name &optional last all list) === modified file 'lisp/mail/rmail.el' --- lisp/mail/rmail.el 2011-02-10 16:56:00 +0000 +++ lisp/mail/rmail.el 2011-02-12 21:45:42 +0000 @@ -191,7 +191,7 @@ :group 'rmail-retrieve :type '(repeat (directory))) -(declare-function rmail-dont-reply-to "mail-utils" (destinations)) +(declare-function mail-dont-reply-to "mail-utils" (destinations)) (declare-function rmail-update-summary "rmailsum" (&rest ignore)) (defun rmail-probe (prog) @@ -283,26 +283,16 @@ :version "21.1") ;;;###autoload -(defcustom rmail-dont-reply-to-names nil - "A regexp specifying addresses to prune from a reply message. -If this is nil, it is set the first time you compose a reply, to -a value which excludes your own email address, plus whatever is -specified by `rmail-default-dont-reply-to-names'. - -Matching addresses are excluded from the CC field in replies, and -also the To field, unless this would leave an empty To field." - :type '(choice regexp (const :tag "Your Name" nil)) - :group 'rmail-reply) - -;;;###autoload -(defvar rmail-default-dont-reply-to-names (purecopy "\\`info-") - "Regexp specifying part of the default value of `rmail-dont-reply-to-names'. -This is used when the user does not set `rmail-dont-reply-to-names' -explicitly. (The other part of the default value is the user's -email address and name.) It is useful to set this variable in -the site customization file. The default value is conventionally -used for large mailing lists to broadcast announcements.") -;; Is it really useful to set this site-wide? +(defvaralias 'rmail-dont-reply-to-names 'mail-dont-reply-to-names) + +;;;###autoload +(defvar rmail-default-dont-reply-to-names nil + "Regexp specifying part of the default value of `mail-dont-reply-to-names'. +This is used when the user does not set `mail-dont-reply-to-names' +explicitly.") +;;;###autoload +(make-obsolete-variable 'rmail-default-dont-reply-to-names + 'mail-dont-reply-to-names "24.1") ;;;###autoload (defcustom rmail-ignored-headers @@ -3578,15 +3568,14 @@ ;; Remove unwanted names from reply-to, since Mail-Followup-To ;; header causes all the names in it to wind up in reply-to, not ;; in cc. But if what's left is an empty list, use the original. - (let* ((reply-to-list (rmail-dont-reply-to reply-to))) + (let* ((reply-to-list (mail-dont-reply-to reply-to))) (if (string= reply-to-list "") reply-to reply-to-list)) subject (rmail-make-in-reply-to-field from date message-id) (if just-sender nil - ;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to - ;; to do its job. - (let* ((cc-list (rmail-dont-reply-to + ;; `mail-dont-reply-to' doesn't need `mail-strip-quoted-names'. + (let* ((cc-list (mail-dont-reply-to (mail-strip-quoted-names (if (null cc) to (concat to ", " cc)))))) (if (string= cc-list "") nil cc-list))) @@ -4359,7 +4348,7 @@ ;;;### (autoloads (rmail-sort-by-labels rmail-sort-by-lines rmail-sort-by-correspondent ;;;;;; rmail-sort-by-recipient rmail-sort-by-author rmail-sort-by-subject -;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "f297fd33c8f7fa74baf16d2da99acb35") +;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "ad1c98fe868c0e5804cf945d6c980d0b") ;;; Generated autoloads from rmailsort.el (autoload 'rmail-sort-by-date "rmailsort" "\ @@ -4393,7 +4382,7 @@ Sort messages of current Rmail buffer by other correspondent. This uses either the \"From\", \"Sender\", \"To\", or \"Apparently-To\" header, downcased. Uses the first header not -excluded by `rmail-dont-reply-to-names'. If prefix argument +excluded by `mail-dont-reply-to-names'. If prefix argument REVERSE is non-nil, sorts in reverse order. \(fn REVERSE)" t nil) @@ -4418,7 +4407,7 @@ ;;;### (autoloads (rmail-summary-by-senders rmail-summary-by-topic ;;;;;; rmail-summary-by-regexp rmail-summary-by-recipients rmail-summary-by-labels -;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "adad96c9eb13cae4bae0769f731d8784") +;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "3817e21639db697abe5832d3223ecfc2") ;;; Generated autoloads from rmailsum.el (autoload 'rmail-summary "rmailsum" "\ === modified file 'lisp/mail/rmailsort.el' --- lisp/mail/rmailsort.el 2011-01-25 04:08:28 +0000 +++ lisp/mail/rmailsort.el 2011-02-12 21:45:42 +0000 @@ -87,7 +87,7 @@ "Sort messages of current Rmail buffer by other correspondent. This uses either the \"From\", \"Sender\", \"To\", or \"Apparently-To\" header, downcased. Uses the first header not -excluded by `rmail-dont-reply-to-names'. If prefix argument +excluded by `mail-dont-reply-to-names'. If prefix argument REVERSE is non-nil, sorts in reverse order." (interactive "P") (rmail-sort-messages reverse @@ -98,13 +98,12 @@ '("From" "Sender" "To" "Apparently-To")))))) (defun rmail-select-correspondent (msg fields) - "Find the first header not excluded by `rmail-dont-reply-to-names'. + "Find the first header not excluded by `mail-dont-reply-to-names'. MSG is a message number. FIELDS is a list of header names." (let ((ans "")) (while (and fields (string= ans "")) (setq ans - ;; NB despite the name, this lives in mail-utils.el. - (rmail-dont-reply-to + (mail-dont-reply-to (mail-strip-quoted-names (or (rmail-get-header (car fields) msg) "")))) (setq fields (cdr fields))) === modified file 'lisp/mail/rmailsum.el' --- lisp/mail/rmailsum.el 2011-02-10 16:56:00 +0000 +++ lisp/mail/rmailsum.el 2011-02-12 21:45:42 +0000 @@ -1796,7 +1796,7 @@ "Sort messages of current Rmail summary by other correspondent. This uses either the \"From\", \"Sender\", \"To\", or \"Apparently-To\" header, downcased. Uses the first header not -excluded by `rmail-dont-reply-to-names'. If prefix argument +excluded by `mail-dont-reply-to-names'. If prefix argument REVERSE is non-nil, sorts in reverse order." (interactive "P") (rmail-sort-from-summary (function rmail-sort-by-correspondent) reverse)) ------------------------------------------------------------ revno: 103237 author: Thierry Volpiatto committer: Chong Yidong branch nick: trunk timestamp: Sat 2011-02-12 14:34:50 -0500 message: New optional arg COPY-CONTENTS to copy-directory. * files.el (copy-directory): New argument COPY-CONTENTS for copying directory contents into another existing directory. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-02-08 20:45:53 +0000 +++ etc/NEWS 2011-02-12 19:34:50 +0000 @@ -633,6 +633,11 @@ * Incompatible Lisp Changes in Emacs 24.1 +** `copy-directory' now copies the source directory as a subdirectory +of the target directory, if the latter is an existing directory. The +new optional arg COPY-CONTENTS, if non-nil, makes the function copy +the contents directly into a pre-existing target directory. + ** `compose-mail' now accepts an optional 8th arg, RETURN-ACTION, and passes it to the mail user agent function. This argument specifies an action for returning to the caller after finishing with the mail. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-12 18:30:13 +0000 +++ lisp/ChangeLog 2011-02-12 19:34:50 +0000 @@ -1,3 +1,8 @@ +2011-02-12 Thierry Volpiatto + + * files.el (copy-directory): New argument COPY-CONTENTS for + copying directory contents into another existing directory. + 2011-02-12 Tassilo Horn * minibuffer.el (completion-table-case-fold): New function for === modified file 'lisp/files.el' --- lisp/files.el 2011-02-11 17:35:37 +0000 +++ lisp/files.el 2011-02-12 19:34:50 +0000 @@ -4826,10 +4826,8 @@ directory 'full directory-files-no-dot-files-regexp))) (delete-directory-internal directory))))) -(defun copy-directory (directory newname &optional keep-time parents) +(defun copy-directory (directory newname &optional keep-time parents copy-contents) "Copy DIRECTORY to NEWNAME. Both args must be strings. -If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there. - This function always sets the file modes of the output files to match the corresponding input file. @@ -4840,7 +4838,12 @@ Noninteractively, the last argument PARENTS says whether to create parent directories if they don't exist. Interactively, -this happens by default." +this happens by default. + +If NEWNAME names an existing directory, copy DIRECTORY as a +subdirectory there. However, if called from Lisp with a non-nil +optional argument COPY-CONTENTS, copy the contents of DIRECTORY +directly into NEWNAME instead." (interactive (let ((dir (read-directory-name "Copy directory: " default-directory default-directory t nil))) @@ -4848,7 +4851,7 @@ (read-file-name (format "Copy directory %s to: " dir) default-directory default-directory nil nil) - current-prefix-arg t))) + current-prefix-arg t nil))) ;; If default-directory is a remote directory, make sure we find its ;; copy-directory handler. (let ((handler (or (find-file-name-handler directory 'copy-directory) @@ -4860,21 +4863,22 @@ (setq directory (directory-file-name (expand-file-name directory)) newname (directory-file-name (expand-file-name newname))) - (if (not (file-directory-p newname)) - ;; If NEWNAME is not an existing directory, create it; that - ;; is where we will copy the files of DIRECTORY. - (make-directory newname parents) - ;; If NEWNAME is an existing directory, we will copy into - ;; NEWNAME/[DIRECTORY-BASENAME]. - (setq newname (expand-file-name - (file-name-nondirectory - (directory-file-name directory)) - newname)) - (and (file-exists-p newname) - (not (file-directory-p newname)) - (error "Cannot overwrite non-directory %s with a directory" - newname)) - (make-directory newname t)) + (cond ((not (file-directory-p newname)) + ;; If NEWNAME is not an existing directory, create it; + ;; that is where we will copy the files of DIRECTORY. + (make-directory newname parents)) + ;; If NEWNAME is an existing directory and COPY-CONTENTS + ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME]. + ((not copy-contents) + (setq newname (expand-file-name + (file-name-nondirectory + (directory-file-name directory)) + newname)) + (and (file-exists-p newname) + (not (file-directory-p newname)) + (error "Cannot overwrite non-directory %s with a directory" + newname)) + (make-directory newname t))) ;; Copy recursively. (dolist (file ------------------------------------------------------------ revno: 103236 committer: Andreas Schwab branch nick: emacs timestamp: Sat 2011-02-12 19:53:24 +0100 message: Make sure SIGPIPE is reset in child processes * process.c (create_process): Reset SIGPIPE handler in the child. * callproc.c (Fcall_process): Likewise. (Bug#5238) diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-12 15:48:10 +0000 +++ src/ChangeLog 2011-02-12 18:53:24 +0000 @@ -1,3 +1,8 @@ +2011-02-12 Andreas Schwab + + * process.c (create_process): Reset SIGPIPE handler in the child. + * callproc.c (Fcall_process): Likewise. (Bug#5238) + 2011-02-12 Eli Zaretskii * xdisp.c : New variable. === modified file 'src/callproc.c' --- src/callproc.c 2011-02-07 05:06:59 +0000 +++ src/callproc.c 2011-02-12 18:53:24 +0000 @@ -445,6 +445,11 @@ register char **save_environ = environ; register int fd1 = fd[1]; int fd_error = fd1; +#ifdef HAVE_WORKING_VFORK + sigset_t procmask; + sigset_t blocked; + struct sigaction sigpipe_action; +#endif #if 0 /* Some systems don't have sigblock. */ mask = sigblock (sigmask (SIGCHLD)); @@ -525,6 +530,18 @@ pid = child_setup (filefd, fd1, fd_error, (char **) new_argv, 0, current_dir); #else /* not WINDOWSNT */ + +#ifdef HAVE_WORKING_VFORK + /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal', + this sets the parent's signal handlers as well as the child's. + So delay all interrupts whose handlers the child might munge, + and record the current handlers so they can be restored later. */ + sigemptyset (&blocked); + sigaddset (&blocked, SIGPIPE); + sigaction (SIGPIPE, 0, &sigpipe_action); + sigprocmask (SIG_BLOCK, &blocked, &procmask); +#endif + BLOCK_INPUT; pid = vfork (); @@ -541,11 +558,26 @@ #else setpgrp (pid, pid); #endif /* USG */ + + /* GTK causes us to ignore SIGPIPE, make sure it is restored + in the child. */ + signal (SIGPIPE, SIG_DFL); +#ifdef HAVE_WORKING_VFORK + sigprocmask (SIG_SETMASK, &procmask, 0); +#endif + child_setup (filefd, fd1, fd_error, (char **) new_argv, 0, current_dir); } UNBLOCK_INPUT; + +#ifdef HAVE_WORKING_VFORK + /* Restore the signal state. */ + sigaction (SIGPIPE, &sigpipe_action, 0); + sigprocmask (SIG_SETMASK, &procmask, 0); +#endif + #endif /* not WINDOWSNT */ /* The MSDOS case did this already. */ === modified file 'src/process.c' --- src/process.c 2011-02-07 05:02:02 +0000 +++ src/process.c 2011-02-12 18:53:24 +0000 @@ -1786,6 +1786,7 @@ sigset_t blocked; struct sigaction sigint_action; struct sigaction sigquit_action; + struct sigaction sigpipe_action; #ifdef AIX struct sigaction sighup_action; #endif @@ -1898,6 +1899,7 @@ and record the current handlers so they can be restored later. */ sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action ); sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action); + sigaddset (&blocked, SIGPIPE); sigaction (SIGPIPE, 0, &sigpipe_action); #ifdef AIX sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action ); #endif @@ -2054,6 +2056,9 @@ signal (SIGINT, SIG_DFL); signal (SIGQUIT, SIG_DFL); + /* GTK causes us to ignore SIGPIPE, make sure it is restored + in the child. */ + signal (SIGPIPE, SIG_DFL); /* Stop blocking signals in the child. */ sigprocmask (SIG_SETMASK, &procmask, 0); @@ -2142,6 +2147,7 @@ /* Restore the parent's signal handlers. */ sigaction (SIGINT, &sigint_action, 0); sigaction (SIGQUIT, &sigquit_action, 0); + sigaction (SIGPIPE, &sigpipe_action, 0); #ifdef AIX sigaction (SIGHUP, &sighup_action, 0); #endif ------------------------------------------------------------ revno: 103235 committer: Tassilo Horn branch nick: trunk timestamp: Sat 2011-02-12 19:30:13 +0100 message: * minibuffer.el (completion-table-case-fold): New function for creating a case-insensitive completion table. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-12 17:51:02 +0000 +++ lisp/ChangeLog 2011-02-12 18:30:13 +0000 @@ -1,3 +1,8 @@ +2011-02-12 Tassilo Horn + + * minibuffer.el (completion-table-case-fold): New function for + creating a case-insensitive completion table. + 2011-02-12 Teodor Zlatanov * net/tramp.el (tramp-default-method): Also check if === modified file 'lisp/minibuffer.el' --- lisp/minibuffer.el 2011-01-25 04:08:28 +0000 +++ lisp/minibuffer.el 2011-02-12 18:30:13 +0000 @@ -196,6 +196,10 @@ (setq ,var (,fun))) ,var)))) +(defun completion-table-case-fold (table string pred action) + (let ((completion-ignore-case t)) + (complete-with-action action table string pred))) + (defun completion-table-with-context (prefix table string pred action) ;; TODO: add `suffix' maybe? ;; Notice that `pred' may not be a function in some abusive cases. ------------------------------------------------------------ revno: 103234 committer: Ted Zlatanov branch nick: quickfixes timestamp: Sat 2011-02-12 11:51:02 -0600 message: Use `auto-source-search' instead of `auto-source-user-or-password'. * mail/smtpmail.el: Autoload `auto-source-search' instead of `auto-source-user-or-password. (smtpmail-try-auth-methods): Use it. * net/imap-hash.el: Autoload `auto-source-search' instead of `auto-source-user-or-password. (imap-hash-open-connection): Use it. * net/tramp-imap.el: Autoload `auto-source-search' instead of `auto-source-user-or-password. (tramp-imap-passphrase-callback-function): Use it. * net/tramp.el (tramp-default-method): Also check if `auth-source-search' is bound. (tramp-read-passwd): Use `auth-source-search' instead of `auto-source-user-or-password'. * url-parse.el (url-bit-for-url, url-user-for-url) (url-password-for-url): Use `auto-source-search' instead of `auto-source-user-or-password'. * url-auth.el: Autoload `auto-source-search' instead of `auto-source-user-or-password'. (url-basic-auth, url-digest-auth, url-do-auth-source-search): Use it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-02-12 01:18:15 +0000 +++ lisp/ChangeLog 2011-02-12 17:51:02 +0000 @@ -1,3 +1,22 @@ +2011-02-12 Teodor Zlatanov + + * net/tramp.el (tramp-default-method): Also check if + `auth-source-search' is bound. + (tramp-read-passwd): Use `auth-source-search' instead of + `auto-source-user-or-password'. + + * net/tramp-imap.el: Autoload `auto-source-search' instead of + `auto-source-user-or-password. + (tramp-imap-passphrase-callback-function): Use it. + + * net/imap-hash.el: Autoload `auto-source-search' instead of + `auto-source-user-or-password. + (imap-hash-open-connection): Use it. + + * mail/smtpmail.el: Autoload `auto-source-search' instead of + `auto-source-user-or-password. + (smtpmail-try-auth-methods): Use it. + 2011-02-12 Phil Hagelberg * emacs-lisp/package.el: Allow packages to be reinstalled. === modified file 'lisp/mail/smtpmail.el' --- lisp/mail/smtpmail.el 2011-01-25 04:08:28 +0000 +++ lisp/mail/smtpmail.el 2011-02-12 17:51:02 +0000 @@ -77,7 +77,7 @@ (autoload 'netrc-machine "netrc") (autoload 'netrc-get "netrc") (autoload 'password-read "password-cache") -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") ;;; (defgroup smtpmail nil @@ -538,10 +538,14 @@ (defun smtpmail-try-auth-methods (process supported-extensions host port) (let* ((mechs (cdr-safe (assoc 'auth supported-extensions))) (mech (car (smtpmail-intersection mechs smtpmail-auth-supported))) - (auth-user (auth-source-user-or-password - "login" host (or port "smtp"))) - (auth-pass (auth-source-user-or-password - "password" host (or port "smtp"))) + (auth-info (auth-source-search :max 1 + :host host + :port (or port "smtp"))) + (auth-user (plist-get (nth 0 auth-info) :user)) + (auth-pass (plist-get (nth 0 auth-info) :secret)) + (auth-pass (if (functionp auth-pass) + (funcall auth-pass) + auth-pass)) (cred (if (and auth-user auth-pass) ; try user-auth-* before netrc-* (list host port auth-user auth-pass) ;; else, if auth-source didn't return them... === modified file 'lisp/net/imap-hash.el' --- lisp/net/imap-hash.el 2011-01-25 04:08:28 +0000 +++ lisp/net/imap-hash.el 2011-02-12 17:51:02 +0000 @@ -43,7 +43,7 @@ (require 'imap) (require 'sendmail) ; for mail-header-separator (require 'message) -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") ;; retrieve these headers (defvar imap-hash-headers @@ -267,13 +267,14 @@ (imap-hash-password iht)))) ;; this will not be needed if auth-need is t (auth-info (when auth-need - (auth-source-user-or-password - '("login" "password") - server port))) + (nth 0 (auth-source-search :host server :port port)))) (auth-user (or (imap-hash-user iht) - (nth 0 auth-info))) + (plist-get auth-info :user))) (auth-passwd (or (imap-hash-password iht) - (nth 1 auth-info))) + (plist-get auth-info :secret))) + (auth-passwd (if (functionp auth-passwd) + (funcall auth-passwd) + auth-passwd)) (imap-logout-timeout nil)) ;; (debug "opening server: opened+state" (imap-opened) imap-state) === modified file 'lisp/net/tramp-imap.el' --- lisp/net/tramp-imap.el 2011-02-05 09:52:07 +0000 +++ lisp/net/tramp-imap.el 2011-02-12 17:51:02 +0000 @@ -56,7 +56,7 @@ (require 'assoc) (require 'tramp) -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") (autoload 'epg-context-operation "epg") (autoload 'epg-context-set-armor "epg") (autoload 'epg-context-set-passphrase-callback "epg") @@ -639,8 +639,14 @@ KEY-ID can be 'SYM or 'PIN among others." (let* ((server tramp-current-host) (port "tramp-imap") ; this is NOT the server password! - (auth-passwd - (auth-source-user-or-password "password" server port))) + (auth-passwd (plist-get + (nth 0 (auth-source-search :max 1 + :host server + :port port)) + :secret)) + (auth-passwd (if (functionp auth-passwd) + (funcall auth-passwd) + auth-passwd))) (or (copy-sequence auth-passwd) ;; If we cache the passphrase and we have one. === modified file 'lisp/net/tramp.el' --- lisp/net/tramp.el 2011-02-05 09:58:45 +0000 +++ lisp/net/tramp.el 2011-02-12 17:51:02 +0000 @@ -297,6 +297,7 @@ (executable-find "pscp")) (if (or (fboundp 'password-read) (fboundp 'auth-source-user-or-password) + (fboundp 'auth-source-search) ;; Pageant is running. (tramp-compat-process-running-p "Pageant")) "pscp" @@ -307,6 +308,7 @@ ((tramp-detect-ssh-controlmaster) "scpc") ((or (fboundp 'password-read) (fboundp 'auth-source-user-or-password) + (fboundp 'auth-source-search) ;; ssh-agent is running. (getenv "SSH_AUTH_SOCK") (getenv "SSH_AGENT_PID")) @@ -3519,7 +3521,8 @@ (or prompt (with-current-buffer (process-buffer proc) (tramp-check-for-regexp proc tramp-password-prompt-regexp) - (format "%s for %s " (capitalize (match-string 1)) key))))) + (format "%s for %s " (capitalize (match-string 1)) key)))) + auth-info auth-passwd) (with-parsed-tramp-file-name key nil (prog1 (or @@ -3527,9 +3530,22 @@ (and (boundp 'auth-sources) (tramp-get-connection-property v "first-password-request" nil) ;; Try with Tramp's current method. - (tramp-compat-funcall - 'auth-source-user-or-password - "password" tramp-current-host tramp-current-method)) + (if (fboundp 'auth-source-search) + (progn + (setq auth-info + (tramp-compat-funcall + 'auth-source-search + :max 1 + :user (or tramp-current-user t) + :host tramp-current-host + :port tramp-current-method)) + (setq auth-passwd (plist-get (nth 0 auth-info) :secret)) + (setq auth-passwd (if (functionp auth-passwd) + (funcall auth-passwd) + auth-passwd))) + (tramp-compat-funcall + 'auth-source-user-or-password + "password" tramp-current-host tramp-current-method))) ;; Try the password cache. (when (functionp 'password-read) (unless (tramp-get-connection-property === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2011-02-03 06:23:35 +0000 +++ lisp/url/ChangeLog 2011-02-12 17:51:02 +0000 @@ -1,3 +1,13 @@ +2011-02-12 Teodor Zlatanov + + * url-parse.el (url-bit-for-url, url-user-for-url) + (url-password-for-url): Use `auto-source-search' instead of + `auto-source-user-or-password'. + + * url-auth.el: Autoload `auto-source-search' instead of + `auto-source-user-or-password'. + (url-basic-auth, url-digest-auth, url-do-auth-source-search): Use it. + 2011-02-03 Lars Ingebrigtsen * url-http.el (url-http-wait-for-headers-change-function): Don't === modified file 'lisp/url/url-auth.el' --- lisp/url/url-auth.el 2011-01-25 04:08:28 +0000 +++ lisp/url/url-auth.el 2011-02-12 17:51:02 +0000 @@ -24,7 +24,7 @@ (require 'url-vars) (require 'url-parse) (autoload 'url-warn "url") -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") (defsubst url-auth-user-prompt (url realm) "String to usefully prompt for a username." @@ -81,11 +81,11 @@ (cond ((and prompt (not byserv)) (setq user (or - (auth-source-user-or-password "login" server type) + (url-do-auth-source-search server type :user) (read-string (url-auth-user-prompt url realm) (or user (user-real-login-name)))) pass (or - (auth-source-user-or-password "password" server type) + (url-do-auth-source-search server type :secret) (read-passwd "Password: " nil (or pass "")))) (set url-basic-auth-storage (cons (list server @@ -110,11 +110,11 @@ (if (or (and (not retval) prompt) overwrite) (progn (setq user (or - (auth-source-user-or-password "login" server type) + (url-do-auth-source-search server type :user) (read-string (url-auth-user-prompt url realm) (user-real-login-name))) pass (or - (auth-source-user-or-password "password" server type) + (url-do-auth-source-search server type :secret) (read-passwd "Password: ")) retval (base64-encode-string (format "%s:%s" user pass)) byserv (assoc server (symbol-value url-basic-auth-storage))) @@ -173,11 +173,11 @@ (cond ((and prompt (not byserv)) (setq user (or - (auth-source-user-or-password "login" server type) + (url-do-auth-source-search server type :user) (read-string (url-auth-user-prompt url realm) (user-real-login-name))) pass (or - (auth-source-user-or-password "password" server type) + (url-do-auth-source-search server type :secret) (read-passwd "Password: ")) url-digest-auth-storage (cons (list server @@ -204,11 +204,11 @@ (if overwrite (if (and (not retval) prompt) (setq user (or - (auth-source-user-or-password "login" server type) + (url-do-auth-source-search server type :user) (read-string (url-auth-user-prompt url realm) (user-real-login-name))) pass (or - (auth-source-user-or-password "password" server type) + (url-do-auth-source-search server type :secret) (read-passwd "Password: ")) retval (setq retval (cons user @@ -244,6 +244,13 @@ "A list of the registered authorization schemes and various and sundry information associated with them.") +(defun url-do-auth-source-search (server type parameter) + (let* ((auth-info (auth-source-search :max 1 :host server :port type)) + (auth-info (nth 0 auth-info)) + (token (plist-get auth-info parameter)) + (token (if (functionp token) (funcall token) token))) + token)) + ;;;###autoload (defun url-get-authentication (url realm type prompt &optional args) "Return an authorization string suitable for use in the WWW-Authenticate === modified file 'lisp/url/url-parse.el' --- lisp/url/url-parse.el 2011-01-25 04:08:28 +0000 +++ lisp/url/url-parse.el 2011-02-12 17:51:02 +0000 @@ -178,20 +178,25 @@ `(let* ((urlobj (url-generic-parse-url url)) (bit (funcall ,method urlobj)) (methods (list 'url-recreate-url - 'url-host))) + 'url-host)) + auth-info) (while (and (not bit) (> (length methods) 0)) - (setq bit - (auth-source-user-or-password - ,lookfor (funcall (pop methods) urlobj) (url-type urlobj)))) + (setq auth-info (auth-source-search + :max 1 + :host (funcall (pop methods) urlobj) + :port (url-type urlobj))) + (setq bit (plist-get (nth 0 auth-info) ,lookfor)) + (when (functionp bit) + (setq bit (funcall bit)))) bit)) (defun url-user-for-url (url) "Attempt to use .authinfo to find a user for this URL." - (url-bit-for-url 'url-user "login" url)) + (url-bit-for-url 'url-user :user url)) (defun url-password-for-url (url) "Attempt to use .authinfo to find a password for this URL." - (url-bit-for-url 'url-password "password" url)) + (url-bit-for-url 'url-password :secret url)) (provide 'url-parse) ------------------------------------------------------------ revno: 103233 committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2011-02-12 17:48:10 +0200 message: Fix bug #7939 with bidi display of hscrolled lines. xdisp.c : New variable. (move_it_in_display_line_to): Record in this_line_min_pos the smallest position iterated across. (display_line): Use this_line_min_pos to record the smallest position in the line even if that position is not displayed due to hscrolling. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-12 10:05:38 +0000 +++ src/ChangeLog 2011-02-12 15:48:10 +0000 @@ -1,3 +1,12 @@ +2011-02-12 Eli Zaretskii + + * xdisp.c : New variable. + (move_it_in_display_line_to): Record in this_line_min_pos the + smallest position iterated across. + (display_line): Use this_line_min_pos to record the smallest + position in the line even if it is not displayed due to + hscrolling. (Bug#7939) + 2011-02-12 Paul Eggert Port to Sun C 5.11, which has __attribute__ ((__aligned (N))). === modified file 'src/xdisp.c' --- src/xdisp.c 2011-02-06 19:44:36 +0000 +++ src/xdisp.c 2011-02-12 15:48:10 +0000 @@ -444,6 +444,12 @@ static int this_line_start_x; +/* The smallest character position seen by move_it_* functions as they + move across display lines. Used to set MATRIX_ROW_START_CHARPOS of + hscrolled lines, see display_line. */ + +static struct text_pos this_line_min_pos; + /* Buffer that this_line_.* variables are referring to. */ static struct buffer *this_line_buffer; @@ -6909,6 +6915,9 @@ && it->current_y < it->last_visible_y) handle_line_prefix (it); + if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) + SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it)); + while (1) { int x, i, ascent = 0, descent = 0; @@ -7013,6 +7022,9 @@ if (it->area != TEXT_AREA) { set_iterator_to_next (it, 1); + if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) + SET_TEXT_POS (this_line_min_pos, + IT_CHARPOS (*it), IT_BYTEPOS (*it)); continue; } @@ -7121,6 +7133,9 @@ } set_iterator_to_next (it, 1); + if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) + SET_TEXT_POS (this_line_min_pos, + IT_CHARPOS (*it), IT_BYTEPOS (*it)); /* On graphical terminals, newlines may "overflow" into the fringe if overflow-newline-into-fringe is non-nil. @@ -7219,6 +7234,8 @@ /* The current display element has been consumed. Advance to the next. */ set_iterator_to_next (it, 1); + if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) + SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it)); /* Stop if lines are truncated and IT's current x-position is past the right edge of the window now. */ @@ -17139,18 +17156,15 @@ if (min_pos <= ZV) SET_TEXT_POS (row->minpos, min_pos, min_bpos); else + /* We didn't find _any_ valid buffer positions in any of the + glyphs, so we must trust the iterator's computed positions. */ + row->minpos = row->start.pos; + if (max_pos <= 0) { - /* We didn't find _any_ valid buffer positions in any of the - glyphs, so we must trust the iterator's computed - positions. */ - row->minpos = row->start.pos; max_pos = CHARPOS (it->current.pos); max_bpos = BYTEPOS (it->current.pos); } - if (!max_pos) - abort (); - /* Here are the various use-cases for ending the row, and the corresponding values for ROW->maxpos: @@ -17263,8 +17277,18 @@ if the first glyph is partially visible or if we hit a line end. */ if (it->current_x < it->first_visible_x) { + SET_TEXT_POS (this_line_min_pos, ZV + 1, ZV_BYTE + 1); move_it_in_display_line_to (it, ZV, it->first_visible_x, MOVE_TO_POS | MOVE_TO_X); + /* Record the smallest positions seen while we moved over + display elements that are not visible. This is needed by + redisplay_internal for optimizing the case where the cursor + stays inside the same line. The rest of this function only + considers positions that are actually displayed, so + RECORD_MAX_MIN_POS will not otherwise record positions that + are hscrolled to the left of the left edge of the window. */ + min_pos = CHARPOS (this_line_min_pos); + min_bpos = BYTEPOS (this_line_min_pos); } else { ------------------------------------------------------------ revno: 103232 committer: Paul Eggert branch nick: trunk timestamp: Sat 2011-02-12 02:05:38 -0800 message: Port to Sun C 5.11, which has __attribute__ ((__aligned (N))). * md5.h (ATTRIBUTE_ALIGNED): New macro. (struct md5_ctx): Use it. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-12 05:13:34 +0000 +++ src/ChangeLog 2011-02-12 10:05:38 +0000 @@ -1,5 +1,9 @@ 2011-02-12 Paul Eggert + Port to Sun C 5.11, which has __attribute__ ((__aligned (N))). + * md5.h (ATTRIBUTE_ALIGNED): New macro. + (struct md5_ctx): Use it. + Port to Solaris 10, which doesn't support FC_HINT_STYLE. * xftfont.c (FC_HINT_STYLE): #define to "hintstyle" if not defined. === modified file 'src/md5.h' --- src/md5.h 2011-01-15 23:16:57 +0000 +++ src/md5.h 2011-02-12 10:05:38 +0000 @@ -72,9 +72,10 @@ #endif -#ifndef __GNUC__ -#define __attribute__(X) -#define __alignof__(X) 1 +#if HAVE_ATTRIBUTE_ALIGNED +# define ATTRIBUTE_ALIGNED(N) __attribute__ ((__aligned__ (N))) +#else +# define ATTRIBUTE_ALIGNED(N) #endif /* Structure to save state of computation between the single steps. */ @@ -87,7 +88,7 @@ md5_uint32 total[2]; md5_uint32 buflen; - char buffer[128] __attribute__ ((__aligned__ (__alignof__ (md5_uint32)))); + char buffer[128] ATTRIBUTE_ALIGNED (__alignof__ (md5_uint32)); }; /* @@ -145,4 +146,3 @@ void *resblock); #endif /* md5.h */ - ------------------------------------------------------------ revno: 103231 committer: Paul Eggert branch nick: trunk timestamp: Fri 2011-02-11 21:13:34 -0800 message: Port to Solaris 10, which doesn't support FC_HINT_STYLE. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-02-11 15:40:19 +0000 +++ src/ChangeLog 2011-02-12 05:13:34 +0000 @@ -1,3 +1,11 @@ +2011-02-12 Paul Eggert + + Port to Solaris 10, which doesn't support FC_HINT_STYLE. + * xftfont.c (FC_HINT_STYLE): #define to "hintstyle" if not + defined. + * xsettings.c (parse_settings, apply_xft_settings): Don't assume + FC_HINT_STYLE is supported. + 2011-02-11 Jan Djärv * xterm.c (x_set_frame_alpha): Access data before it is free:d. === modified file 'src/xftfont.c' --- src/xftfont.c 2011-02-05 22:30:14 +0000 +++ src/xftfont.c 2011-02-12 05:13:34 +0000 @@ -187,17 +187,20 @@ double dpi; FcPatternGetBool (pat, FC_ANTIALIAS, 0, &b); - if (! b) + if (! b) { FcPatternDel (match, FC_ANTIALIAS); FcPatternAddBool (match, FC_ANTIALIAS, FcFalse); } FcPatternGetBool (pat, FC_HINTING, 0, &b); - if (! b) + if (! b) { FcPatternDel (match, FC_HINTING); FcPatternAddBool (match, FC_HINTING, FcFalse); } +#ifndef FC_HINT_STYLE +# define FC_HINT_STYLE "hintstyle" +#endif if (FcResultMatch == FcPatternGetInteger (pat, FC_HINT_STYLE, 0, &i)) { FcPatternDel (match, FC_HINT_STYLE); @@ -781,4 +784,3 @@ register_font_driver (&xftfont_driver, NULL); } - === modified file 'src/xsettings.c' --- src/xsettings.c 2011-01-25 04:08:28 +0000 +++ src/xsettings.c 2011-02-12 05:13:34 +0000 @@ -75,7 +75,7 @@ SEEN_FONT = 0x40, SEEN_TB_STYLE = 0x80, }; -struct xsettings +struct xsettings { #ifdef HAVE_XFT FcBool aa, hinting; @@ -104,7 +104,7 @@ gpointer user_data) { GConfValue *v = gconf_entry_get_value (entry); - + if (!v) return; if (v->type == GCONF_VALUE_STRING) { @@ -196,7 +196,7 @@ 4 CARD32 last-change-serial and then the value, For string: - + bytes type what ------------------------------------ 4 CARD32 n = value-length @@ -280,7 +280,7 @@ (strcmp (XSETTINGS_FONT_NAME, name) == 0) || (strcmp (XSETTINGS_TOOL_BAR_STYLE, name) == 0); - switch (type) + switch (type) { case 0: /* Integer */ if (bytes_parsed+4 > bytes) return BadLength; @@ -310,14 +310,14 @@ case 2: /* RGB value */ /* No need to parse this */ if (bytes_parsed+8 > bytes) return BadLength; - bytes_parsed += 8; /* 4 values (r, b, g, alpha), 2 bytes each. */ + bytes_parsed += 8; /* 4 values (r, b, g, alpha), 2 bytes each. */ break; default: /* Parse Error */ return BadValue; } - if (want_this) + if (want_this) { ++settings_seen; if (strcmp (name, XSETTINGS_FONT_NAME) == 0) @@ -341,6 +341,7 @@ settings->seen |= SEEN_HINTING; settings->hinting = ival != 0; } +# ifdef FC_HINT_STYLE else if (strcmp (name, "Xft/HintStyle") == 0) { settings->seen |= SEEN_HINTSTYLE; @@ -355,6 +356,7 @@ else settings->seen &= ~SEEN_HINTSTYLE; } +# endif else if (strcmp (name, "Xft/RGBA") == 0) { settings->seen |= SEEN_RGBA; @@ -442,7 +444,9 @@ pat); FcPatternGetBool (pat, FC_ANTIALIAS, 0, &oldsettings.aa); FcPatternGetBool (pat, FC_HINTING, 0, &oldsettings.hinting); +# ifdef FC_HINT_STYLE FcPatternGetInteger (pat, FC_HINT_STYLE, 0, &oldsettings.hintstyle); +# endif FcPatternGetInteger (pat, FC_LCD_FILTER, 0, &oldsettings.lcdfilter); FcPatternGetInteger (pat, FC_RGBA, 0, &oldsettings.rgba); FcPatternGetDouble (pat, FC_DPI, 0, &oldsettings.dpi); @@ -488,6 +492,7 @@ if (strlen (buf) > 0) strcat (buf, ", "); sprintf (buf+strlen (buf), "LCDFilter: %d", oldsettings.lcdfilter); +# ifdef FC_HINT_STYLE if ((settings->seen & SEEN_HINTSTYLE) != 0 && oldsettings.hintstyle != settings->hintstyle) { @@ -496,6 +501,7 @@ ++changed; oldsettings.hintstyle = settings->hintstyle; } +# endif if (strlen (buf) > 0) strcat (buf, ", "); sprintf (buf+strlen (buf), "Hintstyle: %d", oldsettings.hintstyle); @@ -508,7 +514,7 @@ FcPatternAddDouble (pat, FC_DPI, settings->dpi); ++changed; oldsettings.dpi = settings->dpi; - + /* Change the DPI on this display and all frames on the display. */ dpyinfo->resy = dpyinfo->resx = settings->dpi; FOR_EACH_FRAME (tail, frame) @@ -565,7 +571,7 @@ if (settings.seen & SEEN_FONT) { - if (!current_font || strcmp (current_font, settings.font) != 0) + if (!current_font || strcmp (current_font, settings.font) != 0) { free (current_font); current_font = settings.font; @@ -774,4 +780,3 @@ Fprovide (intern_c_string ("dynamic-setting"), Qnil); } - ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.