From 7b1bf1735e58fbadbe180d4bbbe3a00cf71baed4 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 12 Nov 2012 19:11:46 -0800 Subject: Use new names for hooks rather than obsolete aliases * lisp/cedet/semantic/lex-spp.el (semantic-lex-spp-lex-text-string): * lisp/cedet/semantic/util.el (semantic-describe-buffer): * lisp/cedet/semantic/bovine/c.el (semantic-c-parse-lexical-token) (semantic-default-c-setup): * lisp/emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke): * lisp/gnus/gnus-diary.el (nndiary-request-create-group-functions) (nndiary-request-update-info-functions) (gnus-subscribe-newsgroup-functions) (nndiary-request-accept-article-functions): * lisp/net/tramp-gvfs.el (tramp-gvfs-dbus-event-error): Use new names for hooks rather than obsolete aliases. * lisp/arc-mode.el: * lisp/emacs-lisp/checkdoc.el: Related comments. * etc/NEWS: Related markup. --- etc/NEWS | 1 + lisp/ChangeLog | 6 ++++++ lisp/arc-mode.el | 2 +- lisp/cedet/ChangeLog | 8 ++++++++ lisp/cedet/semantic/bovine/c.el | 6 +++--- lisp/cedet/semantic/lex-spp.el | 6 +++--- lisp/cedet/semantic/util.el | 2 +- lisp/emacs-lisp/checkdoc.el | 2 +- lisp/emacs-lisp/eieio-datadebug.el | 2 +- lisp/gnus/ChangeLog | 8 ++++++++ lisp/gnus/gnus-diary.el | 12 ++++++------ lisp/net/tramp-gvfs.el | 4 ++-- 12 files changed, 41 insertions(+), 18 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 623b40bb64f..00106469415 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -629,6 +629,7 @@ enabled. ** FIXME something happened to ses.el, 2012-04-17. ++++ ** Hooks renamed to avoid obsolete "-hooks" suffix: *** semantic-lex-reset-hooks -> semantic-lex-reset-functions *** semantic-change-hooks -> semantic-change-functions diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2ad7230e912..61d202433fc 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2012-11-13 Glenn Morris + + * emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke): + * net/tramp-gvfs.el (tramp-gvfs-dbus-event-error): + Use new names for hooks rather than obsolete aliases. + 2012-11-12 Stefan Monnier * emacs-lisp/gv.el (gv-define-simple-setter): One more fix (bug#12871). diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index cebd4302d0c..9fc91a242d2 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -96,7 +96,7 @@ ;; ;; archive-mode-hook ;; archive-foo-mode-hook -;; archive-extract-hooks +;; archive-extract-hook ;;; Code: diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 6de901848c7..56207c7ae57 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,11 @@ +2012-11-13 Glenn Morris + + * semantic/lex-spp.el (semantic-lex-spp-lex-text-string): + * semantic/util.el (semantic-describe-buffer): + * semantic/bovine/c.el (semantic-c-parse-lexical-token) + (semantic-default-c-setup): + Use new names for hooks rather than obsolete aliases. + 2012-11-12 Stefan Monnier * semantic/mru-bookmark.el (semantic-mru-bookmark-mode): diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 02ad6e05d1a..a3d57108d1d 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -931,8 +931,8 @@ the regular parser." (setq semantic-new-buffer-fcn-was-run t) (semantic-lex-init) (semantic-clear-toplevel-cache) - (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook - t) + (remove-hook 'semantic-lex-reset-functions + 'semantic-lex-spp-reset-hook t) ) ;; Get the macro symbol table right. (setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms) @@ -2073,7 +2073,7 @@ actually in their parent which is not accessible.") ) (setq semantic-lex-analyzer #'semantic-c-lexer) - (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t) + (add-hook 'semantic-lex-reset-functions 'semantic-lex-spp-reset-hook nil t) (when (eq major-mode 'c++-mode) (add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__cplusplus" . ""))) ) diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 406f2900563..ad366c2b94f 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -30,7 +30,7 @@ ;; If you use SPP in your language, be sure to specify this in your ;; semantic language setup function: ;; -;; (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t) +;; (add-hook 'semantic-lex-reset-functions 'semantic-lex-spp-reset-hook nil t) ;; ;; ;; Special Lexical Tokens: @@ -947,8 +947,8 @@ and variable state from the current buffer." (setq semantic-new-buffer-fcn-was-run t) (semantic-lex-init) (semantic-clear-toplevel-cache) - (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook - t) + (remove-hook 'semantic-lex-reset-functions + 'semantic-lex-spp-reset-hook t) )) ;; Second Cheat: copy key variables regarding macro state from the diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index 65201c4fd12..f3d30f6af5c 100644 --- a/lisp/cedet/semantic/util.el +++ b/lisp/cedet/semantic/util.el @@ -280,7 +280,7 @@ If TAG is not specified, use the tag at point." semantic-parser-name semantic-parse-tree-state semantic-lex-analyzer - semantic-lex-reset-hooks + semantic-lex-reset-functions semantic-lex-syntax-modifications ))) (dolist (V vars) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index ffa42e97221..1cbed17cbab 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -124,7 +124,7 @@ ;; Adding your own checks: ;; ;; You can experiment with adding your own checks by setting the -;; hooks `checkdoc-style-functions' and `checkdoc-comment-style-hooks'. +;; hooks `checkdoc-style-functions' and `checkdoc-comment-style-functions'. ;; Return a string which is the error you wish to report. The cursor ;; position should be preserved. ;; diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index ec470d21bf3..a1db1972b83 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -131,7 +131,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button." (defun eieio-debug-methodinvoke (method class) "Show the method invocation order for METHOD with CLASS object." (interactive "aMethod: \nXClass Expression: ") - (let* ((eieio-pre-method-execution-hooks + (let* ((eieio-pre-method-execution-functions (lambda (l) (throw 'moose l) )) (data (catch 'moose (eieio-generic-call diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 8cb53de85fa..d1cf22fd971 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,11 @@ +2012-11-13 Glenn Morris + + * gnus-diary.el (nndiary-request-create-group-functions) + (nndiary-request-update-info-functions) + (gnus-subscribe-newsgroup-functions) + (nndiary-request-accept-article-functions): + Use new names for hooks rather than obsolete aliases. + 2012-10-23 Stefan Monnier * nndiary.el (nndiary-request-create-group-functions) diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 854af2f5d76..bca307b19b6 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -277,18 +277,18 @@ Optional prefix (or REVERSE argument) means sort in reverse order." ;; Called when a group is subscribed. This is needed because groups created ;; because of mail splitting are *not* created with the back end function. -;; Thus, `nndiary-request-create-group-hooks' is inoperative. +;; Thus, `nndiary-request-create-group-functions' is inoperative. (defun gnus-diary-maybe-update-group-parameters (group) (when (eq (car (gnus-find-method-for-group group)) 'nndiary) (gnus-diary-update-group-parameters group))) -(add-hook 'nndiary-request-create-group-hooks +(add-hook 'nndiary-request-create-group-functions 'gnus-diary-update-group-parameters) -;; Now that we have `gnus-subscribe-newsgroup-hooks', this is not needed +;; Now that we have `gnus-subscribe-newsgroup-functions', this is not needed ;; anymore. Maybe I should remove this completely. -(add-hook 'nndiary-request-update-info-hooks +(add-hook 'nndiary-request-update-info-functions 'gnus-diary-update-group-parameters) -(add-hook 'gnus-subscribe-newsgroup-hooks +(add-hook 'gnus-subscribe-newsgroup-functions 'gnus-diary-maybe-update-group-parameters) @@ -384,7 +384,7 @@ If ARG (or prefix) is non-nil, force prompting for all fields." nndiary-headers) )) -(add-hook 'nndiary-request-accept-article-hooks +(add-hook 'nndiary-request-accept-article-functions (lambda () (gnus-diary-check-message nil))) (define-key message-mode-map "\C-c\C-fd" 'gnus-diary-check-message) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 60b39606d86..0aa1b8957ac 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -521,12 +521,12 @@ It is needed when D-Bus signals or errors arrive, because there is no information where to trace the message.") (defun tramp-gvfs-dbus-event-error (event err) - "Called when a D-Bus error message arrives, see `dbus-event-error-hooks'." + "Called when a D-Bus error message arrives, see `dbus-event-error-functions'." (when tramp-gvfs-dbus-event-vector (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event) (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err)))) -(add-hook 'dbus-event-error-hooks 'tramp-gvfs-dbus-event-error) +(add-hook 'dbus-event-error-functions 'tramp-gvfs-dbus-event-error) ;; File name primitives. -- cgit v1.2.1 From 314654db9bdf937d4fc9b770e688a42acb9a0514 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 12 Nov 2012 19:16:17 -0800 Subject: Remove placeholder ses.el NEWS entry Will move to trunk NEWS, since emacs-24 version is apparently not-ready-for-use; ref http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00221.html --- etc/NEWS | 2 -- 1 file changed, 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 00106469415..23210e5212f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -627,8 +627,6 @@ enabled, applies to all applicable major modes. ** winner-mode-hook now runs when the mode is disabled, as well as when it is enabled. -** FIXME something happened to ses.el, 2012-04-17. - +++ ** Hooks renamed to avoid obsolete "-hooks" suffix: *** semantic-lex-reset-hooks -> semantic-lex-reset-functions -- cgit v1.2.1 From 6e5e9b70f501a975baa4bce0b8f0854052435ff0 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 12 Nov 2012 19:40:44 -0800 Subject: Document new erc module "notifications" * doc/misc/erc.texi (Modules): Undocument obsolete "hecomplete". Add "notifications". * lisp/erc/erc.el (erc-modules): Add "notifications". Tweak "hecomplete" doc. * etc/NEWS: Related edit. --- doc/misc/ChangeLog | 5 +++++ doc/misc/erc.texi | 10 +++++----- etc/NEWS | 5 +++-- lisp/erc/ChangeLog | 4 ++++ lisp/erc/erc.el | 4 +++- 5 files changed, 20 insertions(+), 8 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index b3b4ad07147..82e0cd0f856 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,8 @@ +2012-11-13 Glenn Morris + + * erc.texi (Modules): Undocument obsolete "hecomplete". + Add "notifications". + 2012-11-12 Glenn Morris * flymake.texi (Customizable variables) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 378180bef31..b5c0dd3c718 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -390,11 +390,6 @@ Complete nicknames and commands (programmable) @item fill Wrap long lines -@cindex modules, hecomplete -@item hecomplete -Complete nicknames and commands (old). This is the old module---you -might prefer the ``completion'' module instead. - @cindex modules, identd @item identd Launch an identd server on port 8113 @@ -427,6 +422,11 @@ Don't display non-IRC commands after evaluation @item notify Notify when the online status of certain users changes +@cindex modules, notifications +@item notifications +Send you a notification when you get a private message, +or your nickname is mentioned + @cindex modules, page @item page Process CTCP PAGE requests from IRC diff --git a/etc/NEWS b/etc/NEWS index 23210e5212f..80c1e5ff4ad 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -434,8 +434,9 @@ The global binding for `M-=', `count-words-region' is in effect. ** ERC -*** New package `erc-desktop-notifications.el', which can send a notification -when you receive a private message or your nickname is mentioned. ++++ +*** New module "notifications", which can send a notification when you +receive a private message or your nickname is mentioned. *** ERC will look up server/channel names via auth-source and use any channel keys found. diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 13dbba769a4..390b34cba40 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,7 @@ +2012-11-13 Glenn Morris + + * erc.el (erc-modules): Add "notifications". Tweak "hecomplete" doc. + 2012-10-28 Stefan Monnier * erc-backend.el: Only require `erc' during compilation (bug#12740). diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2e97131b603..7cb6fbb595b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1843,7 +1843,7 @@ removed from the list will be disabled." capab-identify) (const :tag "completion: Complete nicknames and commands (programmable)" completion) - (const :tag "hecomplete: Complete nicknames and commands (old)" hecomplete) + (const :tag "hecomplete: Complete nicknames and commands (obsolete, use \"completion\")" hecomplete) (const :tag "dcc: Provide Direct Client-to-Client support" dcc) (const :tag "fill: Wrap long lines" fill) (const :tag "identd: Launch an identd server on port 8113" identd) @@ -1863,6 +1863,8 @@ removed from the list will be disabled." (const :tag "notify: Notify when the online status of certain users changes" notify) + (const :tag "notifications: Send notifications on PRIVMSG or nickname mentions" + notifications) (const :tag "page: Process CTCP PAGE requests from IRC" page) (const :tag "readonly: Make displayed lines read-only" readonly) (const :tag "replace: Replace text in messages" replace) -- cgit v1.2.1 From 9234627530cf2b766d7db64d2a059aaab11dc7b5 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Tue, 13 Nov 2012 08:40:07 +0100 Subject: Preserve window-point-insertion-type when copying window-point markers. (Bug#12588) * window.el (record-window-buffer) (display-buffer-record-window): When copying the markers to window-point preserve window-point-insertion-type. (Bug#12588) --- lisp/ChangeLog | 6 ++++++ lisp/window.el | 24 +++++++++++++++--------- 2 files changed, 21 insertions(+), 9 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 61d202433fc..c13ef1289f8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2012-11-13 Martin Rudalics + + * window.el (record-window-buffer) + (display-buffer-record-window): When copying the markers to + window-point preserve window-point-insertion-type. (Bug#12588) + 2012-11-13 Glenn Morris * emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke): diff --git a/lisp/window.el b/lisp/window.el index 30ee622cfe6..6ea66d9d0a2 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -3049,8 +3049,10 @@ WINDOW must be a live window and defaults to the selected one." (set-marker (nth 2 entry) point)) ;; Make new markers. (list (copy-marker start) - (copy-marker point))))) - + (copy-marker + ;; Preserve window-point-insertion-type + ;; (Bug#12588). + point window-point-insertion-type))))) (set-window-prev-buffers window (cons entry (window-prev-buffers window)))))))) @@ -4555,13 +4557,17 @@ element is BUFFER." ;; If WINDOW has a quit-restore parameter, reset its car. (setcar (window-parameter window 'quit-restore) 'same)) ;; WINDOW shows another buffer. - (set-window-parameter - window 'quit-restore - (list 'other - ;; A quadruple of WINDOW's buffer, start, point and height. - (list (window-buffer window) (window-start window) - (window-point window) (window-total-size window)) - (selected-window) buffer)))) + (with-current-buffer (window-buffer window) + (set-window-parameter + window 'quit-restore + (list 'other + ;; A quadruple of WINDOW's buffer, start, point and height. + (list (current-buffer) (window-start window) + ;; Preserve window-point-insertion-type (Bug#12588). + (copy-marker + (window-point window) window-point-insertion-type) + (window-total-size window)) + (selected-window) buffer))))) ((eq type 'window) ;; WINDOW has been created on an existing frame. (set-window-parameter -- cgit v1.2.1 From f99c65e5743526a7fcc6352599b6f0efd3970202 Mon Sep 17 00:00:00 2001 From: Jan Djärv Date: Tue, 13 Nov 2012 08:56:15 +0100 Subject: * nsterm.m (hold_event): Send SIGIO to make sure ns_read_socket is called. Fixes: debbugs:12834 --- src/ChangeLog | 5 +++++ src/nsterm.m | 2 ++ 2 files changed, 7 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index 494b2179516..d72091c0ed6 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2012-11-13 Jan Djärv + + * nsterm.m (hold_event): Send SIGIO to make sure ns_read_socket is + called (Bug#12834). + 2012-11-12 Eli Zaretskii * xdisp.c (decode_mode_spec): Limit the value of WIDTH argument diff --git a/src/nsterm.m b/src/nsterm.m index 9b2e544c75b..f4982e0a7cb 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -312,6 +312,8 @@ hold_event (struct input_event *event) } hold_event_q.q[hold_event_q.nr++] = *event; + /* Make sure ns_read_socket is called, i.e. we have input. */ + kill (0, SIGIO); } static Lisp_Object -- cgit v1.2.1 From f925b109e76f36081d9495252fcee204deb4c1fb Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 13 Nov 2012 00:05:42 -0800 Subject: * doc/misc/erc.texi (Connecting): Add brief section on passwords. * etc/NEWS: Related edit. --- doc/misc/ChangeLog | 1 + doc/misc/erc.texi | 24 ++++++++++++++++++++++++ etc/NEWS | 3 +++ 3 files changed, 28 insertions(+) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 82e0cd0f856..0a837320b43 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -2,6 +2,7 @@ * erc.texi (Modules): Undocument obsolete "hecomplete". Add "notifications". + (Connecting): Add brief section on passwords. 2012-11-12 Glenn Morris diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index b5c0dd3c718..ea315cd86fa 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -604,6 +604,30 @@ ERC should automatically attempt to connect with another nickname. You can manually set another nickname with the /NICK command. @end defopt +@subheading Password +@cindex password + +@defopt erc-prompt-for-password +If non-@code{nil} (the default), @kbd{M-x erc} prompts for a password. +@end defopt + +If you prefer, you can set this option to @code{nil} and use the +@code{auth-source} mechanism to store your password. For instance, if +you use @file{~/.authinfo} as your auth-source backend, then put +something like the following in that file: + +@example +machine irc.example.net login "#fsf" password sEcReT +@end example + +@noindent +ERC also consults @code{auth-source} to find any channel keys required +for the channels that you wish to autojoin, as specified by the +variable @code{erc-autojoin-channels-alist}. + +For more details, @pxref{Top,,auth-source, auth, Emacs auth-source Library}. + + @subheading Full name @defun erc-compute-full-name &optional full-name diff --git a/etc/NEWS b/etc/NEWS index 80c1e5ff4ad..ca20c4dcff1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -438,9 +438,12 @@ The global binding for `M-=', `count-words-region' is in effect. *** New module "notifications", which can send a notification when you receive a private message or your nickname is mentioned. ++++ *** ERC will look up server/channel names via auth-source and use any channel keys found. +*** FIXME erc-lurker-hide-list + +++ ** Flymake uses fringe bitmaps to indicate errors and warnings. See `flymake-fringe-indicator-position', `flymake-error-bitmap' and -- cgit v1.2.1 From 274f5de608fd1a4dd99c2f9e4e9214579554f437 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 13 Nov 2012 00:14:15 -0800 Subject: Document erc-lurker-hide-list * doc/misc/erc.texi (Options): Make a start by adding erc-hide-list, erc-lurker-hide-list. * etc/NEWS: Related edit. --- doc/misc/ChangeLog | 1 + doc/misc/erc.texi | 18 ++++++++++++++++-- etc/NEWS | 4 +++- 3 files changed, 20 insertions(+), 3 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 0a837320b43..1ec8a3d56ff 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -3,6 +3,7 @@ * erc.texi (Modules): Undocument obsolete "hecomplete". Add "notifications". (Connecting): Add brief section on passwords. + (Options): Make a start by adding erc-hide-list, erc-lurker-hide-list. 2012-11-12 Glenn Morris diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index ea315cd86fa..4be94df4b45 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -737,10 +737,24 @@ stuff, to the current ERC buffer." @c PRE5_4: (Node) Document every ERC option (module options go in @c previous chapter) -This section has not yet been written. For now, the easiest way to -check out the available options for ERC is to do +This section is extremely incomplete. For now, the easiest way to +check out all the available options for ERC is to do @kbd{M-x customize-group erc RET}. +@defopt erc-hide-list +If non, @code{nil}, this is a list of IRC message types to hide, e.g. + +@example +(setq erc-hide-list '("JOIN" "PART" "QUIT")) +@end example +@end defopt + +@defopt erc-lurker-hide-list +Like @code{erc-hide-list}, but only applies to messages sent by +lurkers. The function @code{erc-lurker-p} determines whether a given +nickname is considerd a lurker. +@end defopt + @node Getting Help and Reporting Bugs @chapter Getting Help and Reporting Bugs diff --git a/etc/NEWS b/etc/NEWS index ca20c4dcff1..9fcb2d13565 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -442,7 +442,9 @@ receive a private message or your nickname is mentioned. *** ERC will look up server/channel names via auth-source and use any channel keys found. -*** FIXME erc-lurker-hide-list ++++ +*** New option `erc-lurker-hide-list', similar to `erc-hide-list', but +only applies to messages sent by lurkers. +++ ** Flymake uses fringe bitmaps to indicate errors and warnings. -- cgit v1.2.1 From 5c934f8b268e07b41487dd73133381e6ed324a59 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 13 Nov 2012 00:16:58 -0800 Subject: * doc/misc/erc.texi: Use @code{nil} rather than just "nil". --- doc/misc/ChangeLog | 3 ++- doc/misc/erc.texi | 12 ++++++------ 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 1ec8a3d56ff..07f38d15dd9 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,6 +1,7 @@ 2012-11-13 Glenn Morris - * erc.texi (Modules): Undocument obsolete "hecomplete". + * erc.texi: Use @code{nil} rather than just "nil". + (Modules): Undocument obsolete "hecomplete". Add "notifications". (Connecting): Add brief section on passwords. (Options): Make a start by adding erc-hide-list, erc-lurker-hide-list. diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 4be94df4b45..834d2ea844d 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -530,7 +530,7 @@ parameters. @defun erc-compute-server &optional server Return an IRC server name. -This tries a number of increasingly more default methods until a non-nil +This tries a number of increasingly more default methods until a non-@code{nil} value is found. @itemize @bullet @@ -542,7 +542,7 @@ value is found. @end defun -@defopt erc-server nil +@defopt erc-server IRC server to use if one is not provided. @end defopt @@ -551,7 +551,7 @@ IRC server to use if one is not provided. @defun erc-compute-port &optional port Return a port for an IRC server. -This tries a number of increasingly more default methods until a non-nil +This tries a number of increasingly more default methods until a non-@code{nil} value is found. @itemize @bullet @@ -574,7 +574,7 @@ This can be either a string or a number. Return user's IRC nick. This tries a number of increasingly more default methods until a -non-nil value is found. +non-@code{nil} value is found. @itemize @item @var{nick} (the argument passed to this function) @@ -598,7 +598,7 @@ The string to append to the nick if it is already in use. @end defopt @defopt erc-try-new-nick-p -If the nickname you chose isn't available, and this option is non-nil, +If the nickname you chose isn't available, and this option is non-@code{nil}, ERC should automatically attempt to connect with another nickname. You can manually set another nickname with the /NICK command. @@ -634,7 +634,7 @@ For more details, @pxref{Top,,auth-source, auth, Emacs auth-source Library}. Return user's full name. This tries a number of increasingly more default methods until a -non-nil value is found. +non-@code{nil} value is found. @itemize @bullet @item @var{full-name} (the argument passed to this function) -- cgit v1.2.1 From 3c442f8b25bf6acc52c45a1f9966b8529ea936d2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Nov 2012 09:12:46 -0500 Subject: * lisp/emacs-lisp/advice.el: Layer on top of nadvice.el. Remove out of date self-require hack. (ad-do-advised-functions): Use simple `dolist'. (ad-advice-name, ad-advice-protected, ad-advice-enabled) (ad-advice-definition): Redefine as functions. (ad-advice-classes): Move before first use. (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition) (ad-make-mapped-call, ad-make-advised-docstring, ad-make-plain-docstring) (ad--defalias-fset): Remove functions. (ad-make-advicefunname, ad-clear-advicefunname-definition): New functions. (ad-get-orig-definition): Rewrite. (ad-make-advised-definition-docstring): Change base docstring. (ad-real-orig-definition): Rewrite. (ad-map-arglists): Change name of called function. (ad--make-advised-docstring): Redirect `function' from ad-Advice-... (ad-make-advised-definition): Simplify. (ad-assemble-advised-definition): Tweak for new calling context. (ad-activate-advised-definition): Setup ad-Advice-* instead of ad-Orig-*. (ad--defalias-fset): Rename from ad-handle-definition. Make it set the function and call ad-activate if needed. (ad-activate, ad-deactivate): Don't call ad-handle-definition any more. (ad-recover): Clear ad-Advice-* instead of ad-Orig-*. (ad-compile-function): Compile ad-Advice-*. (ad-activate-on-top-level, ad-with-auto-activation-disabled): Remove. (ad-start-advice, ad-stop-advice): Remove. --- etc/NEWS | 3 +- lisp/ChangeLog | 28 ++ lisp/emacs-lisp/advice.el | 730 ++++++++++++++--------------------------- test/automated/advice-tests.el | 23 ++ 4 files changed, 291 insertions(+), 493 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index fbe24c8345f..58acf81897c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -43,7 +43,8 @@ It is layered as: * Incompatible Lisp Changes in Emacs 24.4 -** `defadvice' does not honor the `freeze' flag any more. +** `defadvice' does not honor the `freeze' flag and cannot advise +special-forms any more. ** `dolist' in lexical-binding mode does not bind VAR in RESULT any more. VAR was bound to nil which was not tremendously useful and just lead to diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fc69b8643b6..72754190cf3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,31 @@ +2012-11-13 Stefan Monnier + + * emacs-lisp/advice.el: Layer on top of nadvice.el. + Remove out of date self-require hack. + (ad-do-advised-functions): Use simple `dolist'. + (ad-advice-name, ad-advice-protected, ad-advice-enabled) + (ad-advice-definition): Redefine as functions. + (ad-advice-classes): Move before first use. + (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition) + (ad-make-mapped-call, ad-make-advised-docstring, ad-make-plain-docstring) + (ad--defalias-fset): Remove functions. + (ad-make-advicefunname, ad-clear-advicefunname-definition): New functions. + (ad-get-orig-definition): Rewrite. + (ad-make-advised-definition-docstring): Change base docstring. + (ad-real-orig-definition): Rewrite. + (ad-map-arglists): Change name of called function. + (ad--make-advised-docstring): Redirect `function' from ad-Advice-... + (ad-make-advised-definition): Simplify. + (ad-assemble-advised-definition): Tweak for new calling context. + (ad-activate-advised-definition): Setup ad-Advice-* instead of ad-Orig-*. + (ad--defalias-fset): Rename from ad-handle-definition. Make it set the + function and call ad-activate if needed. + (ad-activate, ad-deactivate): Don't call ad-handle-definition any more. + (ad-recover): Clear ad-Advice-* instead of ad-Orig-*. + (ad-compile-function): Compile ad-Advice-*. + (ad-activate-on-top-level, ad-with-auto-activation-disabled): Remove. + (ad-start-advice, ad-stop-advice): Remove. + 2012-11-13 Dmitry Gutov * progmodes/ruby-mode.el (ruby-add-log-current-method): Print the diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index ecaf6861a6c..f9b4491e6e0 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -47,14 +47,12 @@ ;; @ Highlights: ;; ============= ;; - Clean definition of multiple, named before/around/after advices -;; for functions, macros, subrs and special forms +;; for functions and macros. ;; - Full control over the arguments an advised function will receive, ;; the binding environment in which it will be executed, as well as the ;; value it will return. -;; - Allows re/definition of interactive behavior for functions and subrs -;; - Every piece of advice can have its documentation string which will be -;; combined with the original documentation of the advised function at -;; call-time of `documentation' for proper command-key substitution. +;; - Allows re/definition of interactive behavior for commands. +;; - Every piece of advice can have its documentation string. ;; - The execution of every piece of advice can be protected against error ;; and non-local exits in preceding code or advices. ;; - Simple argument access either by name, or, more portable but as @@ -63,7 +61,7 @@ ;; version of a function. ;; - Advised functions can be byte-compiled either at file-compile time ;; (see preactivation) or activation time. -;; - Separation of advice definition and activation +;; - Separation of advice definition and activation. ;; - Forward advice is possible, that is ;; as yet undefined or autoload functions can be advised without having to ;; preload the file in which they are defined. @@ -77,7 +75,7 @@ ;; - En/disablement mechanism allows the use of different "views" of advised ;; functions depending on what pieces of advice are currently en/disabled ;; - Provides manipulation mechanisms for sets of advised functions via -;; regular expressions that match advice names +;; regular expressions that match advice names. ;; @ Overview, or how to read this file: ;; ===================================== @@ -113,23 +111,12 @@ ;; others come from the various Lisp advice mechanisms I've come across ;; so far, and a few are simply mine. -;; @ Comments, suggestions, bug reports: -;; ===================================== -;; If you find any bugs, have suggestions for new advice features, find the -;; documentation wrong, confusing, incomplete, or otherwise unsatisfactory, -;; have any questions about Advice, or have otherwise enlightening -;; comments feel free to send me email at . - ;; @ Safety Rules and Emergency Exits: ;; =================================== ;; Before we begin: CAUTION!! ;; Advice provides you with a lot of rope to hang yourself on very ;; easily accessible trees, so, here are a few important things you -;; should know: Once Advice has been started with `ad-start-advice' -;; (which happens automatically when you load this file), it -;; generates an advised definition of the `documentation' function, and -;; it will enable automatic advice activation when functions get defined. -;; All of this can be undone at any time with `M-x ad-stop-advice'. +;; should know: ;; ;; If you experience any strange behavior/errors etc. that you attribute to ;; Advice or to some ill-advised function do one of the following: @@ -137,45 +124,37 @@ ;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what ;; function gives you problems) ;; - M-x ad-deactivate-all (if you don't have a clue what's going wrong) -;; - M-x ad-stop-advice (if you think the problem is related to the -;; advised functions used by Advice itself) ;; - M-x ad-recover-normality (for real emergencies) ;; - If none of the above solves your Advice-related problem go to another ;; terminal, kill your Emacs process and send me some hate mail. -;; The first three measures have restarts, i.e., once you've figured out +;; The first two measures have restarts, i.e., once you've figured out ;; the problem you can reactivate advised functions with either `ad-activate', -;; `ad-activate-all', or `ad-start-advice'. `ad-recover-normality' unadvises +;; or `ad-activate-all'. `ad-recover-normality' unadvises ;; everything so you won't be able to reactivate any advised functions, you'll ;; have to stick with their standard incarnations for the rest of the session. -;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before -;; you byte-compile a file, because advised special forms and macros can lead -;; to unwanted compilation results. When you are done compiling use -;; `M-x ad-activate-all' to go back to the advised state of all your -;; advised functions. - ;; RELAX: Advice is pretty safe even if you are oblivious to the above. ;; I use it extensively and haven't run into any serious trouble in a long -;; time. Just wanted you to be warned. +;; time. Just wanted you to be warned. ;; @ Customization: ;; ================ ;; Look at the documentation of `ad-redefinition-action' for possible values -;; of this variable. Its default value is `warn' which will print a warning +;; of this variable. Its default value is `warn' which will print a warning ;; message when an already defined advised function gets redefined with a ;; new original definition and de/activated. ;; Look at the documentation of `ad-default-compilation-action' for possible -;; values of this variable. Its default value is `maybe' which will compile +;; values of this variable. Its default value is `maybe' which will compile ;; advised definitions during activation in case the byte-compiler is already -;; loaded. Otherwise, it will leave them uncompiled. +;; loaded. Otherwise, it will leave them uncompiled. ;; @ Motivation: ;; ============= ;; Before I go on explaining how advice works, here are four simple examples -;; how this package can be used. The first three are very useful, the last one +;; how this package can be used. The first three are very useful, the last one ;; is just a joke: ;;(defadvice switch-to-buffer (before existing-buffers-only activate) @@ -206,13 +185,12 @@ ;; @ Advice documentation: ;; ======================= -;; Below is general documentation of the various features of advice. For more +;; Below is general documentation of the various features of advice. For more ;; concrete examples check the corresponding sections in the tutorial part. ;; @@ Terminology: ;; =============== ;; - Emacs: Emacs as released by the GNU Project -;; - jwz: Jamie Zawinski - creator of the byte-compiler used in v19s. ;; - Advice: The name of this package. ;; - advices: Short for "pieces of advice". @@ -236,22 +214,22 @@ ;; is the name of the advice which has to be a non-nil symbol. ;; Names uniquely identify a piece of advice in a certain advice class, ;; hence, advices can be redefined by defining an advice with the same class -;; and name. Advice names are global symbols, hence, the same name space +;; and name. Advice names are global symbols, hence, the same name space ;; conventions used for function names should be applied. ;; An optional specifies where in the current list of advices of -;; the specified this new advice will be placed. has to +;; the specified this new advice will be placed. has to ;; be either `first', `last' or a number that specifies a zero-based -;; position (`first' is equivalent to 0). If no position is specified -;; `first' will be used as a default. If this call to `defadvice' redefines +;; position (`first' is equivalent to 0). If no position is specified +;; `first' will be used as a default. If this call to `defadvice' redefines ;; an already existing advice (see above) then the position argument will ;; be ignored and the position of the already existing advice will be used. ;; An optional which has to be a list can be used to define the -;; argument list of the advised function. This argument list should of +;; argument list of the advised function. This argument list should of ;; course be compatible with the argument list of the original function, ;; otherwise functions that call the advised function with the original -;; argument list in mind will break. If more than one advice specify an +;; argument list in mind will break. If more than one advice specify an ;; argument list then the first one (the one with the smallest position) ;; found in the list of before/around/after advices will be used. @@ -267,10 +245,10 @@ ;; `disable': Specifies that the defined advice should be disabled, hence, ;; it will not be used in an activation until somebody enables it. ;; `preactivate': Specifies that the advised function should get preactivated -;; at macro-expansion/compile time of this `defadvice'. This +;; at macro-expansion/compile time of this `defadvice'. This ;; generates a compiled advised definition according to the ;; current advice state which will be used during activation -;; if appropriate. Only use this if the `defadvice' gets +;; if appropriate. Only use this if the `defadvice' gets ;; actually compiled. ;; An optional can be supplied to document the advice. @@ -278,20 +256,20 @@ ;; documentation strings of the original function and other advices. ;; An optional form can be supplied to change/add -;; interactive behavior of the original function. If more than one advice +;; interactive behavior of the original function. If more than one advice ;; has an `(interactive ...)' specification then the first one (the one ;; with the smallest position) found in the list of before/around/after ;; advices will be used. ;; A possibly empty list of specifies the body of the advice in -;; an implicit progn. The body of an advice can access/change arguments, +;; an implicit progn. The body of an advice can access/change arguments, ;; the return value, the binding environment, and can have all sorts of ;; other side effects. ;; @@ Assembling advised definitions: ;; ================================== ;; Suppose a function/macro/subr/special-form has N pieces of before advice, -;; M pieces of around advice and K pieces of after advice. Assuming none of +;; M pieces of around advice and K pieces of after advice. Assuming none of ;; the advices is protected, its advised definition will look like this ;; (body-form indices correspond to the position of the respective advice in ;; that advice class): @@ -330,11 +308,11 @@ ;; be expanded into a proper documentation string upon call of `documentation'. ;; (interactive ...) is an optional interactive form either taken from the -;; original function or from a before/around/after advice. For advised +;; original function or from a before/around/after advice. For advised ;; interactive subrs that do not have an interactive form specified in any ;; advice we have to use (interactive) and then call the subr interactively ;; if the advised function was called interactively, because the -;; interactive specification of subrs is not accessible. This is the only +;; interactive specification of subrs is not accessible. This is the only ;; case where changing the values of arguments will not have an affect ;; because they will be reset by the interactive specification of the subr. ;; If this is a problem one can always specify an interactive form in a @@ -343,45 +321,44 @@ ;; ;; Then the body forms of the various advices in the various classes of advice ;; are assembled in order. The forms of around advice L are normally part of -;; one of the forms of around advice L-1. An around advice can specify where +;; one of the forms of around advice L-1. An around advice can specify where ;; the forms of the wrapped or surrounded forms should go with the special -;; keyword `ad-do-it', which will be substituted with a `progn' containing the -;; forms of the surrounded code. +;; keyword `ad-do-it', which will run the forms of the surrounded code. ;; The innermost part of the around advice onion is ;; > -;; whose form depends on the type of the original function. The variable -;; `ad-return-value' will be set to its result. This variable is visible to +;; whose form depends on the type of the original function. The variable +;; `ad-return-value' will be set to its result. This variable is visible to ;; all pieces of advice which can access and modify it before it gets returned. ;; ;; The semantic structure of advised functions that contain protected pieces -;; of advice is the same. The only difference is that `unwind-protect' forms +;; of advice is the same. The only difference is that `unwind-protect' forms ;; make sure that the protected advice gets executed even if some previous -;; piece of advice had an error or a non-local exit. If any around advice is +;; piece of advice had an error or a non-local exit. If any around advice is ;; protected then the whole around advice onion will be protected. ;; @@ Argument access in advised functions: ;; ======================================== ;; As already mentioned, the simplest way to access the arguments of an -;; advised function in the body of an advice is to refer to them by name. To -;; do that, the advice programmer needs to know either the names of the +;; advised function in the body of an advice is to refer to them by name. +;; To do that, the advice programmer needs to know either the names of the ;; argument variables of the original function, or the names used in the -;; argument list redefinition given in a piece of advice. While this simple +;; argument list redefinition given in a piece of advice. While this simple ;; method might be sufficient in many cases, it has the disadvantage that it ;; is not very portable because it hardcodes the argument names into the ;; advice. If the definition of the original function changes the advice -;; might break even though the code might still be correct. Situations like +;; might break even though the code might still be correct. Situations like ;; that arise, for example, if one advises a subr like `eval-region' which ;; gets redefined in a non-advice style into a function by the edebug -;; package. If the advice assumes `eval-region' to be a subr it might break -;; once edebug is loaded. Similar situations arise when one wants to use the +;; package. If the advice assumes `eval-region' to be a subr it might break +;; once edebug is loaded. Similar situations arise when one wants to use the ;; same piece of advice across different versions of Emacs. ;; As a solution to that advice provides argument list access macros that get ;; translated into the proper access forms at activation time, i.e., when the -;; advised definition gets constructed. Access macros access actual arguments +;; advised definition gets constructed. Access macros access actual arguments ;; by position regardless of how these actual argument get distributed onto -;; the argument variables of a function. The rational behind this is that in +;; the argument variables of a function. The rational behind this is that in ;; Emacs Lisp the semantics of an argument is strictly determined by its ;; position (there are no keyword arguments). @@ -393,9 +370,9 @@ ;; ;; (foo 0 1 2 3 4 5 6) -;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that -;; the semantics of an actual argument is determined by its position. It is -;; this semantics that has to be known by the advice programmer. Then s/he +;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that +;; the semantics of an actual argument is determined by its position. It is +;; this semantics that has to be known by the advice programmer. Then s/he ;; can access these arguments in a piece of advice with some of the ;; following macros (the arrows indicate what value they will return): @@ -408,17 +385,17 @@ ;; `(ad-get-arg )' will return the actual argument that was supplied ;; at , `(ad-get-args )' will return the list of actual -;; arguments supplied starting at . Note that these macros can be +;; arguments supplied starting at . Note that these macros can be ;; used without any knowledge about the form of the actual argument list of ;; the original function. ;; Similarly, `(ad-set-arg )' can be used to set the -;; value of the actual argument at to . For example, +;; value of the actual argument at to . For example, ;; ;; (ad-set-arg 5 "five") ;; ;; will have the effect that R=(3 4 "five" 6) once the original function is -;; called. `(ad-set-args )' can be used to set +;; called. `(ad-set-args )' can be used to set ;; the list of actual arguments starting at to . ;; For example, ;; @@ -427,7 +404,7 @@ ;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original ;; function is called. -;; All these access macros are text macros rather than real Lisp macros. When +;; All these access macros are text macros rather than real Lisp macros. When ;; the advised definition gets constructed they get replaced with actual access ;; forms depending on the argument list of the advised function, i.e., after ;; that argument access is in most cases as efficient as using the argument @@ -437,7 +414,7 @@ ;; ======================================================= ;; Some functions (such as `trace-function' defined in trace.el) need a ;; method of accessing the names and bindings of the arguments of an -;; arbitrary advised function. To do that within an advice one can use the +;; arbitrary advised function. To do that within an advice one can use the ;; special keyword `ad-arg-bindings' which is a text macro that will be ;; substituted with a form that will evaluate to a list of binding ;; specifications, one for every argument variable. These binding @@ -463,7 +440,7 @@ ;; ========================== ;; Because `defadvice' allows the specification of the argument list ;; of the advised function we need a mapping mechanism that maps this -;; argument list onto that of the original function. Hence SYM and +;; argument list onto that of the original function. Hence SYM and ;; NEWDEF have to be properly mapped onto the &rest variable when the ;; original definition is called. Advice automatically takes care of ;; that mapping, hence, the advice programmer can specify an argument @@ -474,11 +451,10 @@ ;; @@ Activation and deactivation: ;; =============================== ;; The definition of an advised function does not change until all its advice -;; gets actually activated. Activation can either happen with the `activate' +;; gets actually activated. Activation can either happen with the `activate' ;; flag specified in the `defadvice', with an explicit call or interactive -;; invocation of `ad-activate', or if forward advice is enabled (i.e., the -;; value of `ad-activate-on-definition' is t) at the time an already advised -;; function gets defined. +;; invocation of `ad-activate', or at the time an already advised function +;; gets defined. ;; When a function gets first activated its original definition gets saved, ;; all defined and enabled pieces of advice will get combined with the @@ -496,7 +472,7 @@ ;; the file that contained the `defadvice' with the `preactivate' flag. ;; `ad-deactivate' can be used to back-define an advised function to its -;; original definition. It can be called interactively or directly. Because +;; original definition. It can be called interactively or directly. Because ;; `ad-activate' caches the advised definition the function can be ;; reactivated via `ad-activate' with only minor overhead (it is checked ;; whether the current advice state is consistent with the cached @@ -504,12 +480,12 @@ ;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate ;; all currently advised function that have a piece of advice with a name that -;; contains a match for a regular expression. These functions can be used to +;; contains a match for a regular expression. These functions can be used to ;; de/activate sets of functions depending on certain advice naming ;; conventions. ;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to -;; de/activate all currently advised functions. These are useful to +;; de/activate all currently advised functions. These are useful to ;; (temporarily) return to an un/advised state. ;; @@@ Reasons for the separation of advice definition and activation: @@ -521,26 +497,26 @@ ;; The advantage of this is that various pieces of advice can be defined ;; before they get combined into an advised definition which avoids -;; unnecessary constructions of intermediate advised definitions. The more +;; unnecessary constructions of intermediate advised definitions. The more ;; important advantage is that it allows the implementation of forward advice. ;; Advice information for a certain function accumulates as the value of the -;; `advice-info' property of the function symbol. This accumulation is +;; `advice-info' property of the function symbol. This accumulation is ;; completely independent of the fact that that function might not yet be -;; defined. The special forms `defun' and `defmacro' have been advised to -;; check whether the function/macro they defined had advice information -;; associated with it. If so and forward advice is enabled, the original +;; defined. The macros `defun' and `defmacro' check whether the +;; function/macro they defined had advice information +;; associated with it. If so and forward advice is enabled, the original ;; definition will be saved, and then the advice will be activated. ;; @@ Enabling/disabling pieces or sets of advice: ;; =============================================== ;; A major motivation for the development of this advice package was to bring ;; a little bit more structure into the function overloading chaos in Emacs -;; Lisp. Many packages achieve some of their functionality by adding a little +;; Lisp. Many packages achieve some of their functionality by adding a little ;; bit (or a lot) to the standard functionality of some Emacs Lisp function. -;; ange-ftp is a very popular package that achieves its magic by overloading -;; most Emacs Lisp functions that deal with files. A popular function that's -;; overloaded by many packages is `expand-file-name'. The situation that one -;; function is multiply overloaded can arise easily. +;; ange-ftp is a very popular package that used to achieve its magic by +;; overloading most Emacs Lisp functions that deal with files. A popular +;; function that's overloaded by many packages is `expand-file-name'. +;; The situation that one function is multiply overloaded can arise easily. ;; Once in a while it would be desirable to be able to disable some/all ;; overloads of a particular package while keeping all the rest. Ideally - @@ -548,7 +524,7 @@ ;; I know I am dreaming right now... In that ideal case the enable/disable ;; mechanism of advice could be used to achieve just that. -;; Every piece of advice is associated with an enablement flag. When the +;; Every piece of advice is associated with an enablement flag. When the ;; advised definition of a particular function gets constructed (e.g., during ;; activation) only the currently enabled pieces of advice will be considered. ;; This mechanism allows one to have different "views" of an advised function @@ -556,17 +532,15 @@ ;; Another motivation for this mechanism is that it allows one to define a ;; piece of advice for some function yet keep it dormant until a certain -;; condition is met. Until then activation of the function will not make use -;; of that piece of advice. Once the condition is met the advice can be +;; condition is met. Until then activation of the function will not make use +;; of that piece of advice. Once the condition is met the advice can be ;; enabled and a reactivation of the function will add its functionality as -;; part of the new advised definition. For example, the advices of `defun' -;; etc. used by advice itself will stay disabled until `ad-start-advice' is -;; called and some variables have the proper values. Hence, if somebody +;; part of the new advised definition. Hence, if somebody ;; else advised these functions too and activates them the advices defined ;; by advice will get used only if they are intended to be used. ;; The main interface to this mechanism are the interactive functions -;; `ad-enable-advice' and `ad-disable-advice'. For example, the following +;; `ad-enable-advice' and `ad-disable-advice'. For example, the following ;; would disable a particular advice of the function `foo': ;; ;; (ad-disable-advice 'foo 'before 'my-advice) @@ -576,28 +550,28 @@ ;; ;; (ad-activate 'foo) ;; -;; or interactively. To disable whole sets of advices one can use a regular -;; expression mechanism. For example, let us assume that ange-ftp actually +;; or interactively. To disable whole sets of advices one can use a regular +;; expression mechanism. For example, let us assume that ange-ftp actually ;; used advice to overload all its functions, and that it used the ;; "ange-ftp-" prefix for all its advice names, then we could temporarily ;; disable all its advices with ;; -;; (ad-disable-regexp "^ange-ftp-") +;; (ad-disable-regexp "\\`ange-ftp-") ;; ;; and the following call would put that actually into effect: ;; -;; (ad-activate-regexp "^ange-ftp-") +;; (ad-activate-regexp "\\`ange-ftp-") ;; ;; A safer way would have been to use ;; -;; (ad-update-regexp "^ange-ftp-") +;; (ad-update-regexp "\\`ange-ftp-") ;; ;; instead which would have only reactivated currently actively advised -;; functions, but not functions that were currently inactive. All these +;; functions, but not functions that were currently inactive. All these ;; functions can also be called interactively. ;; A certain piece of advice is considered a match if its name contains a -;; match for the regular expression. To enable ange-ftp again we would use +;; match for the regular expression. To enable ange-ftp again we would use ;; `ad-enable-regexp' and then activate or update again. ;; @@ Forward advice, automatic advice activation: @@ -616,7 +590,7 @@ ;; of advice definition and activation that makes it possible to accumulate ;; advice information without having the original function already defined, ;; 2) special versions of the built-in functions `fset/defalias' which check -;; for advice information whenever they define a function. If advice +;; for advice information whenever they define a function. If advice ;; information was found then the advice will immediately get activated when ;; the function gets defined. @@ -625,16 +599,11 @@ ;; file, and the function has some advice-info stored with it then that ;; advice will get activated right away. -;; @@@ Enabling automatic advice activation: -;; ========================================= -;; Automatic advice activation is enabled by default. It can be disabled with -;; `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'. - ;; @@ Caching of advised definitions: ;; ================================== ;; After an advised definition got constructed it gets cached as part of the ;; advised function's advice-info so it can be reused, for example, after an -;; intermediate deactivation. Because the advice-info of a function might +;; intermediate deactivation. Because the advice-info of a function might ;; change between the time of caching and reuse a cached definition gets ;; a cache-id associated with it so it can be verified whether the cached ;; definition is still valid (the main application of this is preactivation @@ -642,19 +611,19 @@ ;; When an advised function gets activated and a verifiable cached definition ;; is available, then that definition will be used instead of creating a new -;; advised definition from scratch. If you want to make sure that a new +;; advised definition from scratch. If you want to make sure that a new ;; definition gets constructed then you should use `ad-clear-cache' before you ;; activate the advised function. ;; @@ Preactivation: ;; ================= -;; Constructing an advised definition is moderately expensive. In a situation +;; Constructing an advised definition is moderately expensive. In a situation ;; where one package defines a lot of advised functions it might be ;; prohibitively expensive to do all the advised definition construction at -;; runtime. Preactivation is a mechanism that allows compile-time construction +;; runtime. Preactivation is a mechanism that allows compile-time construction ;; of compiled advised definitions that can be activated cheaply during -;; runtime. Preactivation uses the caching mechanism to do that. Here's how it -;; works: +;; runtime. Preactivation uses the caching mechanism to do that. Here's how +;; it works: ;; When the byte-compiler compiles a `defadvice' that has the `preactivate' ;; flag specified, it uses the current original definition of the advised @@ -665,27 +634,27 @@ ;; byte-compiler. ;; When the file with the compiled, preactivating `defadvice' gets loaded the ;; precompiled advised definition will be cached on the advised function's -;; advice-info. When it gets activated (can be immediately on execution of the +;; advice-info. When it gets activated (can be immediately on execution of the ;; `defadvice' or any time later) the cache-id gets checked against the ;; current state of advice and if it is verified the precompiled definition -;; will be used directly (the verification is pretty cheap). If it couldn't get -;; verified a new advised definition for that function will be built from -;; scratch, hence, the efficiency added by the preactivation mechanism does -;; not at all impair the flexibility of the advice mechanism. +;; will be used directly (the verification is pretty cheap). If it couldn't +;; get verified a new advised definition for that function will be built from +;; scratch, hence, the efficiency added by the preactivation mechanism does not +;; at all impair the flexibility of the advice mechanism. ;; MORAL: In order get all the efficiency out of preactivation the advice ;; state of an advised function at the time the file with the ;; preactivating `defadvice' gets byte-compiled should be exactly ;; the same as it will be when the advice of that function gets -;; actually activated. If it is not there is a high chance that the +;; actually activated. If it is not there is a high chance that the ;; cache-id will not match and hence a new advised definition will ;; have to be constructed at runtime. -;; Preactivation and forward advice do not contradict each other. It is +;; Preactivation and forward advice do not contradict each other. It is ;; perfectly ok to load a file with a preactivating `defadvice' before the -;; original definition of the advised function is available. The constructed +;; original definition of the advised function is available. The constructed ;; advised definition will be used once the original function gets defined and -;; its advice gets activated. The only constraint is that at the time the +;; its advice gets activated. The only constraint is that at the time the ;; file with the preactivating `defadvice' got compiled the original function ;; definition was available. @@ -697,18 +666,18 @@ ;; - `byte-compile' is part of the `features' variable even though you ;; did not use the byte-compiler ;; Right now advice does not provide an elegant way to find out whether -;; and why a preactivation failed. What you can do is to trace the +;; and why a preactivation failed. What you can do is to trace the ;; function `ad-cache-id-verification-code' (with the function ;; `trace-function-background' defined in my trace.el package) before -;; any of your advised functions get activated. After they got +;; any of your advised functions get activated. After they got ;; activated check whether all calls to `ad-cache-id-verification-code' -;; returned `verified' as a result. Other values indicate why the +;; returned `verified' as a result. Other values indicate why the ;; verification failed which should give you enough information to ;; fix your preactivation/compile/load/activation sequence. ;; IMPORTANT: There is one case (that I am aware of) that can make ;; preactivation fail, i.e., a preconstructed advised definition that does -;; NOT match the current state of advice gets used nevertheless. That case +;; NOT match the current state of advice gets used nevertheless. That case ;; arises if one package defines a certain piece of advice which gets used ;; during preactivation, and another package incompatibly redefines that ;; very advice (i.e., same function/class/name), and it is the second advice @@ -720,30 +689,20 @@ ;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with ;; George Walker Bush), and why would you redefine your own advice anyway? ;; Advice is a mechanism to facilitate function redefinition, not advice -;; redefinition (wait until I write Meta-Advice :-). If you really have -;; to undo somebody else's advice try to write a "neutralizing" advice. +;; redefinition (wait until I write Meta-Advice :-). If you really have +;; to undo somebody else's advice, try to write a "neutralizing" advice. -;; @@ Advising macros and special forms and other dangerous things: -;; ================================================================ +;; @@ Advising macros and other dangerous things: +;; ============================================== ;; Look at the corresponding tutorial sections for more information on -;; these topics. Here it suffices to point out that the special treatment -;; of macros and special forms by the byte-compiler can lead to problems -;; when they get advised. Macros can create problems because they get -;; expanded at compile time, hence, they might not have all the necessary -;; runtime support and such advice cannot be de/activated or changed as -;; it is possible for functions. Special forms create problems because they -;; have to be advised "into" macros, i.e., an advised special form is a -;; implemented as a macro, hence, in most cases the byte-compiler will -;; not recognize it as a special form anymore which can lead to very strange -;; results. -;; -;; MORAL: - Only advise macros or special forms when you are absolutely sure -;; what you are doing. -;; - As a safety measure, always do `ad-deactivate-all' before you -;; byte-compile a file to make sure that even if some inconsiderate -;; person advised some special forms you'll get proper compilation -;; results. After compilation do `ad-activate-all' to get back to -;; the previous state. +;; these topics. Here it suffices to point out that the special treatment +;; of macros can lead to problems when they get advised. Macros can create +;; problems because they get expanded at compile or load time, hence, they +;; might not have all the necessary runtime support and such advice cannot be +;; de/activated or changed as it is possible for functions. +;; Special forms cannot be advised. +;; +;; MORAL: - Only advise macros when you are absolutely sure what you are doing. ;; @@ Adding a piece of advice with `ad-add-advice': ;; ================================================= @@ -754,10 +713,10 @@ ;; @@ Activation/deactivation advices, file load hooks: ;; ==================================================== ;; There are two special classes of advice called `activation' and -;; `deactivation'. The body forms of these advices are not included into the +;; `deactivation'. The body forms of these advices are not included into the ;; advised definition of a function, rather they are assembled into a hook ;; form which will be evaluated whenever the advice-info of the advised -;; function gets activated or deactivated. One application of this mechanism +;; function gets activated or deactivated. One application of this mechanism ;; is to define file load hooks for files that do not provide such hooks. ;; For example, suppose you want to print a message whenever `file-x' gets ;; loaded, and suppose the last function defined in `file-x' is @@ -769,7 +728,7 @@ ;; ;; This will constitute a forward advice for function `file-x-last-fn' which ;; will get activated when `file-x' is loaded (only if forward advice is -;; enabled of course). Because there are no "real" pieces of advice +;; enabled of course). Because there are no "real" pieces of advice ;; available for it, its definition will not be changed, but the activation ;; advice will be run during its activation which is equivalent to having a ;; file load hook for `file-x'. @@ -784,14 +743,14 @@ ;; enabled advices are considered during construction of an advised ;; definition. ;; - Activation: -;; Redefine an advised function with its advised definition. Constructs +;; Redefine an advised function with its advised definition. Constructs ;; an advised definition from scratch if no verifiable cached advised ;; definition is available and caches it. ;; - Deactivation: ;; Back-define an advised function to its original definition. ;; - Update: ;; Reactivate an advised function but only if its advice is currently -;; active. This can be used to bring all currently advised function up +;; active. This can be used to bring all currently advised function up ;; to date with the current state of advice without also activating ;; currently inactive functions. ;; - Caching: @@ -800,7 +759,7 @@ ;; - Preactivation: ;; Is the construction of an advised definition according to the current ;; state of advice during byte-compilation of a file with a preactivating -;; `defadvice'. That advised definition can then rather cheaply be used +;; `defadvice'. That advised definition can then rather cheaply be used ;; during activation without having to construct an advised definition ;; from scratch at runtime. @@ -860,12 +819,8 @@ ;; @ Foo games: An advice tutorial ;; =============================== -;; The following tutorial was created in Emacs 18.59. Left-justified +;; The following tutorial was created in Emacs 18.59. Left-justified ;; s-expressions are input forms followed by one or more result forms. -;; First we have to start the advice magic: -;; -;; (ad-start-advice) -;; nil ;; ;; We start by defining an innocent looking function `foo' that simply ;; adds 1 to its argument X: @@ -988,19 +943,6 @@ ;; (call-interactively 'foo) ;; 6 ;; -;; Let's have a look at what the definition of `foo' looks like now -;; (indentation added by hand for legibility): -;; -;; (symbol-function 'foo) -;; (lambda (x) -;; "$ad-doc: foo$" -;; (interactive (list 5)) -;; (let (ad-return-value) -;; (setq x (1- x)) -;; (setq x (1+ x)) -;; (setq ad-return-value (ad-Orig-foo x)) -;; ad-return-value)) -;; ;; @@ Around advices: ;; ================== ;; Now we'll try some `around' advices. An around advice is a wrapper around @@ -1038,20 +980,6 @@ ;; (foo 3) ;; 8 ;; -;; Again, let's see what the definition of `foo' looks like so far: -;; -;; (symbol-function 'foo) -;; (lambda (x) -;; "$ad-doc: foo$" -;; (interactive (list 5)) -;; (let (ad-return-value) -;; (setq x (1- x)) -;; (setq x (1+ x)) -;; (let ((x (* x 2))) -;; (let ((x (1+ x))) -;; (setq ad-return-value (ad-Orig-foo x)))) -;; ad-return-value)) -;; ;; @@ Controlling advice activation: ;; ================================= ;; In every `defadvice' so far we have used the flag `activate' to activate @@ -1071,9 +999,9 @@ ;; 8 ;; ;; Now we define another advice and activate which will also activate the -;; previous advice `fg-times-x'. Note the use of the special variable +;; previous advice `fg-times-x'. Note the use of the special variable ;; `ad-return-value' in the body of the advice which is set to the result of -;; the original function. If we change its value then the value returned by +;; the original function. If we change its value then the value returned by ;; the advised function will be changed accordingly: ;; ;; (defadvice foo (after fg-times-x-again act) @@ -1121,24 +1049,6 @@ ;; "Let's clean up now!" ;; error-in-foo ;; -;; Again, let's see what `foo' looks like: -;; -;; (symbol-function 'foo) -;; (lambda (x) -;; "$ad-doc: foo$" -;; (interactive (list 5)) -;; (let (ad-return-value) -;; (unwind-protect -;; (progn (setq x (1- x)) -;; (setq x (1+ x)) -;; (let ((x (* x 2))) -;; (let ((x (1+ x))) -;; (setq ad-return-value (ad-Orig-foo x)))) -;; (setq ad-return-value (* ad-return-value x)) -;; (setq ad-return-value (* ad-return-value x))) -;; (print "Let's clean up now!")) -;; ad-return-value)) -;; ;; @@ Compilation of advised definitions: ;; ====================================== ;; Finally, we can specify the `compile' keyword in a `defadvice' to say @@ -1150,13 +1060,10 @@ ;; (print "Let's clean up now!")) ;; foo ;; -;; Now `foo' is byte-compiled: +;; Now `foo's advice is byte-compiled: ;; -;; (symbol-function 'foo) -;; (lambda (x) -;; "$ad-doc: foo$" -;; (interactive (byte-code "....." [5] 1)) -;; (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6)) +;; (byte-code-function-p 'ad-Advice-foo) +;; t ;; ;; (foo 3) ;; "Let's clean up now!" @@ -1262,7 +1169,7 @@ ;; deactivate functions that have a piece of advice defined by a certain ;; package (we save the old definition to check out caching): ;; -;; (setq old-definition (symbol-function 'foo)) +;; (setq old-definition (symbol-function 'ad-Advice-foo)) ;; (lambda (x) ....) ;; ;; (ad-deactivate-regexp "^fg-") @@ -1274,7 +1181,7 @@ ;; (ad-activate-regexp "^fg-") ;; nil ;; -;; (eq old-definition (symbol-function 'foo)) +;; (eq old-definition (symbol-function 'ad-Advice-foo)) ;; t ;; ;; (foo 3) @@ -1283,14 +1190,6 @@ ;; ;; @@ Forward advice: ;; ================== -;; To enable automatic activation of forward advice we first have to set -;; `ad-activate-on-definition' to t and restart advice: -;; -;; (setq ad-activate-on-definition t) -;; t -;; -;; (ad-start-advice) -;; (ad-activate-defined-function) ;; ;; Let's define a piece of advice for an undefined function: ;; @@ -1303,9 +1202,7 @@ ;; (fboundp 'bar) ;; nil ;; -;; Now we define it and the forward advice will get activated (only because -;; `ad-activate-on-definition' was t when we started advice above with -;; `ad-start-advice'): +;; Now we define it and the forward advice will get activated: ;; ;; (defun bar (x) ;; "Subtract 1 from X." @@ -1357,7 +1254,7 @@ ;; (ad-activate 'fie) ;; fie ;; -;; (eq cached-definition (symbol-function 'fie)) +;; (eq cached-definition (symbol-function 'ad-Advice-fie)) ;; t ;; ;; (fie 2) @@ -1365,7 +1262,7 @@ ;; ;; If you put a preactivating `defadvice' into a Lisp file that gets byte- ;; compiled then the constructed advised definition will get compiled by -;; the byte-compiler. For that to occur in a v18 Emacs you had to put the +;; the byte-compiler. For that to occur in a v18 Emacs you had to put the ;; `defadvice' inside a `defun' because the v18 compiler did not compile ;; top-level forms other than `defun' or `defmacro', for example, ;; @@ -1407,18 +1304,16 @@ ;; constructed during preactivation was used, even though we did not specify ;; the `compile' flag: ;; -;; (symbol-function 'fum) -;; (lambda (x) -;; "$ad-doc: fum$" -;; (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4)) +;; (byte-code-function-p 'ad-Advice-fum) +;; t ;; ;; (fum 2) ;; 8 ;; ;; A preactivated definition will only be used if it matches the current -;; function definition and advice information. If it does not match it +;; function definition and advice information. If it does not match it ;; will simply be discarded and a new advised definition will be constructed -;; from scratch. For example, let's first remove all advice-info for `fum': +;; from scratch. For example, let's first remove all advice-info for `fum': ;; ;; (ad-unadvise 'fum) ;; (("fie") ("bar") ("foo") ...) @@ -1431,7 +1326,7 @@ ;; fum ;; ;; When we now try to use a preactivation it will not be used because the -;; current advice state is different from the one at preactivation time. This +;; current advice state is different from the one at preactivation time. This ;; is no tragedy, everything will work as expected just not as efficient, ;; because a new advised definition has to be constructed from scratch: ;; @@ -1440,7 +1335,7 @@ ;; ;; A new uncompiled advised definition got constructed: ;; -;; (ad-compiled-p (symbol-function 'fum)) +;; (byte-code-function-p 'ad-Advice-fum) ;; nil ;; ;; (fum 2) @@ -1448,7 +1343,7 @@ ;; ;; MORAL: To get all the efficiency out of preactivation the function ;; definition and advice state at preactivation time must be the same as the -;; state at activation time. Preactivation does work with forward advice, all +;; state at activation time. Preactivation does work with forward advice, all ;; that's necessary is that the definition of the forward advised function is ;; available when the `defadvice' with the preactivation gets compiled. ;; @@ -1702,15 +1597,9 @@ ;; @@ Compilation idiosyncrasies: ;; ============================== -;; `defadvice' expansion needs quite a few advice functions and variables, -;; hence, I need to preload the file before it can be compiled. To avoid -;; interference of bogus compiled files I always preload the source file: -(provide 'advice-preload) -;; During a normal load this is a noop: -(require 'advice-preload "advice.el") (require 'macroexp) ;; At run-time also, since ad-do-advised-functions returns code that uses it. -(require 'cl-lib) +(eval-when-compile (require 'cl-lib)) ;; @@ Variable definitions: ;; ======================== @@ -1789,7 +1678,7 @@ generates a copy of TREE." ;; (after adv1 adv2 ...) ;; (activation adv1 adv2 ...) ;; (deactivation adv1 adv2 ...) -;; (origname . ) +;; (advicefunname . ) ;; (cache . ( . ))) ;; List of currently advised though not necessarily activated functions @@ -1816,7 +1705,7 @@ generates a copy of TREE." On each iteration VAR will be bound to the name of an advised function \(a symbol)." (declare (indent 1)) - `(cl-dolist (,(car varform) ad-advised-functions) + `(dolist (,(car varform) ad-advised-functions) (setq ,(car varform) (intern (car ,(car varform)))) ,@body)) @@ -1882,18 +1771,17 @@ either t or nil, and DEFINITION should be a list of the form ;; ad-find-advice uses the alist structure directly -> ;; change if this data structure changes!! -(defmacro ad-advice-name (advice) - (list 'car advice)) -(defmacro ad-advice-protected (advice) - (list 'nth 1 advice)) -(defmacro ad-advice-enabled (advice) - (list 'nth 2 advice)) -(defmacro ad-advice-definition (advice) - (list 'nth 3 advice)) +(defsubst ad-advice-name (advice) (car advice)) +(defsubst ad-advice-protected (advice) (nth 1 advice)) +(defsubst ad-advice-enabled (advice) (nth 2 advice)) +(defsubst ad-advice-definition (advice) (nth 3 advice)) (defun ad-advice-set-enabled (advice flag) (rplaca (cdr (cdr advice)) flag)) +(defvar ad-advice-classes '(before around after activation deactivation) + "List of defined advice classes.") + (defun ad-class-p (thing) (memq thing ad-advice-classes)) (defun ad-name-p (thing) @@ -1906,9 +1794,6 @@ either t or nil, and DEFINITION should be a list of the form ;; @@ Advice access functions: ;; =========================== -;; List of defined advice classes: -(defvar ad-advice-classes '(before around after activation deactivation)) - (defun ad-has-enabled-advice (function class) "True if at least one of FUNCTION's advices in CLASS is enabled." (cl-dolist (advice (ad-get-advice-info-field function class)) @@ -1948,58 +1833,23 @@ Redefining advices affect the construction of an advised definition." ;; Whether advised definitions created by automatic activations will be ;; compiled depends on the value of `ad-default-compilation-action'. -;; Since calling `ad-activate-internal' in the built-in definition of `fset' can -;; create major disasters we have to be a bit careful. One precaution is -;; to provide a dummy definition for `ad-activate-internal' which can be used to -;; turn off automatic advice activation (e.g., when `ad-stop-advice' or -;; `ad-recover-normality' are called). Another is to avoid recursive calls -;; to `ad-activate' by using `ad-with-auto-activation-disabled' where -;; appropriate, especially in a safe version of `fset'. - -(defun ad--defalias-fset (fsetfun function definition) - (funcall (or fsetfun #'fset) function definition) - (ad-activate-internal function nil)) - -;; For now define `ad-activate-internal' to the dummy definition: -(defun ad-activate-internal (_function &optional _compile) - "Automatic advice activation is disabled. `ad-start-advice' enables it." - nil) - -;; This is just a copy of the above: -(defun ad-activate-internal-off (_function &optional _compile) - "Automatic advice activation is disabled. `ad-start-advice' enables it." - nil) - -;; This will be t for top-level calls to `ad-activate-internal-on': -(defvar ad-activate-on-top-level t) - -(defmacro ad-with-auto-activation-disabled (&rest body) - `(let ((ad-activate-on-top-level nil)) - ,@body)) - -;; @@ Access functions for original definitions: -;; ============================================ -;; The advice-info of an advised function contains its `origname' which is -;; a symbol that is fbound to the original definition available at the first -;; proper activation of the function after a valid re/definition. If the -;; original was defined via fcell indirection then `origname' will be defined -;; just so. Hence, to get hold of the actual original definition of a function -;; we need to use `ad-real-orig-definition'. - -(defun ad-make-origname (function) - "Make name to be used to call the original FUNCTION." - (intern (format "ad-Orig-%s" function))) +(defalias 'ad-activate-internal 'ad-activate) -(defmacro ad-get-orig-definition (function) - `(let ((origname (ad-get-advice-info-field ,function 'origname))) - (if (fboundp origname) - (symbol-function origname)))) +(defun ad-make-advicefunname (function) + "Make name to be used to call the assembled advice function." + (intern (format "ad-Advice-%s" function))) -(defmacro ad-set-orig-definition (function definition) - `(fset (ad-get-advice-info-field ,function 'origname) ,definition)) +(defun ad-get-orig-definition (function) ;FIXME: Rename to "-unadvised-". + (if (symbolp function) + (setq function (if (fboundp function) + (advice--strip-macro (symbol-function function))))) + (while (advice--p function) (setq function (advice--cdr function))) + function) -(defmacro ad-clear-orig-definition (function) - `(fmakunbound (ad-get-advice-info-field ,function 'origname))) +(defun ad-clear-advicefunname-definition (function) + (let ((advicefunname (ad-get-advice-info-field function 'advicefunname))) + (advice-remove function advicefunname) + (fmakunbound advicefunname))) ;; @@ Interactive input functions: @@ -2259,7 +2109,7 @@ See Info node `(elisp)Computed Advice' for detailed documentation." (cond ((not (ad-is-advised function)) (ad-initialize-advice-info function) (ad-set-advice-info-field - function 'origname (ad-make-origname function)))) + function 'advicefunname (ad-make-advicefunname function)))) (let* ((previous-position (ad-advice-position function class (ad-advice-name advice))) (advices (ad-get-advice-info-field function class)) @@ -2374,7 +2224,8 @@ the name of the advised function from the docstring. This is needed to generate a proper advised docstring even if we are just given a definition (see the code for `documentation')." (eval-when-compile - (propertize "Advice doc string" 'dynamic-docstring-function + (propertize "Advice function assembled by advice.el." + 'dynamic-docstring-function #'ad--make-advised-docstring))) (defun ad-advised-definition-p (definition) @@ -2417,9 +2268,9 @@ For that it has to be fbound with a non-autoload definition." definition)))) (defun ad-real-orig-definition (function) - "Find FUNCTION's real original definition starting from its `origname'." - (if (ad-is-advised function) - (ad-real-definition (ad-get-advice-info-field function 'origname)))) + (let* ((fun1 (ad-get-orig-definition function)) + (fun2 (indirect-function fun1))) + (unless (autoloadp fun2) fun2))) (defun ad-is-compilable (function) "True if FUNCTION has an interpreted definition that can be compiled." @@ -2430,24 +2281,15 @@ For that it has to be fbound with a non-autoload definition." (defvar warning-suppress-types) ;From warnings.el. (defun ad-compile-function (function) - "Byte-compiles FUNCTION (or macro) if it is not yet compiled." - (interactive "aByte-compile function: ") - (if (ad-is-compilable function) - ;; Need to turn off auto-activation - ;; because `byte-compile' uses `fset': - (ad-with-auto-activation-disabled - (require 'bytecomp) - (require 'warnings) ;To define warning-suppress-types - ;before we let-bind it. - (let ((symbol (make-symbol "advice-compilation")) - (byte-compile-warnings byte-compile-warnings) - ;; Don't pop up windows showing byte-compiler warnings. - (warning-suppress-types '((bytecomp)))) - (if (featurep 'cl) - (byte-compile-disable-warning 'cl-functions)) - (fset symbol (symbol-function function)) - (byte-compile symbol) - (fset function (symbol-function symbol)))))) + "Byte-compile the assembled advice function." + (require 'bytecomp) + (require 'warnings) ;To define warning-suppress-types before we let-bind it. + (let ((byte-compile-warnings byte-compile-warnings) + ;; Don't pop up windows showing byte-compiler warnings. + (warning-suppress-types '((bytecomp)))) + (if (featurep 'cl) + (byte-compile-disable-warning 'cl-functions)) + (byte-compile (ad-get-advice-info-field function 'advicefunname)))) ;; @@@ Accessing argument lists: ;; ============================= @@ -2634,7 +2476,7 @@ Excess source arguments will be neglected, missing source arguments will be supplied as nil. Returns a `funcall' or `apply' form with the second element being `function' which has to be replaced by an actual function argument. Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return - `(funcall function a (car args) (car (cdr args)) (nth 2 args))'." + `(funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))'." (let* ((parsed-source-arglist (ad-parse-arglist source-arglist)) (source-reqopt-args (append (nth 0 parsed-source-arglist) (nth 1 parsed-source-arglist))) @@ -2648,7 +2490,7 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return ;; This produces ``error-proof'' target function calls with the exception ;; of a case like (&rest a) mapped onto (x &rest y) where the actual args ;; supplied to A might not be enough to supply the required target arg X - (append (list (if need-apply 'apply 'funcall) 'function) + (append (list (if need-apply 'apply 'funcall) 'ad--addoit-function) (cond (need-apply ;; `apply' can take care of that directly: (append source-reqopt-args (list source-rest-arg))) @@ -2663,13 +2505,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return (nthcdr (length target-reqopt-args) source-reqopt-args))))))))) -(defun ad-make-mapped-call (source-arglist target-arglist target-function) - "Make form to call TARGET-FUNCTION with args from SOURCE-ARGLIST." - (let ((mapped-form (ad-map-arglists source-arglist target-arglist))) - (if (eq (car mapped-form) 'funcall) - (cons target-function (cdr (cdr mapped-form))) - (prog1 mapped-form - (setcar (cdr mapped-form) (list 'quote target-function)))))) ;; @@@ Making an advised documentation string: ;; =========================================== @@ -2697,13 +2532,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return (require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage. -(defun ad-make-advised-docstring (function &optional style) - (let* ((origdef (ad-real-orig-definition function)) - (origdoc - ;; Retrieve raw doc, key substitution will be taken care of later: - (documentation origdef t))) - (ad--make-advised-docstring origdoc function style))) - (defun ad--make-advised-docstring (origdoc function &optional style) "Construct a documentation string for the advised FUNCTION. It concatenates the original documentation with the documentation @@ -2712,14 +2540,14 @@ according to STYLE. STYLE can be `plain', everything else will be interpreted as `default'. The order of the advice documentation strings corresponds to before/around/after and the individual ordering in any of these classes." - (let* ((origdef (ad-real-orig-definition function)) - (origtype (symbol-name (ad-definition-type origdef))) - (usage (help-split-fundoc origdoc function)) + (if (and (symbolp function) + (string-match "\\`ad-+Advice-" (symbol-name function))) + (setq function + (intern (substring (symbol-name function) (match-end 0))))) + (let* ((usage (help-split-fundoc origdoc function)) paragraphs advice-docstring) (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage))) (if origdoc (setq paragraphs (list origdoc))) - (unless (eq style 'plain) - (push (concat "This " origtype " is advised.") paragraphs)) (dolist (class ad-advice-classes) (dolist (advice (ad-get-enabled-advices function class)) (setq advice-docstring @@ -2735,8 +2563,6 @@ in any of these classes." #'ad--make-advised-docstring))) (help-add-fundoc-usage origdoc usage))) -(defun ad-make-plain-docstring (function) - (ad-make-advised-docstring function 'plain)) ;; @@@ Accessing overriding arglists and interactive forms: ;; ======================================================== @@ -2770,64 +2596,16 @@ in any of these classes." (if (and (ad-is-advised function) (ad-has-redefining-advice function)) (let* ((origdef (ad-real-orig-definition function)) - (origname (ad-get-advice-info-field function 'origname)) - (orig-interactive-p (commandp origdef)) - (orig-subr-p (ad-subr-p origdef)) - (orig-special-form-p (special-form-p origdef)) - (orig-macro-p (ad-macro-p origdef)) ;; Construct the individual pieces that we need for assembly: (orig-arglist (ad-arglist origdef)) (advised-arglist (or (ad-advised-arglist function) orig-arglist)) - (advised-interactive-form (ad-advised-interactive-form function)) - (interactive-form - (cond (orig-macro-p nil) - (advised-interactive-form) - ((interactive-form origdef) - (interactive-form - (if (and (symbolp function) (get function 'elp-info)) - (aref (get function 'elp-info) 2) - origdef))))) + (interactive-form (ad-advised-interactive-form function)) (orig-form - (cond ((or orig-special-form-p orig-macro-p) - ;; Special forms and macros will be advised into macros. - ;; The trick is to construct an expansion for the advised - ;; macro that does the correct thing when it gets eval'ed. - ;; For macros we'll just use the expansion of the original - ;; macro and return that. This way compiled advised macros - ;; will be expanded into something useful. Note that after - ;; advices have full control over whether they want to - ;; evaluate the expansion (the value of `ad-return-value') - ;; at macro expansion time or not. For special forms there - ;; is no solution that interacts reasonably with the - ;; compiler, hence we just evaluate the original at macro - ;; expansion time and return the result. The moral of that - ;; is that one should always deactivate advised special - ;; forms before one byte-compiles a file. - `(,(if orig-macro-p 'macroexpand 'eval) - (cons ',origname - ,(ad-get-arguments advised-arglist 0)))) - ((and orig-subr-p - orig-interactive-p - (not interactive-form) - (not advised-interactive-form)) - ;; Check whether we were called interactively - ;; in order to do proper prompting: - `(if (called-interactively-p 'any) - (call-interactively ',origname) - ,(ad-make-mapped-call advised-arglist - orig-arglist - origname))) - ;; And now for normal functions and non-interactive subrs - ;; (or subrs whose interactive behavior was advised): - (t (ad-make-mapped-call - advised-arglist orig-arglist origname))))) + (ad-map-arglists advised-arglist orig-arglist))) ;; Finally, build the sucker: (ad-assemble-advised-definition - (cond (orig-macro-p 'macro) - (orig-special-form-p 'special-form) - (t 'function)) advised-arglist (ad-make-advised-definition-docstring function) interactive-form @@ -2837,13 +2615,11 @@ in any of these classes." (ad-get-enabled-advices function 'after))))) (defun ad-assemble-advised-definition - (type args docstring interactive orig &optional befores arounds afters) - - "Assembles an original and its advices into an advised function. -It constructs a function or macro definition according to TYPE which has to -be either `macro', `function' or `special-form'. ARGS is the argument list -that has to be used, DOCSTRING if non-nil defines the documentation of the -definition, INTERACTIVE if non-nil is the interactive form to be used, + (args docstring interactive orig &optional befores arounds afters) + "Assemble the advices into an overall advice function. +ARGS is the argument list that has to be used, +DOCSTRING if non-nil defines the documentation of the definition, +INTERACTIVE if non-nil is the interactive form to be used, ORIG is a form that calls the body of the original unadvised function, and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG should be modified. The assembled function will be returned." @@ -2894,16 +2670,12 @@ should be modified. The assembled function will be returned." (ad-body-forms (ad-advice-definition advice))))))) (setq definition - `(,@(if (memq type '(macro special-form)) '(macro)) - lambda - ,args + `(lambda (ad--addoit-function ,@args) ,@(if docstring (list docstring)) ,@(if interactive (list interactive)) (let (ad-return-value) ,@after-forms - ,(if (eq type 'special-form) - '(list 'quote ad-return-value) - 'ad-return-value)))) + ad-return-value))) (ad-insert-argument-access-forms definition args))) @@ -3000,11 +2772,11 @@ advised definition from scratch." "Generate an identifying image of the current advices of FUNCTION." (let ((original-definition (ad-real-orig-definition function)) (cached-definition (ad-get-cache-definition function))) - (list (mapcar (function (lambda (advice) (ad-advice-name advice))) + (list (mapcar #'ad-advice-name (ad-get-enabled-advices function 'before)) - (mapcar (function (lambda (advice) (ad-advice-name advice))) + (mapcar #'ad-advice-name (ad-get-enabled-advices function 'around)) - (mapcar (function (lambda (advice) (ad-advice-name advice))) + (mapcar #'ad-advice-name (ad-get-enabled-advices function 'after)) (ad-definition-type original-definition) (if (equal (ad-arglist original-definition) @@ -3147,25 +2919,32 @@ The resulting FUNCTION will be compiled if `ad-should-compile' returns t. The current definition and its cache-id will be put into the cache." (let ((verified-cached-definition (if (ad-verify-cache-id function) - (ad-get-cache-definition function)))) - (fset function - (or verified-cached-definition - (ad-make-advised-definition function))) + (ad-get-cache-definition function))) + (advicefunname (ad-get-advice-info-field function 'advicefunname))) + (fset advicefunname + (or verified-cached-definition + (ad-make-advised-definition function))) + (advice-add function :around advicefunname) (if (ad-should-compile function compile) - (ad-compile-function function)) + (byte-compile advicefunname)) (if verified-cached-definition - (if (not (eq verified-cached-definition (symbol-function function))) + (if (not (eq verified-cached-definition + (symbol-function advicefunname))) ;; we must have compiled, cache the compiled definition: - (ad-set-cache - function (symbol-function function) (ad-get-cache-id function))) + (ad-set-cache function (symbol-function advicefunname) + (ad-get-cache-id function))) ;; We created a new advised definition, cache it with a proper id: (ad-clear-cache function) ;; ad-make-cache-id needs the new cached definition: - (ad-set-cache function (symbol-function function) nil) + (ad-set-cache function (symbol-function advicefunname) nil) (ad-set-cache - function (symbol-function function) (ad-make-cache-id function))))) + function (symbol-function advicefunname) (ad-make-cache-id function))))) -(defun ad-handle-definition (function) +(defun ad--defalias-fset (fsetfun function newdef) + ;; Besides ad-redefinition-action we use this defalias-fset-function hook + ;; for two other reasons: + ;; - for `activation/deactivation' advices. + ;; - to rebuild the ad-Advice-* function with the right argument names. "Handle re/definition of an advised FUNCTION during de/activation. If FUNCTION does not have an original definition associated with it and the current definition is usable, then it will be stored as FUNCTION's @@ -3177,33 +2956,27 @@ associated with it but got redefined with a new definition and then de/activated. If you do not like the current redefinition action change the value of `ad-redefinition-action' and de/activate again." (let ((original-definition (ad-get-orig-definition function)) - (current-definition (if (ad-real-definition function) - (symbol-function function)))) + (current-definition (ad-get-orig-definition newdef))) (if original-definition (if current-definition - (if (and (not (eq current-definition original-definition)) - ;; Redefinition with an advised definition from a - ;; different function won't count as such: - (not (ad-advised-definition-p current-definition))) - ;; we have a redefinition: + (if (not (eq current-definition original-definition)) + ;; We have a redefinition: (if (not (memq ad-redefinition-action '(accept discard warn))) - (error "ad-handle-definition (see its doc): `%s' %s" + (error "ad-redefinition-action: `%s' %s" function "invalidly redefined") (if (eq ad-redefinition-action 'discard) - (fset function original-definition) - (ad-set-orig-definition function current-definition) + nil ;; Just drop it! + (funcall (or fsetfun #'fset) function newdef) + (ad-activate-internal function) (if (eq ad-redefinition-action 'warn) (message "ad-handle-definition: `%s' got redefined" function)))) ;; either advised def or correct original is in place: nil) - ;; we have an undefinition, ignore it: - nil) - (if current-definition - ;; we have a first definition, save it as original: - (ad-set-orig-definition function current-definition) - ;; we don't have anything noteworthy: - nil)))) + ;; We have an undefinition, ignore it: + (funcall (or fsetfun #'fset) function newdef)) + (funcall (or fsetfun #'fset) function newdef) + (when current-definition (ad-activate-internal function))))) ;; @@ The top-level advice interface: @@ -3229,24 +3002,20 @@ definition will always be cached for later usage." (interactive (list (ad-read-advised-function "Activate advice of") current-prefix-arg)) - (if ad-activate-on-top-level - ;; avoid recursive calls to `ad-activate': - (ad-with-auto-activation-disabled - (if (not (ad-is-advised function)) - (error "ad-activate: `%s' is not advised" function) - (ad-handle-definition function) - ;; Just return for forward advised and not yet defined functions: - (if (ad-get-orig-definition function) - (if (not (ad-has-any-advice function)) - (ad-unadvise function) - ;; Otherwise activate the advice: - (cond ((ad-has-redefining-advice function) - (ad-activate-advised-definition function compile) - (ad-set-advice-info-field function 'active t) - (eval (ad-make-hook-form function 'activation)) - function) - ;; Here we are if we have all disabled advices: - (t (ad-deactivate function))))))))) + (if (not (ad-is-advised function)) + (error "ad-activate: `%s' is not advised" function) + ;; Just return for forward advised and not yet defined functions: + (if (ad-get-orig-definition function) + (if (not (ad-has-any-advice function)) + (ad-unadvise function) + ;; Otherwise activate the advice: + (cond ((ad-has-redefining-advice function) + (ad-activate-advised-definition function compile) + (ad-set-advice-info-field function 'active t) + (eval (ad-make-hook-form function 'activation)) + function) + ;; Here we are if we have all disabled advices: + (t (ad-deactivate function))))))) (defalias 'ad-activate-on 'ad-activate) @@ -3261,11 +3030,10 @@ a call to `ad-activate'." (if (not (ad-is-advised function)) (error "ad-deactivate: `%s' is not advised" function) (cond ((ad-is-active function) - (ad-handle-definition function) (if (not (ad-get-orig-definition function)) (error "ad-deactivate: `%s' has no original definition" function) - (fset function (ad-get-orig-definition function)) + (ad-clear-advicefunname-definition function) (ad-set-advice-info-field function 'active nil) (eval (ad-make-hook-form function 'deactivation)) function))))) @@ -3287,7 +3055,7 @@ If FUNCTION was not advised this will be a noop." (cond ((ad-is-advised function) (if (ad-is-active function) (ad-deactivate function)) - (ad-clear-orig-definition function) + (ad-clear-advicefunname-definition function) (ad-set-advice-info function nil) (ad-pop-advised-function function)))) @@ -3302,9 +3070,7 @@ Use in emergencies." (list (intern (completing-read "Recover advised function: " obarray nil t)))) (cond ((ad-is-advised function) - (cond ((ad-get-orig-definition function) - (fset function (ad-get-orig-definition function)) - (ad-clear-orig-definition function))) + (ad-clear-advicefunname-definition function) (ad-set-advice-info function nil) (ad-pop-advised-function function)))) @@ -3544,35 +3310,15 @@ undone on exit of this macro." ;; @@ Starting, stopping and recovering from the advice package magic: ;; =================================================================== -(defun ad-start-advice () - "Start the automatic advice handling magic." - (interactive) - ;; Advising `ad-activate-internal' means death!! - (ad-set-advice-info 'ad-activate-internal nil) - (fset 'ad-activate-internal 'ad-activate)) - -(defun ad-stop-advice () - "Stop the automatic advice handling magic. -You should only need this in case of Advice-related emergencies." - (interactive) - ;; Advising `ad-activate-internal' means death!! - (ad-set-advice-info 'ad-activate-internal nil) - (fset 'ad-activate-internal 'ad-activate-internal-off)) - (defun ad-recover-normality () "Undo all advice related redefinitions and unadvises everything. Use only in REAL emergencies." (interactive) - ;; Advising `ad-activate-internal' means death!! - (ad-set-advice-info 'ad-activate-internal nil) - (fset 'ad-activate-internal 'ad-activate-internal-off) (ad-recover-all) (ad-do-advised-functions (function) (message "Oops! Left over advised function %S" function) (ad-pop-advised-function function))) -(ad-start-advice) - (provide 'advice) ;;; advice.el ends here diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el index 9f9719fdcfc..8f9bf54114c 100644 --- a/test/automated/advice-tests.el +++ b/test/automated/advice-tests.el @@ -57,6 +57,29 @@ (defmacro sm-test3 (x) `(call-test3 ,x)) (macroexpand '(sm-test3 56)) (toto (call-test3 56))) + ((defadvice sm-test4 (around wrap-with-toto activate) + ad-do-it (setq ad-return-value `(toto ,ad-return-value))) + (defmacro sm-test4 (x) `(call-test4 ,x)) + (macroexpand '(sm-test4 56)) (toto (call-test4 56))) + ((defmacro sm-test4 (x) `(call-testq ,x)) + (macroexpand '(sm-test4 56)) (toto (call-testq 56))) + + ;; Combining old style and new style advices. + ((defun sm-test5 (x) (+ x 4)) + (sm-test5 6) 10) + ((advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) + (sm-test5 6) 50) + ((defadvice sm-test5 (around test activate) + ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) + (sm-test5 5) 45.1) + ((ad-deactivate 'sm-test5) + (sm-test5 6) 50) + ((ad-activate 'sm-test5) + (sm-test5 6) 50.1) + ((defun sm-test5 (x) (+ x 14)) + (sm-test5 6) 100.1) + ((advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) + (sm-test5 6) 20.1) )) (ert-deftest advice-tests () -- cgit v1.2.1 From fa470af020b518efb92a7213ac805a9d5d0b6061 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Nov 2012 11:59:34 -0500 Subject: * lisp/woman.el (woman-file-name): Don't mess with unread-command-events. Fixes: debbugs:12861 --- lisp/ChangeLog | 9 ++++++--- lisp/woman.el | 12 ++++++------ 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 72754190cf3..7ebd3632dda 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2012-11-13 Stefan Monnier + * woman.el (woman-file-name): Don't mess with unread-command-events + (bug#12861). + * emacs-lisp/advice.el: Layer on top of nadvice.el. Remove out of date self-require hack. (ad-do-advised-functions): Use simple `dolist'. @@ -7,9 +10,9 @@ (ad-advice-definition): Redefine as functions. (ad-advice-classes): Move before first use. (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition) - (ad-make-mapped-call, ad-make-advised-docstring, ad-make-plain-docstring) + (ad-make-mapped-call, ad-make-advised-docstring,ad-make-plain-docstring) (ad--defalias-fset): Remove functions. - (ad-make-advicefunname, ad-clear-advicefunname-definition): New functions. + (ad-make-advicefunname, ad-clear-advicefunname-definition): New funs. (ad-get-orig-definition): Rewrite. (ad-make-advised-definition-docstring): Change base docstring. (ad-real-orig-definition): Rewrite. @@ -17,7 +20,7 @@ (ad--make-advised-docstring): Redirect `function' from ad-Advice-... (ad-make-advised-definition): Simplify. (ad-assemble-advised-definition): Tweak for new calling context. - (ad-activate-advised-definition): Setup ad-Advice-* instead of ad-Orig-*. + (ad-activate-advised-definition): Setup ad-Advice-* i.s.o ad-Orig-*. (ad--defalias-fset): Rename from ad-handle-definition. Make it set the function and call ad-activate if needed. (ad-activate, ad-deactivate): Don't call ad-handle-definition any more. diff --git a/lisp/woman.el b/lisp/woman.el index 974a7d72465..46b6b680440 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1303,12 +1303,12 @@ cache to be re-read." ((null (cdr files)) (car (car files))) ; only 1 file for topic. (t ;; Multiple files for topic, so must select 1. - ;; Unread the command event (TAB = ?\t = 9) that runs the command - ;; `minibuffer-complete' in order to automatically complete the - ;; minibuffer contents as far as possible. - (setq unread-command-events '(9)) ; and delete any type-ahead! - (completing-read "Manual file: " files nil 1 - (try-completion "" files) 'woman-file-history)))))) + ;; Run the command `minibuffer-complete' in order to automatically + ;; complete the minibuffer contents as far as possible. + (minibuffer-with-setup-hook + (lambda () (let ((this-command this-command)) (minibuffer-complete))) + (completing-read "Manual file: " files nil 1 + (try-completion "" files) 'woman-file-history))))))) (defun woman-select (predicate list) "Select unique elements for which PREDICATE is true in LIST. -- cgit v1.2.1 From a77b8d5eb0ac3ea68f8a6e647677b1286ab47d30 Mon Sep 17 00:00:00 2001 From: Tsuyoshi Kitamoto Date: Tue, 13 Nov 2012 13:09:20 -0500 Subject: * emacs-lisp/advice.el: Fix typos in comment. --- lisp/emacs-lisp/nadvice.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index ca1ebf3cad2..ff30d9e7fa4 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -30,7 +30,7 @@ ;; holds a function. ;; This part provides mainly 2 macros: `add-function' and `remove-function'. ;; -;; - The second part provides `add-advice' and `remove-advice' which are +;; - The second part provides `advice-add' and `advice-remove' which are ;; refined version of the previous macros specially tailored for the case ;; where the place that we want to modify is a `symbol-function'. @@ -234,7 +234,7 @@ of the piece of advice." (cond ((special-form-p def) ;; Not worth the trouble trying to handle this, I think. - (error "add-advice failure: %S is a special form" symbol)) + (error "advice-add failure: %S is a special form" symbol)) ((and (symbolp def) (eq 'macro (car-safe (ignore-errors (indirect-function def))))) (let ((newval (cons 'macro (cdr (indirect-function def))))) -- cgit v1.2.1 From 5e9419e849410373473691611778572622ea490a Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Tue, 13 Nov 2012 22:57:26 +0400 Subject: * lisp/progmodes/ruby-mode.el (ruby-move-to-block): Looks for a block start/end keyword a bit harder. Works with different values of N. Add more comments. (ruby-end-of-block): Update accordingly. * test/automated/ruby-mode-tests.el (ruby-heredoc-font-lock) (ruby-singleton-class-no-heredoc-font-lock) (ruby-add-log-current-method-examples): New tests. (ruby-test-string): Extract from ruby-should-indent-buffer. (ruby-deftest-move-to-block): New macro. Add several move-to-block tests. --- lisp/ChangeLog | 7 ++++ lisp/progmodes/ruby-mode.el | 78 +++++++++++++++++++++++---------------- test/ChangeLog | 2 + test/automated/ruby-mode-tests.el | 48 ++++++++++++++++++++++++ 4 files changed, 103 insertions(+), 32 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7ebd3632dda..898722232f1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2012-11-13 Dmitry Gutov + + * progmodes/ruby-mode.el (ruby-move-to-block): Looks for a block + start/end keyword a bit harder. Works with different values of N. + Add more comments. + (ruby-end-of-block): Update accordingly. + 2012-11-13 Stefan Monnier * woman.el (woman-file-name): Don't mess with unread-command-events diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 7c72b73a879..c662ccbea95 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -865,39 +865,54 @@ calculating indentation on the lines after it." (beginning-of-line))))) (defun ruby-move-to-block (n) - "Move to the beginning (N < 0) or the end (N > 0) of the current block -or blocks containing the current block." - ;; TODO: Make this work for n > 1, - ;; make it not loop for n = 0, - ;; document body + "Move to the beginning (N < 0) or the end (N > 0) of the +current block, a sibling block, or an outer block. Do that (abs N) times." (let ((orig (point)) (start (ruby-calculate-indent)) - (down (looking-at (if (< n 0) ruby-block-end-re - (concat "\\<\\(" ruby-block-beg-re "\\)\\>")))) - pos done) - (while (and (not done) (not (if (< n 0) (bobp) (eobp)))) - (forward-line n) - (cond - ((looking-at "^\\s *$")) - ((looking-at "^\\s *#")) - ((and (> n 0) (looking-at "^=begin\\>")) - (re-search-forward "^=end\\>")) - ((and (< n 0) (looking-at "^=end\\>")) - (re-search-backward "^=begin\\>")) - (t - (setq pos (current-indentation)) + (signum (if (> n 0) 1 -1)) + (backward (< n 0)) + down pos done) + (dotimes (_ (abs n)) + (setq done nil) + (setq down (save-excursion + (back-to-indentation) + ;; There is a block start or block end keyword on this + ;; line, don't need to look for another block. + (and (re-search-forward + (if backward ruby-block-end-re + (concat "\\_<\\(" ruby-block-beg-re "\\)\\_>")) + (line-end-position) t) + (not (nth 8 (syntax-ppss)))))) + (while (and (not done) (not (if backward (bobp) (eobp)))) + (forward-line signum) (cond - ((< start pos) - (setq down t)) - ((and down (= pos start)) - (setq done t)) - ((> start pos) - (setq done t))))) - (if done - (save-excursion - (back-to-indentation) - (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>")) - (setq done nil))))) + ;; Skip empty and commented out lines. + ((looking-at "^\\s *$")) + ((looking-at "^\\s *#")) + ;; Skip block comments; + ((and (not backward) (looking-at "^=begin\\>")) + (re-search-forward "^=end\\>")) + ((and backward (looking-at "^=end\\>")) + (re-search-backward "^=begin\\>")) + (t + (setq pos (current-indentation)) + (cond + ;; Deeper intendation, we found a block. + ;; FIXME: We can't recognize empty blocks this way. + ((< start pos) + (setq down t)) + ;; Block found, and same indentation as when started, stop. + ((and down (= pos start)) + (setq done t)) + ;; Shallower indentation, means outer block, can stop now. + ((> start pos) + (setq done t))))) + (if done + (save-excursion + (back-to-indentation) + ;; Not really at the first or last line of the block, move on. + (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>")) + (setq done nil)))))) (back-to-indentation))) (defun ruby-beginning-of-block (&optional arg) @@ -909,8 +924,7 @@ With ARG, move up multiple blocks." (defun ruby-end-of-block (&optional arg) "Move forward to the end of the current block. With ARG, move out of multiple blocks." - ;; Passing a value > 1 to ruby-move-to-block currently doesn't work. - (interactive) + (interactive "p") (ruby-move-to-block (or arg 1))) (defun ruby-forward-sexp (&optional arg) diff --git a/test/ChangeLog b/test/ChangeLog index 44c013e9887..8973a0f1d4f 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -4,6 +4,8 @@ (ruby-singleton-class-no-heredoc-font-lock) (ruby-add-log-current-method-examples): New tests. (ruby-test-string): Extract from ruby-should-indent-buffer. + (ruby-deftest-move-to-block): New macro. + Add several move-to-block tests. 2012-11-12 Stefan Monnier diff --git a/test/automated/ruby-mode-tests.el b/test/automated/ruby-mode-tests.el index 0e41b2ba1e2..a8cdd2f3f28 100644 --- a/test/automated/ruby-mode-tests.el +++ b/test/automated/ruby-mode-tests.el @@ -283,6 +283,54 @@ VALUES-PLIST is a list with alternating index and value elements." (should (string= (ruby-add-log-current-method) (format "M::C%s" value))))))) +(defvar ruby-block-test-example + (ruby-test-string + "class C + | def foo + | 1 + | end + | + | def bar + | 2 + | end + | + | def baz + | some do + | end + | end + |end")) + +(defmacro ruby-deftest-move-to-block (name &rest body) + `(ert-deftest ,(intern (format "ruby-move-to-block-%s" name)) () + (with-temp-buffer + (insert ruby-block-test-example) + (ruby-mode) + ,@body))) + +(put 'ruby-deftest-move-to-block 'lisp-indent-function 'defun) + +(ruby-deftest-move-to-block works-on-do + (goto-line 11) + (ruby-end-of-block) + (should (= 12 (line-number-at-pos))) + (ruby-beginning-of-block) + (should (= 11 (line-number-at-pos)))) + +(ruby-deftest-move-to-block zero-is-noop + (goto-line 5) + (ruby-move-to-block 0) + (should (= 5 (line-number-at-pos)))) + +(ruby-deftest-move-to-block ok-with-three + (goto-line 2) + (ruby-move-to-block 3) + (should (= 13 (line-number-at-pos)))) + +(ruby-deftest-move-to-block ok-with-minus-two + (goto-line 10) + (ruby-move-to-block -2) + (should (= 2 (line-number-at-pos)))) + (provide 'ruby-mode-tests) ;;; ruby-mode-tests.el ends here -- cgit v1.2.1 From 9c3912d3d9aaa1e20e3f7168f5764695ad5e43fd Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Nov 2012 20:12:52 -0500 Subject: * lisp/emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments. Fixes: debbugs:12879 --- lisp/ChangeLog | 5 +++++ lisp/emacs-lisp/gv.el | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 898722232f1..48eced16fe1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-14 Stefan Monnier + + * emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments + (bug#12879). + 2012-11-13 Dmitry Gutov * progmodes/ruby-mode.el (ruby-move-to-block): Looks for a block diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 02eec08f96b..5488330a1a4 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -236,7 +236,7 @@ For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y). The return value is the last VAL in the list. \(fn PLACE VAL PLACE VAL ...)" - (declare (debug (gv-place form))) + (declare (debug (&rest [gv-place form]))) (if (and args (null (cddr args))) (let ((place (pop args)) (val (car args))) -- cgit v1.2.1 From 73dcdb9f30cb94a3183db54d9b463370c3978d4d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Nov 2012 20:55:41 -0800 Subject: Use faccessat, not access, when checking file permissions. This fixes a bug that has been present in Emacs since its creation. It was reported by Chris Torek in 1983 even before GNU Emacs existed, which must set some sort of record. (Torek's bug report was against a predecessor of GNU Emacs, but GNU Emacs happened to have the same common flaw.) See Torek's Usenet posting "setuid/setgid programs & Emacs" Article-I.D.: sri-arpa.858 Posted: Fri Apr 8 14:18:56 1983. * .bzrignore: Add lib/fcntl.h. * configure.ac (euidaccess): Remove check; gnulib does this for us now. (gl_FCNTL_O_FLAGS): Define a dummy version. * lib/at-func.c, lib/euidaccess.c, lib/faccessat.c, lib/fcntl.in.h: * lib/getgroups.c, lib/group-member.c, lib/root-uid.h: * lib/xalloc-oversized.h, m4/euidaccess.m4, m4/faccessat.m4: * m4/fcntl_h.m4, m4/getgroups.m4, m4/group-member.m4: New files, from gnulib. * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. * admin/merge-gnulib (GNULIB_MODULES): Add faccessat. (GNULIB_TOOL_FLAGS): Avoid at-internal, fchdir, malloc-posix, openat-die, openat-h, save-cwd. Do not avoid fcntl-h. Omit gnulib's m4/fcntl-o.m4. * nt/inc/ms-w32.h (AT_FDCWD, AT_EACCESS): New symbols. (access): Remove. (faccessat): New macro. * src/Makefile.in (LIB_EACCESS): New macro. (LIBES): Use it. * src/callproc.c (init_callproc): * src/charset.c (init_charset): * src/fileio.c (check_existing, check_executable, check_writable) (Ffile_readable_p): * src/lread.c (openp, load_path_check): * src/process.c (allocate_pty): * src/xrdb.c (file_p): Use effective UID when checking permissions, not real UID. * src/callproc.c (init_callproc): * src/charset.c (init_charset): * src/lread.c (load_path_check, init_lread): Test whether directories are accessible, not merely whether they exist. * src/conf_post.h (GNULIB_SUPPORT_ONLY_AT_FDCWD): New macro. * src/fileio.c (check_existing, check_executable, check_writable) (Ffile_readable_p): Use symbolic names instead of integers for the flags, as they're portable now. (check_writable): New arg AMODE. All uses changed. Set errno on failure. (Ffile_readable_p): Use faccessat, not stat + open + close. (Ffile_writable_p): No need to call check_existing + check_writable. Just call check_writable and then look at errno. This saves a syscall. dir should never be nil; replace an unnecessary runtime check with an eassert. When checking the parent directory of a nonexistent file, check that the directory is searchable as well as writable, as we can't create files in unsearchable directories. (file_directory_p): New function, which uses 'stat' on most platforms but faccessat with D_OK (for efficiency) if WINDOWSNT. (Ffile_directory_p, Fset_file_times): Use it. (file_accessible_directory_p): New function, which uses a single syscall for efficiency. (Ffile_accessible_directory_p): Use it. * src/xrdb.c (file_p): Use file_directory_p. * src/lisp.h (file_directory_p, file_accessible_directory_p): New decls. * src/lread.c (openp): When opening a file, use fstat rather than stat, as that avoids a permissions race. When not opening a file, use file_directory_p rather than stat. (dir_warning): First arg is now a usage string, not a format. Use errno. All uses changed. * src/nsterm.m (ns_term_init): Remove unnecessary call to file-readable that merely introduced a race. * src/process.c, src/sysdep.c, src/term.c: All uses of '#ifdef O_NONBLOCK' changed to '#if O_NONBLOCK', to accommodate gnulib O_* style, and similarly for the other O_* flags. * src/w32.c (sys_faccessat): Rename from sys_access and switch to faccessat's API. All uses changed. * src/xrdb.c: Do not include ; no longer needed. (magic_db): Rename from magic_file_p. (magic_db, search_magic_path): Return an XrmDatabase rather than a char *, so that we don't have to test for file existence separately from opening the file for reading. This removes a race fixes a permission-checking problem, and simplifies the code. All uses changed. (file_p): Remove; no longer needed. Fixes: debbugs:12632 --- ChangeLog | 13 ++ admin/ChangeLog | 8 ++ admin/merge-gnulib | 13 +- configure.ac | 4 +- lib/at-func.c | 146 ++++++++++++++++++++ lib/euidaccess.c | 221 ++++++++++++++++++++++++++++++ lib/faccessat.c | 45 +++++++ lib/fcntl.in.h | 355 +++++++++++++++++++++++++++++++++++++++++++++++++ lib/getgroups.c | 116 ++++++++++++++++ lib/gnulib.mk | 97 +++++++++++++- lib/group-member.c | 119 +++++++++++++++++ lib/root-uid.h | 30 +++++ lib/xalloc-oversized.h | 38 ++++++ m4/euidaccess.m4 | 52 ++++++++ m4/faccessat.m4 | 28 ++++ m4/fcntl_h.m4 | 50 +++++++ m4/getgroups.m4 | 107 +++++++++++++++ m4/gnulib-comp.m4 | 105 +++++++++++++++ m4/group-member.m4 | 29 ++++ nt/ChangeLog | 7 + nt/inc/ms-w32.h | 7 +- src/ChangeLog | 67 ++++++++++ src/Makefile.in | 3 +- src/callproc.c | 12 +- src/charset.c | 2 +- src/conf_post.h | 4 + src/fileio.c | 184 ++++++++++++------------- src/lisp.h | 2 + src/lread.c | 92 +++++++------ src/nsterm.m | 2 - src/process.c | 36 ++--- src/sysdep.c | 6 +- src/term.c | 4 +- src/w32.c | 18 ++- src/xrdb.c | 101 ++++++-------- 35 files changed, 1878 insertions(+), 245 deletions(-) create mode 100644 lib/at-func.c create mode 100644 lib/euidaccess.c create mode 100644 lib/faccessat.c create mode 100644 lib/fcntl.in.h create mode 100644 lib/getgroups.c create mode 100644 lib/group-member.c create mode 100644 lib/root-uid.h create mode 100644 lib/xalloc-oversized.h create mode 100644 m4/euidaccess.m4 create mode 100644 m4/faccessat.m4 create mode 100644 m4/fcntl_h.m4 create mode 100644 m4/getgroups.m4 create mode 100644 m4/group-member.m4 diff --git a/ChangeLog b/ChangeLog index e8bff20d56d..f5f649aae6d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2012-11-14 Paul Eggert + + Use faccessat, not access, when checking file permissions (Bug#12632). + * .bzrignore: Add lib/fcntl.h. + * configure.ac (euidaccess): Remove check; gnulib does this for us now. + (gl_FCNTL_O_FLAGS): Define a dummy version. + * lib/at-func.c, lib/euidaccess.c, lib/faccessat.c, lib/fcntl.in.h: + * lib/getgroups.c, lib/group-member.c, lib/root-uid.h: + * lib/xalloc-oversized.h, m4/euidaccess.m4, m4/faccessat.m4: + * m4/fcntl_h.m4, m4/getgroups.m4, m4/group-member.m4: + New files, from gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + 2012-11-05 Paul Eggert Assume at least POSIX.1-1988 for getpgrp, setpgid, setsid (Bug#12800). diff --git a/admin/ChangeLog b/admin/ChangeLog index 496e1c1bb6a..fd28bf1228f 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,11 @@ +2012-11-14 Paul Eggert + + Use faccessat, not access, when checking file permissions (Bug#12632). + * merge-gnulib (GNULIB_MODULES): Add faccessat. + (GNULIB_TOOL_FLAGS): Avoid at-internal, fchdir, malloc-posix, + openat-die, openat-h, save-cwd. Do not avoid fcntl-h. + Omit gnulib's m4/fcntl-o.m4. + 2012-11-05 Paul Eggert Assume at least POSIX.1-1988 for getpgrp, setpgid, setsid (Bug#12800). diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 901daf4e442..f7a675e5101 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -28,7 +28,7 @@ GNULIB_URL=git://git.savannah.gnu.org/gnulib.git GNULIB_MODULES=' alloca-opt c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 - dtoastr dtotimespec dup2 environ execinfo + dtoastr dtotimespec dup2 environ execinfo faccessat filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink @@ -39,9 +39,12 @@ GNULIB_MODULES=' ' GNULIB_TOOL_FLAGS=' - --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat - --avoid=msvc-inval --avoid=msvc-nothrow - --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types + --avoid=at-internal + --avoid=errno --avoid=fchdir --avoid=fcntl --avoid=fstat + --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow + --avoid=openat-die --avoid=openat-h + --avoid=raise + --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --conditional-dependencies --import --no-changelog --no-vc-files --makefile-name=gnulib.mk @@ -85,7 +88,7 @@ test -x "$gnulib_srcdir"/gnulib-tool || { } "$gnulib_srcdir"/gnulib-tool --dir="$src" $GNULIB_TOOL_FLAGS $GNULIB_MODULES && -rm -- "$src"m4/gnulib-cache.m4 "$src"m4/warn-on-use.m4 && +rm -- "$src"m4/fcntl-o.m4 "$src"m4/gnulib-cache.m4 "$src"m4/warn-on-use.m4 && cp -- "$gnulib_srcdir"/build-aux/texinfo.tex "$src"doc/misc && cp -- "$gnulib_srcdir"/build-aux/move-if-change "$src"build-aux && autoreconf -i -I m4 -- ${src:+"$src"} diff --git a/configure.ac b/configure.ac index 9146c669096..b0c81a23f8a 100644 --- a/configure.ac +++ b/configure.ac @@ -572,6 +572,8 @@ else test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS" fi +# Avoid gnulib's tests for O_NOATIME and O_NOFOLLOW, as we don't use them. +AC_DEFUN([gl_FCNTL_O_FLAGS]) # Avoid gnulib's threadlib module, as we do threads our own way. AC_DEFUN([gl_THREADLIB]) @@ -2872,7 +2874,7 @@ AC_SUBST(BLESSMAIL_TARGET) AC_CHECK_FUNCS(gethostname \ closedir getrusage get_current_dir_name \ lrand48 \ -fpathconf select euidaccess getpagesize setlocale \ +fpathconf select getpagesize setlocale \ utimes getrlimit setrlimit getcwd shutdown getaddrinfo \ strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ diff --git a/lib/at-func.c b/lib/at-func.c new file mode 100644 index 00000000000..481eea475a1 --- /dev/null +++ b/lib/at-func.c @@ -0,0 +1,146 @@ +/* Define at-style functions like fstatat, unlinkat, fchownat, etc. + Copyright (C) 2006, 2009-2012 Free Software Foundation, Inc. + + This program 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. + + This program 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 this program. If not, see . */ + +/* written by Jim Meyering */ + +#include "dosname.h" /* solely for definition of IS_ABSOLUTE_FILE_NAME */ + +#ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD +# include +# ifndef ENOTSUP +# define ENOTSUP EINVAL +# endif +#else +# include "openat.h" +# include "openat-priv.h" +# include "save-cwd.h" +#endif + +#ifdef AT_FUNC_USE_F1_COND +# define CALL_FUNC(F) \ + (flag == AT_FUNC_USE_F1_COND \ + ? AT_FUNC_F1 (F AT_FUNC_POST_FILE_ARGS) \ + : AT_FUNC_F2 (F AT_FUNC_POST_FILE_ARGS)) +# define VALIDATE_FLAG(F) \ + if (flag & ~AT_FUNC_USE_F1_COND) \ + { \ + errno = EINVAL; \ + return FUNC_FAIL; \ + } +#else +# define CALL_FUNC(F) (AT_FUNC_F1 (F AT_FUNC_POST_FILE_ARGS)) +# define VALIDATE_FLAG(F) /* empty */ +#endif + +#ifdef AT_FUNC_RESULT +# define FUNC_RESULT AT_FUNC_RESULT +#else +# define FUNC_RESULT int +#endif + +#ifdef AT_FUNC_FAIL +# define FUNC_FAIL AT_FUNC_FAIL +#else +# define FUNC_FAIL -1 +#endif + +/* Call AT_FUNC_F1 to operate on FILE, which is in the directory + open on descriptor FD. If AT_FUNC_USE_F1_COND is defined to a value, + AT_FUNC_POST_FILE_PARAM_DECLS must include a parameter named flag; + call AT_FUNC_F2 if FLAG is 0 or fail if FLAG contains more bits than + AT_FUNC_USE_F1_COND. Return int and fail with -1 unless AT_FUNC_RESULT + or AT_FUNC_FAIL are defined. If possible, do it without changing the + working directory. Otherwise, resort to using save_cwd/fchdir, + then AT_FUNC_F?/restore_cwd. If either the save_cwd or the restore_cwd + fails, then give a diagnostic and exit nonzero. */ +FUNC_RESULT +AT_FUNC_NAME (int fd, char const *file AT_FUNC_POST_FILE_PARAM_DECLS) +{ + VALIDATE_FLAG (flag); + + if (fd == AT_FDCWD || IS_ABSOLUTE_FILE_NAME (file)) + return CALL_FUNC (file); + +#ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD + errno = ENOTSUP; + return FUNC_FAIL; +#else + { + /* Be careful to choose names unlikely to conflict with + AT_FUNC_POST_FILE_PARAM_DECLS. */ + struct saved_cwd saved_cwd; + int saved_errno; + FUNC_RESULT err; + + { + char proc_buf[OPENAT_BUFFER_SIZE]; + char *proc_file = openat_proc_name (proc_buf, fd, file); + if (proc_file) + { + FUNC_RESULT proc_result = CALL_FUNC (proc_file); + int proc_errno = errno; + if (proc_file != proc_buf) + free (proc_file); + /* If the syscall succeeds, or if it fails with an unexpected + errno value, then return right away. Otherwise, fall through + and resort to using save_cwd/restore_cwd. */ + if (FUNC_FAIL != proc_result) + return proc_result; + if (! EXPECTED_ERRNO (proc_errno)) + { + errno = proc_errno; + return proc_result; + } + } + } + + if (save_cwd (&saved_cwd) != 0) + openat_save_fail (errno); + if (0 <= fd && fd == saved_cwd.desc) + { + /* If saving the working directory collides with the user's + requested fd, then the user's fd must have been closed to + begin with. */ + free_cwd (&saved_cwd); + errno = EBADF; + return FUNC_FAIL; + } + + if (fchdir (fd) != 0) + { + saved_errno = errno; + free_cwd (&saved_cwd); + errno = saved_errno; + return FUNC_FAIL; + } + + err = CALL_FUNC (file); + saved_errno = (err == FUNC_FAIL ? errno : 0); + + if (restore_cwd (&saved_cwd) != 0) + openat_restore_fail (errno); + + free_cwd (&saved_cwd); + + if (saved_errno) + errno = saved_errno; + return err; + } +#endif +} +#undef CALL_FUNC +#undef FUNC_RESULT +#undef FUNC_FAIL diff --git a/lib/euidaccess.c b/lib/euidaccess.c new file mode 100644 index 00000000000..ca2ceca5d22 --- /dev/null +++ b/lib/euidaccess.c @@ -0,0 +1,221 @@ +/* euidaccess -- check if effective user id can access file + + Copyright (C) 1990-1991, 1995, 1998, 2000, 2003-2006, 2008-2012 Free + Software Foundation, Inc. + + This file is part of the GNU C Library. + + This program 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. + + This program 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 this program. If not, see . */ + +/* Written by David MacKenzie and Torbjorn Granlund. + Adapted for GNU C library by Roland McGrath. */ + +#ifndef _LIBC +# include +#endif + +#include +#include +#include +#include + +#include "root-uid.h" + +#if HAVE_LIBGEN_H +# include +#endif + +#include +#ifndef __set_errno +# define __set_errno(val) errno = (val) +#endif + +#if defined EACCES && !defined EACCESS +# define EACCESS EACCES +#endif + +#ifndef F_OK +# define F_OK 0 +# define X_OK 1 +# define W_OK 2 +# define R_OK 4 +#endif + + +#ifdef _LIBC + +# define access __access +# define getuid __getuid +# define getgid __getgid +# define geteuid __geteuid +# define getegid __getegid +# define group_member __group_member +# define euidaccess __euidaccess +# undef stat +# define stat stat64 + +#endif + +/* Return 0 if the user has permission of type MODE on FILE; + otherwise, return -1 and set 'errno'. + Like access, except that it uses the effective user and group + id's instead of the real ones, and it does not always check for read-only + file system, text busy, etc. */ + +int +euidaccess (const char *file, int mode) +{ +#if HAVE_FACCESSAT /* glibc, AIX 7, Solaris 11, Cygwin 1.7 */ + return faccessat (AT_FDCWD, file, mode, AT_EACCESS); +#elif defined EFF_ONLY_OK /* IRIX, OSF/1, Interix */ + return access (file, mode | EFF_ONLY_OK); +#elif defined ACC_SELF /* AIX */ + return accessx (file, mode, ACC_SELF); +#elif HAVE_EACCESS /* FreeBSD */ + return eaccess (file, mode); +#else /* Mac OS X, NetBSD, OpenBSD, HP-UX, Solaris, Cygwin, mingw, BeOS */ + + uid_t uid = getuid (); + gid_t gid = getgid (); + uid_t euid = geteuid (); + gid_t egid = getegid (); + struct stat stats; + +# if HAVE_DECL_SETREGID && PREFER_NONREENTRANT_EUIDACCESS + + /* Define PREFER_NONREENTRANT_EUIDACCESS if you prefer euidaccess to + return the correct result even if this would make it + nonreentrant. Define this only if your entire application is + safe even if the uid or gid might temporarily change. If your + application uses signal handlers or threads it is probably not + safe. */ + + if (mode == F_OK) + return stat (file, &stats); + else + { + int result; + int saved_errno; + + if (uid != euid) + setreuid (euid, uid); + if (gid != egid) + setregid (egid, gid); + + result = access (file, mode); + saved_errno = errno; + + /* Restore them. */ + if (uid != euid) + setreuid (uid, euid); + if (gid != egid) + setregid (gid, egid); + + errno = saved_errno; + return result; + } + +# else + + /* The following code assumes the traditional Unix model, and is not + correct on systems that have ACLs or the like. However, it's + better than nothing, and it is reentrant. */ + + unsigned int granted; + if (uid == euid && gid == egid) + /* If we are not set-uid or set-gid, access does the same. */ + return access (file, mode); + + if (stat (file, &stats) != 0) + return -1; + + /* The super-user can read and write any file, and execute any file + that anyone can execute. */ + if (euid == ROOT_UID + && ((mode & X_OK) == 0 + || (stats.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH)))) + return 0; + + /* Convert the mode to traditional form, clearing any bogus bits. */ + if (R_OK == 4 && W_OK == 2 && X_OK == 1 && F_OK == 0) + mode &= 7; + else + mode = ((mode & R_OK ? 4 : 0) + + (mode & W_OK ? 2 : 0) + + (mode & X_OK ? 1 : 0)); + + if (mode == 0) + return 0; /* The file exists. */ + + /* Convert the file's permission bits to traditional form. */ + if (S_IRUSR == (4 << 6) && S_IWUSR == (2 << 6) && S_IXUSR == (1 << 6) + && S_IRGRP == (4 << 3) && S_IWGRP == (2 << 3) && S_IXGRP == (1 << 3) + && S_IROTH == (4 << 0) && S_IWOTH == (2 << 0) && S_IXOTH == (1 << 0)) + granted = stats.st_mode; + else + granted = ((stats.st_mode & S_IRUSR ? 4 << 6 : 0) + + (stats.st_mode & S_IWUSR ? 2 << 6 : 0) + + (stats.st_mode & S_IXUSR ? 1 << 6 : 0) + + (stats.st_mode & S_IRGRP ? 4 << 3 : 0) + + (stats.st_mode & S_IWGRP ? 2 << 3 : 0) + + (stats.st_mode & S_IXGRP ? 1 << 3 : 0) + + (stats.st_mode & S_IROTH ? 4 << 0 : 0) + + (stats.st_mode & S_IWOTH ? 2 << 0 : 0) + + (stats.st_mode & S_IXOTH ? 1 << 0 : 0)); + + if (euid == stats.st_uid) + granted >>= 6; + else if (egid == stats.st_gid || group_member (stats.st_gid)) + granted >>= 3; + + if ((mode & ~granted) == 0) + return 0; + __set_errno (EACCESS); + return -1; + +# endif +#endif +} +#undef euidaccess +#ifdef weak_alias +weak_alias (__euidaccess, euidaccess) +#endif + +#ifdef TEST +# include +# include +# include + +char *program_name; + +int +main (int argc, char **argv) +{ + char *file; + int mode; + int err; + + program_name = argv[0]; + if (argc < 3) + abort (); + file = argv[1]; + mode = atoi (argv[2]); + + err = euidaccess (file, mode); + printf ("%d\n", err); + if (err != 0) + error (0, errno, "%s", file); + exit (0); +} +#endif diff --git a/lib/faccessat.c b/lib/faccessat.c new file mode 100644 index 00000000000..d11a3efaad6 --- /dev/null +++ b/lib/faccessat.c @@ -0,0 +1,45 @@ +/* Check the access rights of a file relative to an open directory. + Copyright (C) 2009-2012 Free Software Foundation, Inc. + + This program 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. + + This program 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 this program. If not, see . */ + +/* written by Eric Blake */ + +#include + +#include +#include + +#ifndef HAVE_ACCESS +/* Mingw lacks access, but it also lacks real vs. effective ids, so + the gnulib euidaccess module is good enough. */ +# undef access +# define access euidaccess +#endif + +/* Invoke access or euidaccess on file, FILE, using mode MODE, in the directory + open on descriptor FD. If possible, do it without changing the + working directory. Otherwise, resort to using save_cwd/fchdir, then + (access|euidaccess)/restore_cwd. If either the save_cwd or the + restore_cwd fails, then give a diagnostic and exit nonzero. + Note that this implementation only supports AT_EACCESS, although some + native versions also support AT_SYMLINK_NOFOLLOW. */ + +#define AT_FUNC_NAME faccessat +#define AT_FUNC_F1 euidaccess +#define AT_FUNC_F2 access +#define AT_FUNC_USE_F1_COND AT_EACCESS +#define AT_FUNC_POST_FILE_PARAM_DECLS , int mode, int flag +#define AT_FUNC_POST_FILE_ARGS , mode +#include "at-func.c" diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h new file mode 100644 index 00000000000..fb402ee1f0f --- /dev/null +++ b/lib/fcntl.in.h @@ -0,0 +1,355 @@ +/* Like , but with non-working flags defined to 0. + + Copyright (C) 2006-2012 Free Software Foundation, Inc. + + This program 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. + + This program 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 this program. If not, see . */ + +/* written by Paul Eggert */ + +#if __GNUC__ >= 3 +@PRAGMA_SYSTEM_HEADER@ +#endif +@PRAGMA_COLUMNS@ + +#if defined __need_system_fcntl_h +/* Special invocation convention. */ + +/* Needed before . + May also define off_t to a 64-bit type on native Windows. */ +#include +/* On some systems other than glibc, is a prerequisite of + . On glibc systems, we would like to avoid namespace pollution. + But on glibc systems, includes inside an + extern "C" { ... } block, which leads to errors in C++ mode with the + overridden from gnulib. These errors are known to be gone + with g++ version >= 4.3. */ +#if !(defined __GLIBC__ || defined __UCLIBC__) || (defined __cplusplus && defined GNULIB_NAMESPACE && !(__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3))) +# include +#endif +#@INCLUDE_NEXT@ @NEXT_FCNTL_H@ + +#else +/* Normal invocation convention. */ + +#ifndef _@GUARD_PREFIX@_FCNTL_H + +/* Needed before . + May also define off_t to a 64-bit type on native Windows. */ +#include +/* On some systems other than glibc, is a prerequisite of + . On glibc systems, we would like to avoid namespace pollution. + But on glibc systems, includes inside an + extern "C" { ... } block, which leads to errors in C++ mode with the + overridden from gnulib. These errors are known to be gone + with g++ version >= 4.3. */ +#if !(defined __GLIBC__ || defined __UCLIBC__) || (defined __cplusplus && defined GNULIB_NAMESPACE && !(__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3))) +# include +#endif +/* The include_next requires a split double-inclusion guard. */ +#@INCLUDE_NEXT@ @NEXT_FCNTL_H@ + +#ifndef _@GUARD_PREFIX@_FCNTL_H +#define _@GUARD_PREFIX@_FCNTL_H + +#ifndef __GLIBC__ /* Avoid namespace pollution on glibc systems. */ +# include +#endif + +/* Native Windows platforms declare open(), creat() in . */ +#if (@GNULIB_OPEN@ || defined GNULIB_POSIXCHECK) \ + && ((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__) +# include +#endif + + +/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */ + +/* The definition of _GL_ARG_NONNULL is copied here. */ + +/* The definition of _GL_WARN_ON_USE is copied here. */ + + +/* Declare overridden functions. */ + +#if @GNULIB_FCNTL@ +# if @REPLACE_FCNTL@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef fcntl +# define fcntl rpl_fcntl +# endif +_GL_FUNCDECL_RPL (fcntl, int, (int fd, int action, ...)); +_GL_CXXALIAS_RPL (fcntl, int, (int fd, int action, ...)); +# else +# if !@HAVE_FCNTL@ +_GL_FUNCDECL_SYS (fcntl, int, (int fd, int action, ...)); +# endif +_GL_CXXALIAS_SYS (fcntl, int, (int fd, int action, ...)); +# endif +_GL_CXXALIASWARN (fcntl); +#elif defined GNULIB_POSIXCHECK +# undef fcntl +# if HAVE_RAW_DECL_FCNTL +_GL_WARN_ON_USE (fcntl, "fcntl is not always POSIX compliant - " + "use gnulib module fcntl for portability"); +# endif +#endif + +#if @GNULIB_OPEN@ +# if @REPLACE_OPEN@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef open +# define open rpl_open +# endif +_GL_FUNCDECL_RPL (open, int, (const char *filename, int flags, ...) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (open, int, (const char *filename, int flags, ...)); +# else +_GL_CXXALIAS_SYS (open, int, (const char *filename, int flags, ...)); +# endif +/* On HP-UX 11, in C++ mode, open() is defined as an inline function with a + default argument. _GL_CXXALIASWARN does not work in this case. */ +# if !defined __hpux +_GL_CXXALIASWARN (open); +# endif +#elif defined GNULIB_POSIXCHECK +# undef open +/* Assume open is always declared. */ +_GL_WARN_ON_USE (open, "open is not always POSIX compliant - " + "use gnulib module open for portability"); +#endif + +#if @GNULIB_OPENAT@ +# if @REPLACE_OPENAT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef openat +# define openat rpl_openat +# endif +_GL_FUNCDECL_RPL (openat, int, + (int fd, char const *file, int flags, /* mode_t mode */ ...) + _GL_ARG_NONNULL ((2))); +_GL_CXXALIAS_RPL (openat, int, + (int fd, char const *file, int flags, /* mode_t mode */ ...)); +# else +# if !@HAVE_OPENAT@ +_GL_FUNCDECL_SYS (openat, int, + (int fd, char const *file, int flags, /* mode_t mode */ ...) + _GL_ARG_NONNULL ((2))); +# endif +_GL_CXXALIAS_SYS (openat, int, + (int fd, char const *file, int flags, /* mode_t mode */ ...)); +# endif +_GL_CXXALIASWARN (openat); +#elif defined GNULIB_POSIXCHECK +# undef openat +# if HAVE_RAW_DECL_OPENAT +_GL_WARN_ON_USE (openat, "openat is not portable - " + "use gnulib module openat for portability"); +# endif +#endif + + +/* Fix up the FD_* macros, only known to be missing on mingw. */ + +#ifndef FD_CLOEXEC +# define FD_CLOEXEC 1 +#endif + +/* Fix up the supported F_* macros. Intentionally leave other F_* + macros undefined. Only known to be missing on mingw. */ + +#ifndef F_DUPFD_CLOEXEC +# define F_DUPFD_CLOEXEC 0x40000000 +/* Witness variable: 1 if gnulib defined F_DUPFD_CLOEXEC, 0 otherwise. */ +# define GNULIB_defined_F_DUPFD_CLOEXEC 1 +#else +# define GNULIB_defined_F_DUPFD_CLOEXEC 0 +#endif + +#ifndef F_DUPFD +# define F_DUPFD 1 +#endif + +#ifndef F_GETFD +# define F_GETFD 2 +#endif + +/* Fix up the O_* macros. */ + +#if !defined O_DIRECT && defined O_DIRECTIO +/* Tru64 spells it 'O_DIRECTIO'. */ +# define O_DIRECT O_DIRECTIO +#endif + +#if !defined O_CLOEXEC && defined O_NOINHERIT +/* Mingw spells it 'O_NOINHERIT'. */ +# define O_CLOEXEC O_NOINHERIT +#endif + +#ifndef O_CLOEXEC +# define O_CLOEXEC 0 +#endif + +#ifndef O_DIRECT +# define O_DIRECT 0 +#endif + +#ifndef O_DIRECTORY +# define O_DIRECTORY 0 +#endif + +#ifndef O_DSYNC +# define O_DSYNC 0 +#endif + +#ifndef O_EXEC +# ifdef O_PATH +# define O_EXEC O_PATH +# else +# define O_EXEC O_RDONLY /* This is often close enough in older systems. */ +# endif +#endif + +#ifndef O_IGNORE_CTTY +# define O_IGNORE_CTTY 0 +#endif + +#ifndef O_NDELAY +# define O_NDELAY 0 +#endif + +#ifndef O_NOATIME +# define O_NOATIME 0 +#endif + +#ifndef O_NONBLOCK +# define O_NONBLOCK O_NDELAY +#endif + +/* If the gnulib module 'nonblocking' is in use, guarantee a working non-zero + value of O_NONBLOCK. Otherwise, O_NONBLOCK is defined (above) to O_NDELAY + or to 0 as fallback. */ +#if @GNULIB_NONBLOCKING@ +# if O_NONBLOCK +# define GNULIB_defined_O_NONBLOCK 0 +# else +# define GNULIB_defined_O_NONBLOCK 1 +# undef O_NONBLOCK +# define O_NONBLOCK 0x40000000 +# endif +#endif + +#ifndef O_NOCTTY +# define O_NOCTTY 0 +#endif + +#ifndef O_NOFOLLOW +# define O_NOFOLLOW 0 +#endif + +#ifndef O_NOLINK +# define O_NOLINK 0 +#endif + +#ifndef O_NOLINKS +# define O_NOLINKS 0 +#endif + +#ifndef O_NOTRANS +# define O_NOTRANS 0 +#endif + +#ifndef O_RSYNC +# define O_RSYNC 0 +#endif + +#ifndef O_SEARCH +# ifdef O_PATH +# define O_SEARCH O_PATH +# else +# define O_SEARCH O_RDONLY /* This is often close enough in older systems. */ +# endif +#endif + +#ifndef O_SYNC +# define O_SYNC 0 +#endif + +#ifndef O_TTY_INIT +# define O_TTY_INIT 0 +#endif + +#if ~O_ACCMODE & (O_RDONLY | O_WRONLY | O_RDWR | O_EXEC | O_SEARCH) +# undef O_ACCMODE +# define O_ACCMODE (O_RDONLY | O_WRONLY | O_RDWR | O_EXEC | O_SEARCH) +#endif + +/* For systems that distinguish between text and binary I/O. + O_BINARY is usually declared in fcntl.h */ +#if !defined O_BINARY && defined _O_BINARY + /* For MSC-compatible compilers. */ +# define O_BINARY _O_BINARY +# define O_TEXT _O_TEXT +#endif + +#if defined __BEOS__ || defined __HAIKU__ + /* BeOS 5 and Haiku have O_BINARY and O_TEXT, but they have no effect. */ +# undef O_BINARY +# undef O_TEXT +#endif + +#ifndef O_BINARY +# define O_BINARY 0 +# define O_TEXT 0 +#endif + +/* Fix up the AT_* macros. */ + +/* Work around a bug in Solaris 9 and 10: AT_FDCWD is positive. Its + value exceeds INT_MAX, so its use as an int doesn't conform to the + C standard, and GCC and Sun C complain in some cases. If the bug + is present, undef AT_FDCWD here, so it can be redefined below. */ +#if 0 < AT_FDCWD && AT_FDCWD == 0xffd19553 +# undef AT_FDCWD +#endif + +/* Use the same bit pattern as Solaris 9, but with the proper + signedness. The bit pattern is important, in case this actually is + Solaris with the above workaround. */ +#ifndef AT_FDCWD +# define AT_FDCWD (-3041965) +#endif + +/* Use the same values as Solaris 9. This shouldn't matter, but + there's no real reason to differ. */ +#ifndef AT_SYMLINK_NOFOLLOW +# define AT_SYMLINK_NOFOLLOW 4096 +#endif + +#ifndef AT_REMOVEDIR +# define AT_REMOVEDIR 1 +#endif + +/* Solaris 9 lacks these two, so just pick unique values. */ +#ifndef AT_SYMLINK_FOLLOW +# define AT_SYMLINK_FOLLOW 2 +#endif + +#ifndef AT_EACCESS +# define AT_EACCESS 4 +#endif + + +#endif /* _@GUARD_PREFIX@_FCNTL_H */ +#endif /* _@GUARD_PREFIX@_FCNTL_H */ +#endif diff --git a/lib/getgroups.c b/lib/getgroups.c new file mode 100644 index 00000000000..f9d36236afe --- /dev/null +++ b/lib/getgroups.c @@ -0,0 +1,116 @@ +/* provide consistent interface to getgroups for systems that don't allow N==0 + + Copyright (C) 1996, 1999, 2003, 2006-2012 Free Software Foundation, Inc. + + This program 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. + + This program 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 this program. If not, see . */ + +/* written by Jim Meyering */ + +#include + +#include + +#include +#include +#include + +#if !HAVE_GETGROUPS + +/* Provide a stub that fails with ENOSYS, since there is no group + information available on mingw. */ +int +getgroups (int n _GL_UNUSED, GETGROUPS_T *groups _GL_UNUSED) +{ + errno = ENOSYS; + return -1; +} + +#else /* HAVE_GETGROUPS */ + +# undef getgroups +# ifndef GETGROUPS_ZERO_BUG +# define GETGROUPS_ZERO_BUG 0 +# endif + +/* On at least Ultrix 4.3 and NextStep 3.2, getgroups (0, NULL) always + fails. On other systems, it returns the number of supplemental + groups for the process. This function handles that special case + and lets the system-provided function handle all others. However, + it can fail with ENOMEM if memory is tight. It is unspecified + whether the effective group id is included in the list. */ + +int +rpl_getgroups (int n, gid_t *group) +{ + int n_groups; + GETGROUPS_T *gbuf; + int saved_errno; + + if (n < 0) + { + errno = EINVAL; + return -1; + } + + if (n != 0 || !GETGROUPS_ZERO_BUG) + { + int result; + if (sizeof *group == sizeof *gbuf) + return getgroups (n, (GETGROUPS_T *) group); + + if (SIZE_MAX / sizeof *gbuf <= n) + { + errno = ENOMEM; + return -1; + } + gbuf = malloc (n * sizeof *gbuf); + if (!gbuf) + return -1; + result = getgroups (n, gbuf); + if (0 <= result) + { + n = result; + while (n--) + group[n] = gbuf[n]; + } + saved_errno = errno; + free (gbuf); + errno == saved_errno; + return result; + } + + n = 20; + while (1) + { + /* No need to worry about address arithmetic overflow here, + since the ancient systems that we're running on have low + limits on the number of secondary groups. */ + gbuf = malloc (n * sizeof *gbuf); + if (!gbuf) + return -1; + n_groups = getgroups (n, gbuf); + if (n_groups == -1 ? errno != EINVAL : n_groups < n) + break; + free (gbuf); + n *= 2; + } + + saved_errno = errno; + free (gbuf); + errno = saved_errno; + + return n_groups; +} + +#endif /* HAVE_GETGROUPS */ diff --git a/lib/gnulib.mk b/lib/gnulib.mk index 324e5cb78fd..f74c46ae9c8 100644 --- a/lib/gnulib.mk +++ b/lib/gnulib.mk @@ -21,7 +21,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub utimens warnings +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=at-internal --avoid=errno --avoid=fchdir --avoid=fcntl --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=openat-h --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub utimens warnings MOSTLYCLEANFILES += core *.stackdump @@ -158,6 +158,17 @@ EXTRA_libgnu_a_SOURCES += dup2.c ## end gnulib module dup2 +## begin gnulib module euidaccess + +if gl_GNULIB_ENABLED_euidaccess + +endif +EXTRA_DIST += euidaccess.c + +EXTRA_libgnu_a_SOURCES += euidaccess.c + +## end gnulib module euidaccess + ## begin gnulib module execinfo BUILT_SOURCES += $(EXECINFO_H) @@ -183,6 +194,50 @@ EXTRA_libgnu_a_SOURCES += execinfo.c ## end gnulib module execinfo +## begin gnulib module faccessat + + +EXTRA_DIST += at-func.c faccessat.c + +EXTRA_libgnu_a_SOURCES += at-func.c faccessat.c + +## end gnulib module faccessat + +## begin gnulib module fcntl-h + +BUILT_SOURCES += fcntl.h + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +fcntl.h: fcntl.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_FCNTL_H''@|$(NEXT_FCNTL_H)|g' \ + -e 's/@''GNULIB_FCNTL''@/$(GNULIB_FCNTL)/g' \ + -e 's/@''GNULIB_NONBLOCKING''@/$(GNULIB_NONBLOCKING)/g' \ + -e 's/@''GNULIB_OPEN''@/$(GNULIB_OPEN)/g' \ + -e 's/@''GNULIB_OPENAT''@/$(GNULIB_OPENAT)/g' \ + -e 's|@''HAVE_FCNTL''@|$(HAVE_FCNTL)|g' \ + -e 's|@''HAVE_OPENAT''@|$(HAVE_OPENAT)|g' \ + -e 's|@''REPLACE_FCNTL''@|$(REPLACE_FCNTL)|g' \ + -e 's|@''REPLACE_OPEN''@|$(REPLACE_OPEN)|g' \ + -e 's|@''REPLACE_OPENAT''@|$(REPLACE_OPENAT)|g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \ + < $(srcdir)/fcntl.in.h; \ + } > $@-t && \ + mv $@-t $@ +MOSTLYCLEANFILES += fcntl.h fcntl.h-t + +EXTRA_DIST += fcntl.in.h + +## end gnulib module fcntl-h + ## begin gnulib module filemode libgnu_a_SOURCES += filemode.c @@ -200,6 +255,17 @@ EXTRA_libgnu_a_SOURCES += fpending.c ## end gnulib module fpending +## begin gnulib module getgroups + +if gl_GNULIB_ENABLED_getgroups + +endif +EXTRA_DIST += getgroups.c + +EXTRA_libgnu_a_SOURCES += getgroups.c + +## end gnulib module getgroups + ## begin gnulib module getloadavg @@ -259,6 +325,17 @@ EXTRA_libgnu_a_SOURCES += gettimeofday.c ## end gnulib module gettimeofday +## begin gnulib module group-member + +if gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1 + +endif +EXTRA_DIST += group-member.c + +EXTRA_libgnu_a_SOURCES += group-member.c + +## end gnulib module group-member + ## begin gnulib module ignore-value @@ -371,6 +448,15 @@ EXTRA_libgnu_a_SOURCES += readlink.c ## end gnulib module readlink +## begin gnulib module root-uid + +if gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c + +endif +EXTRA_DIST += root-uid.h + +## end gnulib module root-uid + ## begin gnulib module signal-h BUILT_SOURCES += signal.h @@ -1329,6 +1415,15 @@ EXTRA_DIST += verify.h ## end gnulib module verify +## begin gnulib module xalloc-oversized + +if gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec + +endif +EXTRA_DIST += xalloc-oversized.h + +## end gnulib module xalloc-oversized + mostlyclean-local: mostlyclean-generic @for dir in '' $(MOSTLYCLEANDIRS); do \ diff --git a/lib/group-member.c b/lib/group-member.c new file mode 100644 index 00000000000..5fcc7e01d0c --- /dev/null +++ b/lib/group-member.c @@ -0,0 +1,119 @@ +/* group-member.c -- determine whether group id is in calling user's group list + + Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2012 Free Software + Foundation, Inc. + + This program 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. + + This program 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 this program. If not, see . */ + +#include + +/* Specification. */ +#include + +#include +#include +#include + +#include "xalloc-oversized.h" + +/* Most processes have no more than this many groups, and for these + processes we can avoid using malloc. */ +enum { GROUPBUF_SIZE = 100 }; + +struct group_info + { + gid_t *group; + gid_t groupbuf[GROUPBUF_SIZE]; + }; + +static void +free_group_info (struct group_info const *g) +{ + if (g->group != g->groupbuf) + free (g->group); +} + +static int +get_group_info (struct group_info *gi) +{ + int n_groups = getgroups (GROUPBUF_SIZE, gi->groupbuf); + gi->group = gi->groupbuf; + + if (n_groups < 0) + { + int n_group_slots = getgroups (0, NULL); + if (0 <= n_group_slots + && ! xalloc_oversized (n_group_slots, sizeof *gi->group)) + { + gi->group = malloc (n_group_slots * sizeof *gi->group); + if (gi->group) + n_groups = getgroups (n_group_slots, gi->group); + } + } + + /* In case of error, the user loses. */ + return n_groups; +} + +/* Return non-zero if GID is one that we have in our groups list. + Note that the groups list is not guaranteed to contain the current + or effective group ID, so they should generally be checked + separately. */ + +int +group_member (gid_t gid) +{ + int i; + int found; + struct group_info gi; + int n_groups = get_group_info (&gi); + + /* Search through the list looking for GID. */ + found = 0; + for (i = 0; i < n_groups; i++) + { + if (gid == gi.group[i]) + { + found = 1; + break; + } + } + + free_group_info (&gi); + + return found; +} + +#ifdef TEST + +char *program_name; + +int +main (int argc, char **argv) +{ + int i; + + program_name = argv[0]; + + for (i = 1; i < argc; i++) + { + gid_t gid; + + gid = atoi (argv[i]); + printf ("%d: %s\n", gid, group_member (gid) ? "yes" : "no"); + } + exit (0); +} + +#endif /* TEST */ diff --git a/lib/root-uid.h b/lib/root-uid.h new file mode 100644 index 00000000000..2379773c291 --- /dev/null +++ b/lib/root-uid.h @@ -0,0 +1,30 @@ +/* The user ID that always has appropriate privileges in the POSIX sense. + + Copyright 2012 Free Software Foundation, Inc. + + This program 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. + + This program 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 this program. If not, see . + + Written by Paul Eggert. */ + +#ifndef ROOT_UID_H_ +#define ROOT_UID_H_ + +/* The user ID that always has appropriate privileges in the POSIX sense. */ +#ifdef __TANDEM +# define ROOT_UID 65535 +#else +# define ROOT_UID 0 +#endif + +#endif diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h new file mode 100644 index 00000000000..ad777d8dd79 --- /dev/null +++ b/lib/xalloc-oversized.h @@ -0,0 +1,38 @@ +/* xalloc-oversized.h -- memory allocation size checking + + Copyright (C) 1990-2000, 2003-2004, 2006-2012 Free Software Foundation, Inc. + + This program 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. + + This program 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 this program. If not, see . */ + +#ifndef XALLOC_OVERSIZED_H_ +# define XALLOC_OVERSIZED_H_ + +# include + +/* Return 1 if an array of N objects, each of size S, cannot exist due + to size arithmetic overflow. S must be positive and N must be + nonnegative. This is a macro, not a function, so that it + works correctly even when SIZE_MAX < N. + + By gnulib convention, SIZE_MAX represents overflow in size + calculations, so the conservative dividend to use here is + SIZE_MAX - 1, since SIZE_MAX might represent an overflowed value. + However, malloc (SIZE_MAX) fails on all known hosts where + sizeof (ptrdiff_t) <= sizeof (size_t), so do not bother to test for + exactly-SIZE_MAX allocations on such hosts; this avoids a test and + branch when S is known to be 1. */ +# define xalloc_oversized(n, s) \ + ((size_t) (sizeof (ptrdiff_t) <= sizeof (size_t) ? -1 : -2) / (s) < (n)) + +#endif /* !XALLOC_OVERSIZED_H_ */ diff --git a/m4/euidaccess.m4 b/m4/euidaccess.m4 new file mode 100644 index 00000000000..2de95b88ba8 --- /dev/null +++ b/m4/euidaccess.m4 @@ -0,0 +1,52 @@ +# euidaccess.m4 serial 15 +dnl Copyright (C) 2002-2012 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_FUNC_NONREENTRANT_EUIDACCESS], +[ + AC_REQUIRE([gl_FUNC_EUIDACCESS]) + AC_CHECK_DECLS([setregid]) + AC_DEFINE([PREFER_NONREENTRANT_EUIDACCESS], [1], + [Define this if you prefer euidaccess to return the correct result + even if this would make it nonreentrant. Define this only if your + entire application is safe even if the uid or gid might temporarily + change. If your application uses signal handlers or threads it + is probably not safe.]) +]) + +AC_DEFUN([gl_FUNC_EUIDACCESS], +[ + AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) + + dnl Persuade glibc to declare euidaccess(). + AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) + + AC_CHECK_FUNCS([euidaccess]) + if test $ac_cv_func_euidaccess = no; then + HAVE_EUIDACCESS=0 + fi +]) + +# Prerequisites of lib/euidaccess.c. +AC_DEFUN([gl_PREREQ_EUIDACCESS], [ + dnl Prefer POSIX faccessat over non-standard euidaccess. + AC_CHECK_FUNCS_ONCE([faccessat]) + dnl Try various other non-standard fallbacks. + AC_CHECK_HEADERS([libgen.h]) + AC_FUNC_GETGROUPS + + # Solaris 9 and 10 need -lgen to get the eaccess function. + # Save and restore LIBS so -lgen isn't added to it. Otherwise, *all* + # programs in the package would end up linked with that potentially-shared + # library, inducing unnecessary run-time overhead. + LIB_EACCESS= + AC_SUBST([LIB_EACCESS]) + gl_saved_libs=$LIBS + AC_SEARCH_LIBS([eaccess], [gen], + [test "$ac_cv_search_eaccess" = "none required" || + LIB_EACCESS=$ac_cv_search_eaccess]) + AC_CHECK_FUNCS([eaccess]) + LIBS=$gl_saved_libs +]) diff --git a/m4/faccessat.m4 b/m4/faccessat.m4 new file mode 100644 index 00000000000..82f3b1f8dde --- /dev/null +++ b/m4/faccessat.m4 @@ -0,0 +1,28 @@ +# serial 6 +# See if we need to provide faccessat replacement. + +dnl Copyright (C) 2009-2012 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +# Written by Eric Blake. + +AC_DEFUN([gl_FUNC_FACCESSAT], +[ + AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) + + dnl Persuade glibc to declare faccessat(). + AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) + + AC_CHECK_FUNCS_ONCE([faccessat]) + if test $ac_cv_func_faccessat = no; then + HAVE_FACCESSAT=0 + fi +]) + +# Prerequisites of lib/faccessat.m4. +AC_DEFUN([gl_PREREQ_FACCESSAT], +[ + AC_CHECK_FUNCS([access]) +]) diff --git a/m4/fcntl_h.m4 b/m4/fcntl_h.m4 new file mode 100644 index 00000000000..cac28aeb283 --- /dev/null +++ b/m4/fcntl_h.m4 @@ -0,0 +1,50 @@ +# serial 15 +# Configure fcntl.h. +dnl Copyright (C) 2006-2007, 2009-2012 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl Written by Paul Eggert. + +AC_DEFUN([gl_FCNTL_H], +[ + AC_REQUIRE([gl_FCNTL_H_DEFAULTS]) + AC_REQUIRE([gl_FCNTL_O_FLAGS]) + gl_NEXT_HEADERS([fcntl.h]) + + dnl Ensure the type pid_t gets defined. + AC_REQUIRE([AC_TYPE_PID_T]) + + dnl Ensure the type mode_t gets defined. + AC_REQUIRE([AC_TYPE_MODE_T]) + + dnl Check for declarations of anything we want to poison if the + dnl corresponding gnulib module is not in use, if it is not common + dnl enough to be declared everywhere. + gl_WARN_ON_USE_PREPARE([[#include + ]], [fcntl openat]) +]) + +AC_DEFUN([gl_FCNTL_MODULE_INDICATOR], +[ + dnl Use AC_REQUIRE here, so that the default settings are expanded once only. + AC_REQUIRE([gl_FCNTL_H_DEFAULTS]) + gl_MODULE_INDICATOR_SET_VARIABLE([$1]) + dnl Define it also as a C macro, for the benefit of the unit tests. + gl_MODULE_INDICATOR_FOR_TESTS([$1]) +]) + +AC_DEFUN([gl_FCNTL_H_DEFAULTS], +[ + GNULIB_FCNTL=0; AC_SUBST([GNULIB_FCNTL]) + GNULIB_NONBLOCKING=0; AC_SUBST([GNULIB_NONBLOCKING]) + GNULIB_OPEN=0; AC_SUBST([GNULIB_OPEN]) + GNULIB_OPENAT=0; AC_SUBST([GNULIB_OPENAT]) + dnl Assume proper GNU behavior unless another module says otherwise. + HAVE_FCNTL=1; AC_SUBST([HAVE_FCNTL]) + HAVE_OPENAT=1; AC_SUBST([HAVE_OPENAT]) + REPLACE_FCNTL=0; AC_SUBST([REPLACE_FCNTL]) + REPLACE_OPEN=0; AC_SUBST([REPLACE_OPEN]) + REPLACE_OPENAT=0; AC_SUBST([REPLACE_OPENAT]) +]) diff --git a/m4/getgroups.m4 b/m4/getgroups.m4 new file mode 100644 index 00000000000..17473af486b --- /dev/null +++ b/m4/getgroups.m4 @@ -0,0 +1,107 @@ +# serial 18 + +dnl From Jim Meyering. +dnl A wrapper around AC_FUNC_GETGROUPS. + +# Copyright (C) 1996-1997, 1999-2004, 2008-2012 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +m4_version_prereq([2.70], [] ,[ + +# This is taken from the following Autoconf patch: +# http://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=7fbb553727ed7e0e689a17594b58559ecf3ea6e9 +AC_DEFUN([AC_FUNC_GETGROUPS], +[ + AC_REQUIRE([AC_TYPE_GETGROUPS])dnl + AC_REQUIRE([AC_TYPE_SIZE_T])dnl + AC_REQUIRE([AC_CANONICAL_HOST])dnl for cross-compiles + AC_CHECK_FUNC([getgroups]) + + # If we don't yet have getgroups, see if it's in -lbsd. + # This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1. + ac_save_LIBS=$LIBS + if test $ac_cv_func_getgroups = no; then + AC_CHECK_LIB(bsd, getgroups, [GETGROUPS_LIB=-lbsd]) + fi + + # Run the program to test the functionality of the system-supplied + # getgroups function only if there is such a function. + if test $ac_cv_func_getgroups = yes; then + AC_CACHE_CHECK([for working getgroups], [ac_cv_func_getgroups_works], + [AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [AC_INCLUDES_DEFAULT], + [[/* On Ultrix 4.3, getgroups (0, 0) always fails. */ + return getgroups (0, 0) == -1;]]) + ], + [ac_cv_func_getgroups_works=yes], + [ac_cv_func_getgroups_works=no], + [case "$host_os" in # (( + # Guess yes on glibc systems. + *-gnu*) ac_cv_func_getgroups_works="guessing yes" ;; + # If we don't know, assume the worst. + *) ac_cv_func_getgroups_works="guessing no" ;; + esac + ]) + ]) + else + ac_cv_func_getgroups_works=no + fi + case "$ac_cv_func_getgroups_works" in + *yes) + AC_DEFINE([HAVE_GETGROUPS], [1], + [Define to 1 if your system has a working `getgroups' function.]) + ;; + esac + LIBS=$ac_save_LIBS +])# AC_FUNC_GETGROUPS + +]) + +AC_DEFUN([gl_FUNC_GETGROUPS], +[ + AC_REQUIRE([AC_TYPE_GETGROUPS]) + AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) + AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles + + AC_FUNC_GETGROUPS + if test $ac_cv_func_getgroups != yes; then + HAVE_GETGROUPS=0 + else + if test "$ac_cv_type_getgroups" != gid_t \ + || { case "$ac_cv_func_getgroups_works" in + *yes) false;; + *) true;; + esac + }; then + REPLACE_GETGROUPS=1 + AC_DEFINE([GETGROUPS_ZERO_BUG], [1], [Define this to 1 if + getgroups(0,NULL) does not return the number of groups.]) + else + dnl Detect FreeBSD bug; POSIX requires getgroups(-1,ptr) to fail. + AC_CACHE_CHECK([whether getgroups handles negative values], + [gl_cv_func_getgroups_works], + [AC_RUN_IFELSE([AC_LANG_PROGRAM([AC_INCLUDES_DEFAULT], + [[int size = getgroups (0, 0); + gid_t *list = malloc (size * sizeof *list); + return getgroups (-1, list) != -1;]])], + [gl_cv_func_getgroups_works=yes], + [gl_cv_func_getgroups_works=no], + [case "$host_os" in + # Guess yes on glibc systems. + *-gnu*) gl_cv_func_getgroups_works="guessing yes" ;; + # If we don't know, assume the worst. + *) gl_cv_func_getgroups_works="guessing no" ;; + esac + ])]) + case "$gl_cv_func_getgroups_works" in + *yes) ;; + *) REPLACE_GETGROUPS=1 ;; + esac + fi + fi + test -n "$GETGROUPS_LIB" && LIBS="$GETGROUPS_LIB $LIBS" +]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 5cd278454e7..30f81b4781f 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -54,18 +54,23 @@ AC_DEFUN([gl_EARLY], # Code from module dtotimespec: # Code from module dup2: # Code from module environ: + # Code from module euidaccess: # Code from module execinfo: # Code from module extensions: AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) # Code from module extern-inline: + # Code from module faccessat: + # Code from module fcntl-h: # Code from module filemode: # Code from module fpending: + # Code from module getgroups: # Code from module getloadavg: # Code from module getopt-gnu: # Code from module getopt-posix: # Code from module gettext-h: # Code from module gettime: # Code from module gettimeofday: + # Code from module group-member: # Code from module ignore-value: # Code from module include_next: # Code from module intprops: @@ -81,6 +86,7 @@ AC_DEFUN([gl_EARLY], # Code from module pselect: # Code from module pthread_sigmask: # Code from module readlink: + # Code from module root-uid: # Code from module signal-h: # Code from module snippet/_Noreturn: # Code from module snippet/arg-nonnull: @@ -122,6 +128,7 @@ AC_DEFUN([gl_EARLY], # Code from module utimens: # Code from module verify: # Code from module warnings: + # Code from module xalloc-oversized: ]) # This macro should be invoked from ./configure.ac, in the section @@ -160,6 +167,14 @@ AC_DEFUN([gl_INIT], gl_UNISTD_MODULE_INDICATOR([environ]) gl_EXECINFO_H AC_REQUIRE([gl_EXTERN_INLINE]) + gl_FUNC_FACCESSAT + if test $HAVE_FACCESSAT = 0; then + AC_LIBOBJ([faccessat]) + gl_PREREQ_FACCESSAT + fi + gl_MODULE_INDICATOR([faccessat]) + gl_UNISTD_MODULE_INDICATOR([faccessat]) + gl_FCNTL_H gl_FILEMODE gl_FUNC_FPENDING if test $ac_cv_func___fpending = no; then @@ -278,18 +293,53 @@ AC_DEFUN([gl_INIT], gl_UNISTD_H gl_UTIMENS gl_gnulib_enabled_dosname=false + gl_gnulib_enabled_euidaccess=false + gl_gnulib_enabled_getgroups=false gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false + gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false gl_gnulib_enabled_pathmax=false + gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false gl_gnulib_enabled_stat=false gl_gnulib_enabled_strtoll=false gl_gnulib_enabled_strtoull=false gl_gnulib_enabled_verify=false + gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false func_gl_gnulib_m4code_dosname () { if ! $gl_gnulib_enabled_dosname; then gl_gnulib_enabled_dosname=true fi } + func_gl_gnulib_m4code_euidaccess () + { + if ! $gl_gnulib_enabled_euidaccess; then + gl_FUNC_EUIDACCESS + if test $HAVE_EUIDACCESS = 0; then + AC_LIBOBJ([euidaccess]) + gl_PREREQ_EUIDACCESS + fi + gl_UNISTD_MODULE_INDICATOR([euidaccess]) + gl_gnulib_enabled_euidaccess=true + if test $HAVE_EUIDACCESS = 0; then + func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1 + fi + func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c + if test $HAVE_EUIDACCESS = 0; then + func_gl_gnulib_m4code_stat + fi + fi + } + func_gl_gnulib_m4code_getgroups () + { + if ! $gl_gnulib_enabled_getgroups; then + gl_FUNC_GETGROUPS + if test $HAVE_GETGROUPS = 0 || test $REPLACE_GETGROUPS = 1; then + AC_LIBOBJ([getgroups]) + fi + gl_UNISTD_MODULE_INDICATOR([getgroups]) + gl_gnulib_enabled_getgroups=true + fi + } func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 () { if ! $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then @@ -298,6 +348,24 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true fi } + func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1 () + { + if ! $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then + gl_FUNC_GROUP_MEMBER + if test $HAVE_GROUP_MEMBER = 0; then + AC_LIBOBJ([group-member]) + gl_PREREQ_GROUP_MEMBER + fi + gl_UNISTD_MODULE_INDICATOR([group-member]) + gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=true + if test $HAVE_GROUP_MEMBER = 0; then + func_gl_gnulib_m4code_getgroups + fi + if test $HAVE_GROUP_MEMBER = 0; then + func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec + fi + fi + } func_gl_gnulib_m4code_pathmax () { if ! $gl_gnulib_enabled_pathmax; then @@ -305,6 +373,12 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_pathmax=true fi } + func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c () + { + if ! $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then + gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=true + fi + } func_gl_gnulib_m4code_stat () { if ! $gl_gnulib_enabled_stat; then @@ -356,6 +430,18 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_verify=true fi } + func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec () + { + if ! $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then + gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=true + fi + } + if test $HAVE_FACCESSAT = 0; then + func_gl_gnulib_m4code_dosname + fi + if test $HAVE_FACCESSAT = 0; then + func_gl_gnulib_m4code_euidaccess + fi if test $REPLACE_GETOPT = 1; then func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 fi @@ -382,12 +468,17 @@ AC_DEFUN([gl_INIT], fi m4_pattern_allow([^gl_GNULIB_ENABLED_]) AM_CONDITIONAL([gl_GNULIB_ENABLED_dosname], [$gl_gnulib_enabled_dosname]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_euidaccess], [$gl_gnulib_enabled_euidaccess]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_getgroups], [$gl_gnulib_enabled_getgroups]) AM_CONDITIONAL([gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36], [$gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1], [$gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1]) AM_CONDITIONAL([gl_GNULIB_ENABLED_pathmax], [$gl_gnulib_enabled_pathmax]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c]) AM_CONDITIONAL([gl_GNULIB_ENABLED_stat], [$gl_gnulib_enabled_stat]) AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll]) AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoull], [$gl_gnulib_enabled_strtoull]) AM_CONDITIONAL([gl_GNULIB_ENABLED_verify], [$gl_gnulib_enabled_verify]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec], [$gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec]) # End of code from modules m4_ifval(gl_LIBSOURCES_LIST, [ m4_syscmd([test ! -d ]m4_defn([gl_LIBSOURCES_DIR])[ || @@ -536,6 +627,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/alloca.in.h lib/allocator.c lib/allocator.h + lib/at-func.c lib/c-ctype.c lib/c-ctype.h lib/c-strcase.h @@ -549,14 +641,18 @@ AC_DEFUN([gl_FILE_LIST], [ lib/dtoastr.c lib/dtotimespec.c lib/dup2.c + lib/euidaccess.c lib/execinfo.c lib/execinfo.in.h + lib/faccessat.c + lib/fcntl.in.h lib/filemode.c lib/filemode.h lib/fpending.c lib/fpending.h lib/ftoastr.c lib/ftoastr.h + lib/getgroups.c lib/getloadavg.c lib/getopt.c lib/getopt.in.h @@ -565,6 +661,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/gettext.h lib/gettime.c lib/gettimeofday.c + lib/group-member.c lib/ignore-value.h lib/intprops.h lib/inttypes.in.h @@ -577,6 +674,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/pselect.c lib/pthread_sigmask.c lib/readlink.c + lib/root-uid.h lib/sha1.c lib/sha1.h lib/sha256.c @@ -618,6 +716,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/utimens.c lib/utimens.h lib/verify.h + lib/xalloc-oversized.h m4/00gnulib.m4 m4/alloca.m4 m4/c-strtod.m4 @@ -625,16 +724,22 @@ AC_DEFUN([gl_FILE_LIST], [ m4/close-stream.m4 m4/dup2.m4 m4/environ.m4 + m4/euidaccess.m4 m4/execinfo.m4 m4/extensions.m4 m4/extern-inline.m4 + m4/faccessat.m4 + m4/fcntl-o.m4 + m4/fcntl_h.m4 m4/filemode.m4 m4/fpending.m4 + m4/getgroups.m4 m4/getloadavg.m4 m4/getopt.m4 m4/gettime.m4 m4/gettimeofday.m4 m4/gnulib-common.m4 + m4/group-member.m4 m4/include_next.m4 m4/inttypes.m4 m4/largefile.m4 diff --git a/m4/group-member.m4 b/m4/group-member.m4 new file mode 100644 index 00000000000..c393b5b1303 --- /dev/null +++ b/m4/group-member.m4 @@ -0,0 +1,29 @@ +# serial 14 + +# Copyright (C) 1999-2001, 2003-2007, 2009-2012 Free Software Foundation, Inc. + +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +dnl Written by Jim Meyering + +AC_DEFUN([gl_FUNC_GROUP_MEMBER], +[ + AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) + + dnl Persuade glibc to declare group_member(). + AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) + + dnl Do this replacement check manually because I want the hyphen + dnl (not the underscore) in the filename. + AC_CHECK_FUNC([group_member], , [ + HAVE_GROUP_MEMBER=0 + ]) +]) + +# Prerequisites of lib/group-member.c. +AC_DEFUN([gl_PREREQ_GROUP_MEMBER], +[ + AC_REQUIRE([AC_FUNC_GETGROUPS]) +]) diff --git a/nt/ChangeLog b/nt/ChangeLog index 931cb745c8b..320c9e6366e 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,10 @@ +2012-11-14 Paul Eggert + + Use faccessat, not access, when checking file permissions (Bug#12632). + * inc/ms-w32.h (AT_FDCWD, AT_EACCESS): New symbols. + (access): Remove. + (faccessat): New macro. + 2012-11-05 Eli Zaretskii * inc/unistd.h (tcgetpgrp, setsid): Provide prototypes. diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index dd2ae781cb8..0f6b51d3915 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -124,6 +124,10 @@ extern char *getenv (); #define MAXPATHLEN _MAX_PATH #endif +/* Use values compatible with gnulib, as there's no reason to differ. */ +#define AT_FDCWD (-3041965) +#define AT_EACCESS 4 + #ifdef HAVE_NTGUI #define HAVE_WINDOW_SYSTEM 1 #define HAVE_MENUS 1 @@ -145,8 +149,6 @@ extern char *getenv (); #endif /* Calls that are emulated or shadowed. */ -#undef access -#define access sys_access #undef chdir #define chdir sys_chdir #undef chmod @@ -161,6 +163,7 @@ extern char *getenv (); #define dup sys_dup #undef dup2 #define dup2 sys_dup2 +#define faccessat sys_faccessat #define fopen sys_fopen #define link sys_link #define localtime sys_localtime diff --git a/src/ChangeLog b/src/ChangeLog index 1d94cef6577..a6b42e8a58c 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,70 @@ +2012-11-14 Paul Eggert + + Use faccessat, not access, when checking file permissions (Bug#12632). + This fixes a bug that has been present in Emacs since its creation. + It was reported by Chris Torek in 1983 even before GNU Emacs existed, + which must set some sort of record. (Torek's bug report was against + a predecessor of GNU Emacs, but GNU Emacs happened to have the + same common flaw.) See Torek's Usenet posting + "setuid/setgid programs & Emacs" Article-I.D.: sri-arpa.858 + Posted: Fri Apr 8 14:18:56 1983. + * Makefile.in (LIB_EACCESS): New macro. + (LIBES): Use it. + * callproc.c (init_callproc): + * charset.c (init_charset): + * fileio.c (check_existing, check_executable, check_writable) + (Ffile_readable_p): + * lread.c (openp, load_path_check): + * process.c (allocate_pty): + * xrdb.c (file_p): + Use effective UID when checking permissions, not real UID. + * callproc.c (init_callproc): + * charset.c (init_charset): + * lread.c (load_path_check, init_lread): + Test whether directories are accessible, not merely whether they exist. + * conf_post.h (GNULIB_SUPPORT_ONLY_AT_FDCWD): New macro. + * fileio.c (check_existing, check_executable, check_writable) + (Ffile_readable_p): + Use symbolic names instead of integers for the flags, as they're + portable now. + (check_writable): New arg AMODE. All uses changed. + Set errno on failure. + (Ffile_readable_p): Use faccessat, not stat + open + close. + (Ffile_writable_p): No need to call check_existing + check_writable. + Just call check_writable and then look at errno. This saves a syscall. + dir should never be nil; replace an unnecessary runtime check + with an eassert. When checking the parent directory of a nonexistent + file, check that the directory is searchable as well as writable, as + we can't create files in unsearchable directories. + (file_directory_p): New function, which uses 'stat' on most platforms + but faccessat with D_OK (for efficiency) if WINDOWSNT. + (Ffile_directory_p, Fset_file_times): Use it. + (file_accessible_directory_p): New function, which uses a single + syscall for efficiency. + (Ffile_accessible_directory_p): Use it. + * xrdb.c (file_p): Use file_directory_p. + * lisp.h (file_directory_p, file_accessible_directory_p): New decls. + * lread.c (openp): When opening a file, use fstat rather than + stat, as that avoids a permissions race. When not opening a file, + use file_directory_p rather than stat. + (dir_warning): First arg is now a usage string, not a format. + Use errno. All uses changed. + * nsterm.m (ns_term_init): Remove unnecessary call to file-readable + that merely introduced a race. + * process.c, sysdep.c, term.c: All uses of '#ifdef O_NONBLOCK' + changed to '#if O_NONBLOCK', to accommodate gnulib O_* style, + and similarly for the other O_* flags. + * w32.c (sys_faccessat): Rename from sys_access and switch to + faccessat's API. All uses changed. + * xrdb.c: Do not include ; no longer needed. + (magic_db): Rename from magic_file_p. + (magic_db, search_magic_path): Return an XrmDatabase rather than a + char *, so that we don't have to test for file existence + separately from opening the file for reading. This removes a race + fixes a permission-checking problem, and simplifies the code. + All uses changed. + (file_p): Remove; no longer needed. + 2012-11-13 Dmitry Antipov Omit glyphs initialization at startup. diff --git a/src/Makefile.in b/src/Makefile.in index c24e421bbbc..d034ad04796 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -150,6 +150,7 @@ M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@ M17N_FLT_LIBS = @M17N_FLT_LIBS@ LIB_CLOCK_GETTIME=@LIB_CLOCK_GETTIME@ +LIB_EACCESS=@LIB_EACCESS@ LIB_TIMER_TIME=@LIB_TIMER_TIME@ DBUS_CFLAGS = @DBUS_CFLAGS@ @@ -392,7 +393,7 @@ otherobj= $(TERMCAP_OBJ) $(PRE_ALLOC_OBJ) $(GMALLOC_OBJ) $(RALLOC_OBJ) \ LIBES = $(LIBS) $(W32_LIBS) $(LIBX_BASE) $(LIBIMAGE) \ $(LIBX_OTHER) $(LIBSOUND) \ $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_CLOCK_GETTIME) \ - $(LIB_TIMER_TIME) $(DBUS_LIBS) \ + $(LIB_EACCESS) $(LIB_TIMER_TIME) $(DBUS_LIBS) \ $(LIB_EXECINFO) \ $(LIBXML2_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ diff --git a/src/callproc.c b/src/callproc.c index c7bbe36e605..8ecaba2b408 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1576,15 +1576,13 @@ init_callproc (void) #endif { tempdir = Fdirectory_file_name (Vexec_directory); - if (access (SSDATA (tempdir), 0) < 0) - dir_warning ("Warning: arch-dependent data dir (%s) does not exist.\n", - Vexec_directory); + if (! file_accessible_directory_p (SSDATA (tempdir))) + dir_warning ("arch-dependent data dir", Vexec_directory); } tempdir = Fdirectory_file_name (Vdata_directory); - if (access (SSDATA (tempdir), 0) < 0) - dir_warning ("Warning: arch-independent data dir (%s) does not exist.\n", - Vdata_directory); + if (! file_accessible_directory_p (SSDATA (tempdir))) + dir_warning ("arch-independent data dir", Vdata_directory); sh = (char *) getenv ("SHELL"); Vshell_file_name = build_string (sh ? sh : "/bin/sh"); @@ -1593,7 +1591,7 @@ init_callproc (void) Vshared_game_score_directory = Qnil; #else Vshared_game_score_directory = build_string (PATH_GAME); - if (NILP (Ffile_directory_p (Vshared_game_score_directory))) + if (NILP (Ffile_accessible_directory_p (Vshared_game_score_directory))) Vshared_game_score_directory = Qnil; #endif } diff --git a/src/charset.c b/src/charset.c index 6b999824dab..c9133c780e8 100644 --- a/src/charset.c +++ b/src/charset.c @@ -2293,7 +2293,7 @@ init_charset (void) { Lisp_Object tempdir; tempdir = Fexpand_file_name (build_string ("charsets"), Vdata_directory); - if (access (SSDATA (tempdir), 0) < 0) + if (! file_accessible_directory_p (SSDATA (tempdir))) { /* This used to be non-fatal (dir_warning), but it should not happen, and if it does sooner or later it will cause some diff --git a/src/conf_post.h b/src/conf_post.h index 66390ddf103..b1997e79081 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -178,6 +178,10 @@ extern void _DebPrint (const char *fmt, ...); #endif #endif +/* Tell gnulib to omit support for openat-related functions having a + first argument other than AT_FDCWD. */ +#define GNULIB_SUPPORT_ONLY_AT_FDCWD + #include #include diff --git a/src/fileio.c b/src/fileio.c index b9541e78838..572f6d8ef83 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2425,15 +2425,7 @@ On Unix, this is a name starting with a `/' or a `~'. */) bool check_existing (const char *filename) { -#ifdef DOS_NT - /* The full emulation of Posix 'stat' is too expensive on - DOS/Windows, when all we want to know is whether the file exists. - So we use 'access' instead, which is much more lightweight. */ - return (access (filename, F_OK) >= 0); -#else - struct stat st; - return (stat (filename, &st) >= 0); -#endif + return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0; } /* Return true if file FILENAME exists and can be executed. */ @@ -2441,56 +2433,40 @@ check_existing (const char *filename) static bool check_executable (char *filename) { -#ifdef DOS_NT - struct stat st; - if (stat (filename, &st) < 0) - return 0; - return ((st.st_mode & S_IEXEC) != 0); -#else /* not DOS_NT */ -#ifdef HAVE_EUIDACCESS - return (euidaccess (filename, 1) >= 0); -#else - /* Access isn't quite right because it uses the real uid - and we really want to test with the effective uid. - But Unix doesn't give us a right way to do it. */ - return (access (filename, 1) >= 0); -#endif -#endif /* not DOS_NT */ + return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0; } -/* Return true if file FILENAME exists and can be written. */ +/* Return true if file FILENAME exists and can be accessed + according to AMODE, which should include W_OK. + On failure, return false and set errno. */ static bool -check_writable (const char *filename) +check_writable (const char *filename, int amode) { #ifdef MSDOS + /* FIXME: an faccessat implementation should be added to the + DOS/Windows ports and this #ifdef branch should be removed. */ struct stat st; if (stat (filename, &st) < 0) return 0; + errno = EPERM; return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode)); #else /* not MSDOS */ -#ifdef HAVE_EUIDACCESS - bool res = (euidaccess (filename, 2) >= 0); + bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0; #ifdef CYGWIN - /* euidaccess may have returned failure because Cygwin couldn't + /* faccessat may have returned failure because Cygwin couldn't determine the file's UID or GID; if so, we return success. */ if (!res) { + int faccessat_errno = errno; struct stat st; if (stat (filename, &st) < 0) return 0; res = (st.st_uid == -1 || st.st_gid == -1); + errno = faccessat_errno; } #endif /* CYGWIN */ return res; -#else /* not HAVE_EUIDACCESS */ - /* Access isn't quite right because it uses the real uid - and we really want to test with the effective uid. - But Unix doesn't give us a right way to do it. - Opening with O_WRONLY could work for an ordinary file, - but would lose for directories. */ - return (access (filename, 2) >= 0); -#endif /* not HAVE_EUIDACCESS */ #endif /* not MSDOS */ } @@ -2547,9 +2523,6 @@ See also `file-exists-p' and `file-attributes'. */) { Lisp_Object absname; Lisp_Object handler; - int desc; - int flags; - struct stat statbuf; CHECK_STRING (filename); absname = Fexpand_file_name (filename, Qnil); @@ -2561,35 +2534,10 @@ See also `file-exists-p' and `file-attributes'. */) return call2 (handler, Qfile_readable_p, absname); absname = ENCODE_FILE (absname); - -#if defined (DOS_NT) || defined (macintosh) - /* Under MS-DOS, Windows, and Macintosh, open does not work for - directories. */ - if (access (SDATA (absname), 0) == 0) - return Qt; - return Qnil; -#else /* not DOS_NT and not macintosh */ - flags = O_RDONLY; -#ifdef O_NONBLOCK - /* Opening a fifo without O_NONBLOCK can wait. - We don't want to wait. But we don't want to mess wth O_NONBLOCK - except in the case of a fifo, on a system which handles it. */ - desc = stat (SSDATA (absname), &statbuf); - if (desc < 0) - return Qnil; - if (S_ISFIFO (statbuf.st_mode)) - flags |= O_NONBLOCK; -#endif - desc = emacs_open (SSDATA (absname), flags, 0); - if (desc < 0) - return Qnil; - emacs_close (desc); - return Qt; -#endif /* not DOS_NT and not macintosh */ + return (faccessat (AT_FDCWD, SSDATA (absname), R_OK, AT_EACCESS) == 0 + ? Qt : Qnil); } -/* Having this before file-symlink-p mysteriously caused it to be forgotten - on the RT/PC. */ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, doc: /* Return t if file FILENAME can be written or created by you. */) (Lisp_Object filename) @@ -2607,14 +2555,15 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, return call2 (handler, Qfile_writable_p, absname); encoded = ENCODE_FILE (absname); - if (check_existing (SSDATA (encoded))) - return (check_writable (SSDATA (encoded)) - ? Qt : Qnil); + if (check_writable (SSDATA (encoded), W_OK)) + return Qt; + if (errno != ENOENT) + return Qnil; dir = Ffile_name_directory (absname); + eassert (!NILP (dir)); #ifdef MSDOS - if (!NILP (dir)) - dir = Fdirectory_file_name (dir); + dir = Fdirectory_file_name (dir); #endif /* MSDOS */ dir = ENCODE_FILE (dir); @@ -2622,10 +2571,9 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, /* The read-only attribute of the parent directory doesn't affect whether a file or directory can be created within it. Some day we should check ACLs though, which do affect this. */ - return (access (SDATA (dir), D_OK) < 0) ? Qnil : Qt; + return file_directory_p (SDATA (dir)) ? Qt : Qnil; #else - return (check_writable (!NILP (dir) ? SSDATA (dir) : "") - ? Qt : Qnil); + return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil; #endif } @@ -2703,8 +2651,7 @@ Symbolic links to directories count as directories. See `file-symlink-p' to distinguish symlinks. */) (Lisp_Object filename) { - register Lisp_Object absname; - struct stat st; + Lisp_Object absname; Lisp_Object handler; absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); @@ -2717,9 +2664,20 @@ See `file-symlink-p' to distinguish symlinks. */) absname = ENCODE_FILE (absname); - if (stat (SSDATA (absname), &st) < 0) - return Qnil; - return S_ISDIR (st.st_mode) ? Qt : Qnil; + return file_directory_p (SSDATA (absname)) ? Qt : Qnil; +} + +/* Return true if FILE is a directory or a symlink to a directory. */ +bool +file_directory_p (char const *file) +{ +#ifdef WINDOWSNT + /* This is cheaper than 'stat'. */ + return faccessat (AT_FDCWD, file, D_OK, AT_EACCESS) == 0; +#else + struct stat st; + return stat (file, &st) == 0 && S_ISDIR (st.st_mode); +#endif } DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, @@ -2733,21 +2691,65 @@ if the directory so specified exists and really is a readable and searchable directory. */) (Lisp_Object filename) { + Lisp_Object absname; Lisp_Object handler; - bool tem; - struct gcpro gcpro1; + + CHECK_STRING (filename); + absname = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p); + handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p); if (!NILP (handler)) - return call2 (handler, Qfile_accessible_directory_p, filename); + return call2 (handler, Qfile_accessible_directory_p, absname); - GCPRO1 (filename); - tem = (NILP (Ffile_directory_p (filename)) - || NILP (Ffile_executable_p (filename))); - UNGCPRO; - return tem ? Qnil : Qt; + absname = ENCODE_FILE (absname); + return file_accessible_directory_p (SSDATA (absname)) ? Qt : Qnil; +} + +/* If FILE is a searchable directory or a symlink to a + searchable directory, return true. Otherwise return + false and set errno to an error number. */ +bool +file_accessible_directory_p (char const *file) +{ +#ifdef DOS_NT + /* There's no need to test whether FILE is searchable, as the + searchable/executable bit is invented on DOS_NT platforms. */ + return file_directory_p (file); +#else + /* On POSIXish platforms, use just one system call; this avoids a + race and is typically faster. */ + ptrdiff_t len = strlen (file); + char const *dir; + bool ok; + int saved_errno; + USE_SAFE_ALLOCA; + + /* Normally a file "FOO" is an accessible directory if "FOO/." exists. + There are three exceptions: "", "/", and "//". Leave "" alone, + as it's invalid. Append only "." to the other two exceptions as + "/" and "//" are distinct on some platforms, whereas "/", "///", + "////", etc. are all equivalent. */ + if (! len) + dir = file; + else + { + /* Just check for trailing '/' when deciding whether to append '/'. + That's simpler than testing the two special cases "/" and "//", + and it's a safe optimization here. */ + char *buf = SAFE_ALLOCA (len + 3); + memcpy (buf, file, len); + strcpy (buf + len, "/." + (file[len - 1] == '/')); + dir = buf; + } + + ok = check_existing (dir); + saved_errno = errno; + SAFE_FREE (); + errno = saved_errno; + return ok; +#endif } DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0, @@ -3044,10 +3046,8 @@ Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of if (set_file_times (-1, SSDATA (encoded_absname), t, t)) { #ifdef MSDOS - struct stat st; - /* Setting times on a directory always fails. */ - if (stat (SSDATA (encoded_absname), &st) == 0 && S_ISDIR (st.st_mode)) + if (file_directory_p (SSDATA (encoded_absname))) return Qnil; #endif report_file_error ("Setting file times", Fcons (absname, Qnil)); diff --git a/src/lisp.h b/src/lisp.h index 72e38fa4653..67ae28a488f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3202,6 +3202,8 @@ extern Lisp_Object close_file_unwind (Lisp_Object); extern Lisp_Object restore_point_unwind (Lisp_Object); extern _Noreturn void report_file_error (const char *, Lisp_Object); extern void internal_delete_file (Lisp_Object); +extern bool file_directory_p (const char *); +extern bool file_accessible_directory_p (const char *); extern void syms_of_fileio (void); extern Lisp_Object make_temp_name (Lisp_Object, bool); extern Lisp_Object Qdelete_file; diff --git a/src/lread.c b/src/lread.c index 3a82e0057e2..5859a2f85a9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1403,7 +1403,7 @@ Returns the file's name in absolute form, or nil if not found. If SUFFIXES is non-nil, it should be a list of suffixes to append to file name when searching. If non-nil, PREDICATE is used instead of `file-readable-p'. -PREDICATE can also be an integer to pass to the access(2) function, +PREDICATE can also be an integer to pass to the faccessat(2) function, in which case file-name-handlers are ignored. This function will normally skip directories, so if you want it to find directories, make sure the PREDICATE function returns `dir-ok' for them. */) @@ -1441,7 +1441,6 @@ static Lisp_Object Qdir_ok; int openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate) { - int fd; ptrdiff_t fn_size = 100; char buf[100]; char *fn = buf; @@ -1496,7 +1495,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto { ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail)); Lisp_Object handler; - bool exists; /* Concatenate path element/specified name with the suffix. If the directory starts with /:, remove that. */ @@ -1520,6 +1518,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto handler = Ffind_file_name_handler (string, Qfile_exists_p); if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate)) { + bool exists; if (NILP (predicate)) exists = !NILP (Ffile_readable_p (string)); else @@ -1541,37 +1540,40 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto } else { -#ifndef WINDOWSNT - struct stat st; -#endif + int fd; const char *pfn; encoded_fn = ENCODE_FILE (string); pfn = SSDATA (encoded_fn); -#ifdef WINDOWSNT - exists = access (pfn, F_OK) == 0 && access (pfn, D_OK) < 0; -#else - exists = (stat (pfn, &st) == 0 && ! S_ISDIR (st.st_mode)); -#endif - if (exists) - { - /* Check that we can access or open it. */ - if (NATNUMP (predicate)) - fd = (((XFASTINT (predicate) & ~INT_MAX) == 0 - && access (pfn, XFASTINT (predicate)) == 0) - ? 1 : -1); - else - fd = emacs_open (pfn, O_RDONLY, 0); - if (fd >= 0) + /* Check that we can access or open it. */ + if (NATNUMP (predicate)) + fd = (((XFASTINT (predicate) & ~INT_MAX) == 0 + && (faccessat (AT_FDCWD, pfn, XFASTINT (predicate), + AT_EACCESS) + == 0) + && ! file_directory_p (pfn)) + ? 1 : -1); + else + { + struct stat st; + fd = emacs_open (pfn, O_RDONLY, 0); + if (0 <= fd + && (fstat (fd, &st) != 0 || S_ISDIR (st.st_mode))) { - /* We succeeded; return this descriptor and filename. */ - if (storeptr) - *storeptr = string; - UNGCPRO; - return fd; + emacs_close (fd); + fd = -1; } } + + if (fd >= 0) + { + /* We succeeded; return this descriptor and filename. */ + if (storeptr) + *storeptr = string; + UNGCPRO; + return fd; + } } } if (absolute) @@ -4087,9 +4089,8 @@ load_path_check (void) if (STRINGP (dirfile)) { dirfile = Fdirectory_file_name (dirfile); - if (access (SSDATA (dirfile), 0) < 0) - dir_warning ("Warning: Lisp directory `%s' does not exist.\n", - XCAR (path_tail)); + if (! file_accessible_directory_p (SSDATA (dirfile))) + dir_warning ("Lisp directory", XCAR (path_tail)); } } } @@ -4201,11 +4202,11 @@ init_lread (void) Lisp_Object tem, tem1; /* Add to the path the lisp subdir of the installation - dir, if it exists. Note: in out-of-tree builds, + dir, if it is accessible. Note: in out-of-tree builds, this directory is empty save for Makefile. */ tem = Fexpand_file_name (build_string ("lisp"), Vinstallation_directory); - tem1 = Ffile_exists_p (tem); + tem1 = Ffile_accessible_directory_p (tem); if (!NILP (tem1)) { if (NILP (Fmember (tem, Vload_path))) @@ -4222,10 +4223,10 @@ init_lread (void) Lisp dirs instead. */ Vload_path = nconc2 (Vload_path, dump_path); - /* Add leim under the installation dir, if it exists. */ + /* Add leim under the installation dir, if it is accessible. */ tem = Fexpand_file_name (build_string ("leim"), Vinstallation_directory); - tem1 = Ffile_exists_p (tem); + tem1 = Ffile_accessible_directory_p (tem); if (!NILP (tem1)) { if (NILP (Fmember (tem, Vload_path))) @@ -4237,7 +4238,7 @@ init_lread (void) { tem = Fexpand_file_name (build_string ("site-lisp"), Vinstallation_directory); - tem1 = Ffile_exists_p (tem); + tem1 = Ffile_accessible_directory_p (tem); if (!NILP (tem1)) { if (NILP (Fmember (tem, Vload_path))) @@ -4282,7 +4283,7 @@ init_lread (void) { tem = Fexpand_file_name (build_string ("site-lisp"), Vsource_directory); - tem1 = Ffile_exists_p (tem); + tem1 = Ffile_accessible_directory_p (tem); if (!NILP (tem1)) { if (NILP (Fmember (tem, Vload_path))) @@ -4338,21 +4339,28 @@ init_lread (void) Vloads_in_progress = Qnil; } -/* Print a warning, using format string FORMAT, that directory DIRNAME - does not exist. Print it on stderr and put it in *Messages*. */ +/* Print a warning that directory intended for use USE and with name + DIRNAME cannot be accessed. On entry, errno should correspond to + the access failure. Print the warning on stderr and put it in + *Messages*. */ void -dir_warning (const char *format, Lisp_Object dirname) +dir_warning (char const *use, Lisp_Object dirname) { - fprintf (stderr, format, SDATA (dirname)); + static char const format[] = "Warning: %s `%s': %s\n"; + int access_errno = errno; + fprintf (stderr, format, use, SSDATA (dirname), strerror (access_errno)); /* Don't log the warning before we've initialized!! */ if (initialized) { + char const *diagnostic = emacs_strerror (access_errno); USE_SAFE_ALLOCA; - char *buffer = SAFE_ALLOCA (SBYTES (dirname) - + strlen (format) - (sizeof "%s" - 1) + 1); - ptrdiff_t message_len = esprintf (buffer, format, SDATA (dirname)); + char *buffer = SAFE_ALLOCA (sizeof format - 3 * (sizeof "%s" - 1) + + strlen (use) + SBYTES (dirname) + + strlen (diagnostic)); + ptrdiff_t message_len = esprintf (buffer, format, use, SSDATA (dirname), + diagnostic); message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname)); SAFE_FREE (); } diff --git a/src/nsterm.m b/src/nsterm.m index 7ba1608268b..804ab825dee 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -4112,8 +4112,6 @@ ns_term_init (Lisp_Object display_name) color_file = Fexpand_file_name (build_string ("rgb.txt"), Fsymbol_value (intern ("data-directory"))); - if (NILP (Ffile_readable_p (color_file))) - fatal ("Could not find %s.\n", SDATA (color_file)); color_map = Fx_load_color_file (color_file); if (NILP (color_map)) diff --git a/src/process.c b/src/process.c index 43f0239d301..728abebe758 100644 --- a/src/process.c +++ b/src/process.c @@ -208,7 +208,7 @@ static EMACS_INT update_tick; #ifndef NON_BLOCKING_CONNECT #ifdef HAVE_SELECT #if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX) -#if defined (O_NONBLOCK) || defined (O_NDELAY) +#if O_NONBLOCK || O_NDELAY #if defined (EWOULDBLOCK) || defined (EINPROGRESS) #define NON_BLOCKING_CONNECT #endif /* EWOULDBLOCK || EINPROGRESS */ @@ -655,7 +655,7 @@ allocate_pty (void) PTY_OPEN; #else /* no PTY_OPEN */ { -# ifdef O_NONBLOCK +# if O_NONBLOCK fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0); # else fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0); @@ -672,7 +672,7 @@ allocate_pty (void) #else sprintf (pty_name, "/dev/tty%c%x", c, i); #endif /* no PTY_TTY_NAME_SPRINTF */ - if (access (pty_name, 6) != 0) + if (faccessat (AT_FDCWD, pty_name, R_OK | W_OK, AT_EACCESS) != 0) { emacs_close (fd); # ifndef __sgi @@ -1624,7 +1624,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) #if ! defined (USG) || defined (USG_SUBTTY_WORKS) /* On most USG systems it does not work to open the pty's tty here, then close it and reopen it in the child. */ -#ifdef O_NOCTTY +#if O_NOCTTY /* Don't let this terminal become our controlling terminal (in case we don't have one). */ forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0); @@ -1678,11 +1678,11 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) } #endif -#ifdef O_NONBLOCK +#if O_NONBLOCK fcntl (inchannel, F_SETFL, O_NONBLOCK); fcntl (outchannel, F_SETFL, O_NONBLOCK); #else -#ifdef O_NDELAY +#if O_NDELAY fcntl (inchannel, F_SETFL, O_NDELAY); fcntl (outchannel, F_SETFL, O_NDELAY); #endif @@ -1943,7 +1943,7 @@ create_pty (Lisp_Object process) #if ! defined (USG) || defined (USG_SUBTTY_WORKS) /* On most USG systems it does not work to open the pty's tty here, then close it and reopen it in the child. */ -#ifdef O_NOCTTY +#if O_NOCTTY /* Don't let this terminal become our controlling terminal (in case we don't have one). */ int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0); @@ -1963,11 +1963,11 @@ create_pty (Lisp_Object process) } #endif /* HAVE_PTYS */ -#ifdef O_NONBLOCK +#if O_NONBLOCK fcntl (inchannel, F_SETFL, O_NONBLOCK); fcntl (outchannel, F_SETFL, O_NONBLOCK); #else -#ifdef O_NDELAY +#if O_NDELAY fcntl (inchannel, F_SETFL, O_NDELAY); fcntl (outchannel, F_SETFL, O_NDELAY); #endif @@ -2927,7 +2927,7 @@ usage: (make-network-process &rest ARGS) */) { /* Don't support network sockets when non-blocking mode is not available, since a blocked Emacs is not useful. */ -#if !defined (O_NONBLOCK) && !defined (O_NDELAY) +#if !O_NONBLOCK && !O_NDELAY error ("Network servers not supported"); #else is_server = 1; @@ -3193,7 +3193,7 @@ usage: (make-network-process &rest ARGS) */) #ifdef NON_BLOCKING_CONNECT if (is_non_blocking_client) { -#ifdef O_NONBLOCK +#if O_NONBLOCK ret = fcntl (s, F_SETFL, O_NONBLOCK); #else ret = fcntl (s, F_SETFL, O_NDELAY); @@ -3410,10 +3410,10 @@ usage: (make-network-process &rest ARGS) */) chan_process[inch] = proc; -#ifdef O_NONBLOCK +#if O_NONBLOCK fcntl (inch, F_SETFL, O_NONBLOCK); #else -#ifdef O_NDELAY +#if O_NDELAY fcntl (inch, F_SETFL, O_NDELAY); #endif #endif @@ -4145,10 +4145,10 @@ server_accept_connection (Lisp_Object server, int channel) chan_process[s] = proc; -#ifdef O_NONBLOCK +#if O_NONBLOCK fcntl (s, F_SETFL, O_NONBLOCK); #else -#ifdef O_NDELAY +#if O_NDELAY fcntl (s, F_SETFL, O_NDELAY); #endif #endif @@ -4849,11 +4849,11 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, #endif /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK, and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */ -#ifdef O_NONBLOCK +#if O_NONBLOCK else if (nread == -1 && errno == EAGAIN) ; #else -#ifdef O_NDELAY +#if O_NDELAY else if (nread == -1 && errno == EAGAIN) ; /* Note that we cannot distinguish between no input @@ -7348,7 +7348,7 @@ init_process_emacs (void) #ifdef HAVE_GETSOCKNAME ADD_SUBFEATURE (QCservice, Qt); #endif -#if defined (O_NONBLOCK) || defined (O_NDELAY) +#if O_NONBLOCK || O_NDELAY ADD_SUBFEATURE (QCserver, Qt); #endif diff --git a/src/sysdep.c b/src/sysdep.c index aa9d0f38c3c..a7f3de2f1b1 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1287,7 +1287,7 @@ reset_sys_modes (struct tty_display_info *tty_out) old_fcntl_owner[fileno (tty_out->input)]); } #endif /* F_SETOWN */ -#ifdef O_NDELAY +#if O_NDELAY fcntl (fileno (tty_out->input), F_SETFL, fcntl (fileno (tty_out->input), F_GETFL, 0) & ~O_NDELAY); #endif @@ -2384,12 +2384,12 @@ serial_open (char *port) fd = emacs_open ((char*) port, O_RDWR -#ifdef O_NONBLOCK +#if O_NONBLOCK | O_NONBLOCK #else | O_NDELAY #endif -#ifdef O_NOCTTY +#if O_NOCTTY | O_NOCTTY #endif , 0); diff --git a/src/term.c b/src/term.c index 578c701858f..96549290da5 100644 --- a/src/term.c +++ b/src/term.c @@ -2992,7 +2992,7 @@ init_tty (const char *name, const char *terminal_type, int must_succeed) int fd; FILE *file; -#ifdef O_IGNORE_CTTY +#if O_IGNORE_CTTY if (!ctty) /* Open the terminal device. Don't recognize it as our controlling terminal, and don't make it the controlling tty @@ -3023,7 +3023,7 @@ init_tty (const char *name, const char *terminal_type, int must_succeed) name); } -#ifndef O_IGNORE_CTTY +#if !O_IGNORE_CTTY if (!ctty) dissociate_if_controlling_tty (fd); #endif diff --git a/src/w32.c b/src/w32.c index 5ac1bc3eb7c..0e7da449b81 100644 --- a/src/w32.c +++ b/src/w32.c @@ -1597,7 +1597,7 @@ init_environment (char ** argv) see if it succeeds. But I think that's too much to ask. */ /* MSVCRT's _access crashes with D_OK. */ - if (tmp && sys_access (tmp, D_OK) == 0) + if (tmp && sys_faccessat (AT_FDCWD, tmp, D_OK, AT_EACCESS) == 0) { char * var = alloca (strlen (tmp) + 8); sprintf (var, "TMPDIR=%s", tmp); @@ -2714,10 +2714,16 @@ logon_network_drive (const char *path) long file names. */ int -sys_access (const char * path, int mode) +sys_faccessat (int dirfd, const char * path, int mode, int flags) { DWORD attributes; + if (dirfd != AT_FDCWD) + { + errno = EBADF; + return -1; + } + /* MSVCRT implementation of 'access' doesn't recognize D_OK, and its newer versions blow up when passed D_OK. */ path = map_w32_filename (path, NULL); @@ -2960,7 +2966,7 @@ sys_mktemp (char * template) { int save_errno = errno; p[0] = first_char[i]; - if (sys_access (template, 0) < 0) + if (sys_faccessat (AT_FDCWD, template, F_OK, AT_EACCESS) < 0) { errno = save_errno; return template; @@ -4011,7 +4017,7 @@ symlink (char const *filename, char const *linkname) { /* Non-absolute FILENAME is understood as being relative to LINKNAME's directory. We need to prepend that directory to - FILENAME to get correct results from sys_access below, since + FILENAME to get correct results from sys_faccessat below, since otherwise it will interpret FILENAME relative to the directory where the Emacs process runs. Note that make-symbolic-link always makes sure LINKNAME is a fully @@ -4025,10 +4031,10 @@ symlink (char const *filename, char const *linkname) strncpy (tem, linkfn, p - linkfn); tem[p - linkfn] = '\0'; strcat (tem, filename); - dir_access = sys_access (tem, D_OK); + dir_access = sys_faccessat (AT_FDCWD, tem, D_OK, AT_EACCESS); } else - dir_access = sys_access (filename, D_OK); + dir_access = sys_faccessat (AT_FDCWD, filename, D_OK, AT_EACCESS); /* Since Windows distinguishes between symlinks to directories and to files, we provide a kludgy feature: if FILENAME doesn't diff --git a/src/xrdb.c b/src/xrdb.c index 9d056a607e4..59b0876ebf8 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -41,7 +41,6 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_PWD_H #include #endif -#include #ifdef USE_MOTIF /* For Vdouble_click_time. */ @@ -50,7 +49,6 @@ along with GNU Emacs. If not, see . */ char *x_get_string_resource (XrmDatabase rdb, const char *name, const char *class); -static int file_p (const char *filename); /* X file search path processing. */ @@ -108,7 +106,7 @@ x_get_customization_string (XrmDatabase db, const char *name, database associated with display. (This is x_customization_string.) - Return the expanded file name if it exists and is readable, and + Return the resource database if its file was read successfully, and refers to %L only when the LANG environment variable is set, or otherwise provided by X. @@ -117,10 +115,11 @@ x_get_customization_string (XrmDatabase db, const char *name, Return NULL otherwise. */ -static char * -magic_file_p (const char *string, ptrdiff_t string_len, const char *class, - const char *escaped_suffix) +static XrmDatabase +magic_db (const char *string, ptrdiff_t string_len, const char *class, + const char *escaped_suffix) { + XrmDatabase db; char *lang = getenv ("LANG"); ptrdiff_t path_size = 100; @@ -217,14 +216,9 @@ magic_file_p (const char *string, ptrdiff_t string_len, const char *class, } path[path_len] = '\0'; - - if (! file_p (path)) - { - xfree (path); - return NULL; - } - - return path; + db = XrmGetFileDatabase (path); + xfree (path); + return db; } @@ -258,22 +252,11 @@ gethomedir (void) } -static int -file_p (const char *filename) -{ - struct stat status; - - return (access (filename, 4) == 0 /* exists and is readable */ - && stat (filename, &status) == 0 /* get the status */ - && (S_ISDIR (status.st_mode)) == 0); /* not a directory */ -} - - /* Find the first element of SEARCH_PATH which exists and is readable, after expanding the %-escapes. Return 0 if we didn't find any, and the path name of the one we found otherwise. */ -static char * +static XrmDatabase search_magic_path (const char *search_path, const char *class, const char *escaped_suffix) { @@ -286,18 +269,16 @@ search_magic_path (const char *search_path, const char *class, if (p > s) { - char *path = magic_file_p (s, p - s, class, escaped_suffix); - if (path) - return path; + XrmDatabase db = magic_db (s, p - s, class, escaped_suffix); + if (db) + return db; } else if (*p == ':') { - char *path; - - s = "%N%S"; - path = magic_file_p (s, strlen (s), class, escaped_suffix); - if (path) - return path; + static char const ns[] = "%N%S"; + XrmDatabase db = magic_db (ns, strlen (ns), class, escaped_suffix); + if (db) + return db; } if (*p == ':') @@ -312,21 +293,12 @@ search_magic_path (const char *search_path, const char *class, static XrmDatabase get_system_app (const char *class) { - XrmDatabase db = NULL; const char *path; - char *p; path = getenv ("XFILESEARCHPATH"); if (! path) path = PATH_X_DEFAULTS; - p = search_magic_path (path, class, 0); - if (p) - { - db = XrmGetFileDatabase (p); - xfree (p); - } - - return db; + return search_magic_path (path, class, 0); } @@ -340,35 +312,40 @@ get_fallback (Display *display) static XrmDatabase get_user_app (const char *class) { + XrmDatabase db = 0; const char *path; - char *file = 0; - char *free_it = 0; /* Check for XUSERFILESEARCHPATH. It is a path of complete file names, not directories. */ - if (((path = getenv ("XUSERFILESEARCHPATH")) - && (file = search_magic_path (path, class, 0))) + path = getenv ("XUSERFILESEARCHPATH"); + if (path) + db = search_magic_path (path, class, 0); + if (! db) + { /* Check for APPLRESDIR; it is a path of directories. In each, we have to search for LANG/CLASS and then CLASS. */ - || ((path = getenv ("XAPPLRESDIR")) - && ((file = search_magic_path (path, class, "/%L/%N")) - || (file = search_magic_path (path, class, "/%N")))) + path = getenv ("XAPPLRESDIR"); + if (path) + { + db = search_magic_path (path, class, "/%L/%N"); + if (!db) + db = search_magic_path (path, class, "/%N"); + } + } + if (! db) + { /* Check in the home directory. This is a bit of a hack; let's hope one's home directory doesn't contain any %-escapes. */ - || (free_it = gethomedir (), - ((file = search_magic_path (free_it, class, "%L/%N")) - || (file = search_magic_path (free_it, class, "%N"))))) - { - XrmDatabase db = XrmGetFileDatabase (file); - xfree (file); - xfree (free_it); - return db; + char *home = gethomedir (); + db = search_magic_path (home, class, "%L/%N"); + if (! db) + db = search_magic_path (home, class, "%N"); + xfree (home); } - xfree (free_it); - return NULL; + return db; } -- cgit v1.2.1 From 7831fb1b9e88be1c18920b36129c6d1933dbd7ea Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Nov 2012 21:07:33 -0800 Subject: Spelling fixes. --- doc/lispref/windows.texi | 4 ++-- doc/misc/ses.texi | 14 +++++++------- doc/misc/url.texi | 2 +- lisp/gnus/pop3.el | 2 +- lisp/progmodes/ruby-mode.el | 2 +- 5 files changed, 12 insertions(+), 12 deletions(-) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index bb02b1d54fd..a284fc09045 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -1055,7 +1055,7 @@ including the space earlier stolen from @code{W3}. @end smallexample @noindent -This can be counterintutive, in particular if @code{W4} were used for +This can be counterintuitive, in particular if @code{W4} were used for displaying a buffer only temporarily (@pxref{Temporary Displays}), and you want to continue working with the initial layout. @@ -2343,7 +2343,7 @@ buffer previously shown no longer exists, this function calls @code{switch-to-prev-buffer} (@pxref{Window History}) to show some other buffer instead. -The optional argument @var{bury-or-kill} specifes how to deal with +The optional argument @var{bury-or-kill} specifies how to deal with @var{window}'s buffer. The following values are handled: @table @code diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi index 5de87a2f1c7..cccd74dec0f 100644 --- a/doc/misc/ses.texi +++ b/doc/misc/ses.texi @@ -482,9 +482,9 @@ show column letters again. Pops up a menu to set the current row as the header, or revert to column letters. @item M-x ses-rename-cell -@findex ses-rename-cell -Rename a cell from a standard A1-like name to any -string. +@findex ses-rename-cell +Rename a cell from a standard A1-like name to any +string. @item M-x ses-repair-cell-reference-all @findex ses-repair-cell-reference-all When you interrupt a cell formula update by clicking @kbd{C-g}, then @@ -606,15 +606,15 @@ instance @code{(ses-range A1 A4 _ "empty")} will do the same as are empty. Similarly, @code{(ses-range A1 A4 _ )} will do the same as @code{(list A1 0 A3 0)}. @item >v -When order matters, list cells by reading cells rowwise from top left +When order matters, list cells by reading cells row-wise from top left to bottom right. This flag is provided for completeness only as it is the default reading order. @item -List cells by reading cells columnwise from top left to bottom right. +List cells by reading cells column-wise from top left to bottom right. @item v< -List cells by reading cells columnwise from top right to bottom left. +List cells by reading cells column-wise from top right to bottom left. @item v A short hand for @code{v>}. @item ^ diff --git a/doc/misc/url.texi b/doc/misc/url.texi index fdb3ab452f2..90ab7f5554f 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -346,7 +346,7 @@ To use this function, you must @code{(require 'url-queue)}. The value of this option is an integer specifying the maximum number of concurrent @code{url-queue-retrieve} network processes. If the number of @code{url-queue-retrieve} calls is larger than this number, -later ones are queued until ealier ones are finished. +later ones are queued until earlier ones are finished. @end defopt @vindex url-queue-timeout diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index f95bf26ad1d..801ed66ec2b 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -178,7 +178,7 @@ Shorter values mean quicker response, but are more CPU intensive.") 1000)))))) (defvar pop3-uidl) -;; List of UIDLs of existing messages at pesent in the server: +;; List of UIDLs of existing messages at present in the server: ;; ("UIDL1" "UIDL2" "UIDL3"...) (defvar pop3-uidl-saved) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index c662ccbea95..0bc41033367 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -897,7 +897,7 @@ current block, a sibling block, or an outer block. Do that (abs N) times." (t (setq pos (current-indentation)) (cond - ;; Deeper intendation, we found a block. + ;; Deeper indentation, we found a block. ;; FIXME: We can't recognize empty blocks this way. ((< start pos) (setq down t)) -- cgit v1.2.1 From f360feb8ec972600bb206447be8ac31cf61b0523 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 13 Nov 2012 21:29:54 -0800 Subject: Use trunk version of gnulib lib/fcntl.in.h. This corrects a recent checkin, which used an experimental version of this file by mistake. Stick with the standard version. --- lib/fcntl.in.h | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h index fb402ee1f0f..604c31b7984 100644 --- a/lib/fcntl.in.h +++ b/lib/fcntl.in.h @@ -213,11 +213,7 @@ _GL_WARN_ON_USE (openat, "openat is not portable - " #endif #ifndef O_EXEC -# ifdef O_PATH -# define O_EXEC O_PATH -# else -# define O_EXEC O_RDONLY /* This is often close enough in older systems. */ -# endif +# define O_EXEC O_RDONLY /* This is often close enough in older systems. */ #endif #ifndef O_IGNORE_CTTY @@ -274,11 +270,7 @@ _GL_WARN_ON_USE (openat, "openat is not portable - " #endif #ifndef O_SEARCH -# ifdef O_PATH -# define O_SEARCH O_PATH -# else -# define O_SEARCH O_RDONLY /* This is often close enough in older systems. */ -# endif +# define O_SEARCH O_RDONLY /* This is often close enough in older systems. */ #endif #ifndef O_SYNC -- cgit v1.2.1 From 8619323f695c733f67dad59987ca5adc3cc0a6e8 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 14 Nov 2012 10:34:17 +0400 Subject: * lisp/progmodes/ruby-mode.el (ruby-expr-beg): Make heredoc detection more strict. Add docstring. * test/automated/ruby-mode-tests.el (ruby-indent-singleton-class): Pass. (ruby-indent-inside-heredoc-after-operator) (ruby-indent-inside-heredoc-after-space): New tests. --- lisp/ChangeLog | 5 +++++ lisp/progmodes/ruby-mode.el | 12 +++++++----- test/ChangeLog | 6 ++++++ test/automated/ruby-mode-tests.el | 15 ++++++++++++++- 4 files changed, 32 insertions(+), 6 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 48eced16fe1..19623bd06b7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-14 Dmitry Gutov + + * progmodes/ruby-mode.el (ruby-expr-beg): Make heredoc detection + more strict. Add docstring. + 2012-11-14 Stefan Monnier * emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 0bc41033367..686bec89a95 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -384,7 +384,9 @@ and `\\' when preceded by `?'." (looking-at "class\\s *<<")))) (defun ruby-expr-beg (&optional option) - "TODO: document." + "Check if point is possibly at the beginning of an expression. +OPTION specifies the type of the expression. +Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." (save-excursion (store-match-data nil) (let ((space (skip-chars-backward " \t")) @@ -397,10 +399,10 @@ and `\\' when preceded by `?'." (or (eq (char-syntax (char-before (point))) ?w) (ruby-special-char-p)))) nil) - ((and (eq option 'heredoc) (< space 0)) - (not (progn (goto-char start) (ruby-singleton-class-p)))) - ((or (looking-at ruby-operator-re) - (looking-at "[\\[({,;]") + ((looking-at ruby-operator-re)) + ((eq option 'heredoc) + (and (< space 0) (not (ruby-singleton-class-p start)))) + ((or (looking-at "[\\[({,;]") (and (looking-at "[!?]") (or (not (eq option 'modifier)) (bolp) diff --git a/test/ChangeLog b/test/ChangeLog index 8973a0f1d4f..5a796408a3b 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,9 @@ +2012-11-14 Dmitry Gutov + + * automated/ruby-mode-tests.el (ruby-indent-singleton-class): Pass. + (ruby-indent-inside-heredoc-after-operator) + (ruby-indent-inside-heredoc-after-space): New tests. + 2012-11-13 Dmitry Gutov * automated/ruby-mode-tests.el (ruby-heredoc-font-lock) diff --git a/test/automated/ruby-mode-tests.el b/test/automated/ruby-mode-tests.el index a8cdd2f3f28..7d633be0f53 100644 --- a/test/automated/ruby-mode-tests.el +++ b/test/automated/ruby-mode-tests.el @@ -154,7 +154,6 @@ VALUES-PLIST is a list with alternating index and value elements." |")) (ert-deftest ruby-indent-singleton-class () - :expected-result :failed ; Doesn't work yet, when no space before "<<". (ruby-should-indent-buffer "class< + + * keymaps.texi (Searching Keymaps, Tool Bar): Untabify examples, + so they align better in info. + 2012-11-12 Glenn Morris * variables.texi (Adding Generalized Variables): diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index f658f7e66fb..7605f2337e1 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -753,12 +753,12 @@ them: (overriding-local-map (@var{find-in} overriding-local-map)) ((or (@var{find-in} (get-char-property (point) 'keymap)) - (@var{find-in-any} emulation-mode-map-alists) - (@var{find-in-any} minor-mode-overriding-map-alist) - (@var{find-in-any} minor-mode-map-alist) - (if (get-text-property (point) 'local-map) - (@var{find-in} (get-char-property (point) 'local-map)) - (@var{find-in} (current-local-map)))))) + (@var{find-in-any} emulation-mode-map-alists) + (@var{find-in-any} minor-mode-overriding-map-alist) + (@var{find-in-any} minor-mode-map-alist) + (if (get-text-property (point) 'local-map) + (@var{find-in} (get-char-property (point) 'local-map)) + (@var{find-in} (current-local-map)))))) (@var{find-in} (current-global-map))) @end lisp @@ -2629,8 +2629,8 @@ By default, the global map binds @code{[tool-bar]} as follows: @example (global-set-key [tool-bar] - `(menu-item ,(purecopy "tool bar") ignore - :filter tool-bar-make-keymap)) + `(menu-item ,(purecopy "tool bar") ignore + :filter tool-bar-make-keymap)) @end example @noindent -- cgit v1.2.1 From e0ea8060060193f66c776b513e3da731765fc38d Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 14 Nov 2012 00:29:25 -0800 Subject: * lisp/subr.el (set-temporary-overlay-map): Doc fix. * etc/NEWS: Related edit. --- etc/NEWS | 4 +++- lisp/ChangeLog | 4 ++++ lisp/subr.el | 15 ++++++++++----- 3 files changed, 17 insertions(+), 6 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 9fcb2d13565..e7e178744a7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -932,7 +932,9 @@ describing the cycle. *** `function-get' fetches a function property, following aliases. +++ *** `posnp' tests if an object is a `posn'. -*** `set-temporary-overlay-map' sets up a temporary overlay map. + +*** `set-temporary-overlay-map' sets up a temporary keymap that +takes precedence over most other maps for a short while (normally one key). +++ *** `system-users' returns the user names on the system. +++ diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c13ef1289f8..80ae61df8c1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2012-11-14 Glenn Morris + + * subr.el (set-temporary-overlay-map): Doc fix. + 2012-11-13 Martin Rudalics * window.el (record-window-buffer) diff --git a/lisp/subr.el b/lisp/subr.el index d328b7cddf5..d02b889ec44 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3960,11 +3960,16 @@ The properties used on SYMBOL are `composefunc', `sendfunc', (put symbol 'hookvar (or hookvar 'mail-send-hook))) (defun set-temporary-overlay-map (map &optional keep-pred) - "Set MAP as a temporary overlay map. -When KEEP-PRED is `t', using a key from the temporary keymap -leaves this keymap activated. KEEP-PRED can also be a function, -which will have the same effect when it returns `t'. -When KEEP-PRED is nil, the temporary keymap is used only once." + "Set MAP as a temporary keymap taking precedence over most other keymaps. +Note that this does NOT take precedence over the \"overriding\" maps +`overriding-terminal-local-map' and `overriding-local-map' (or the +`keymap' text property). Unlike those maps, if no match for a key is +found in MAP, the normal key lookup sequence then continues. + +Normally, MAP is used only once. If the optional argument +KEEP-PRED is `t', MAP stays active if a key from MAP is used. +KEEP-PRED can also be a function of no arguments: if it returns +non-nil then MAP stays active." (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map")) (overlaysym (make-symbol "t")) (alist (list (cons overlaysym map))) -- cgit v1.2.1 From 921c067f4309c3eab0aa536723683bada6802545 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 14 Nov 2012 00:45:50 -0800 Subject: Document set-temporary-overlay-map * doc/lispref/keymaps.texi (Active Keymaps, Searching Keymaps) (Controlling Active Maps): Document set-temporary-overlay-map. * etc/NEWS: Related markup. --- doc/lispref/ChangeLog | 2 ++ doc/lispref/keymaps.texi | 23 +++++++++++++++++++++-- etc/NEWS | 2 +- 3 files changed, 24 insertions(+), 3 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 5bdcf86406c..e5320bf9343 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -2,6 +2,8 @@ * keymaps.texi (Searching Keymaps, Tool Bar): Untabify examples, so they align better in info. + (Active Keymaps, Searching Keymaps, Controlling Active Maps): + Document set-temporary-overlay-map. 2012-11-12 Glenn Morris diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 7605f2337e1..f6d571ecc68 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -664,7 +664,9 @@ additional active keymaps through the variable The highest precedence normal keymap comes from the @code{keymap} text or overlay property. If that is non-@code{nil}, it is the first -keymap to be processed, in normal circumstances. +keymap to be processed, in normal circumstances. Next comes +any keymap added by the function @code{set-temporary-overlay-map}. +@xref{Controlling Active Maps}. However, there are also special ways for programs to substitute other keymaps for some of those. The variable @@ -753,6 +755,7 @@ them: (overriding-local-map (@var{find-in} overriding-local-map)) ((or (@var{find-in} (get-char-property (point) 'keymap)) + (@var{find-in} @var{temp-map}) (@var{find-in-any} emulation-mode-map-alists) (@var{find-in-any} minor-mode-overriding-map-alist) (@var{find-in-any} minor-mode-map-alist) @@ -770,7 +773,8 @@ Lookup}.) If the key sequence starts with a mouse event, or a symbolic prefix event followed by a mouse event, that event's position is used instead of point and the current buffer. Mouse events on an embedded string use non-@code{nil} text properties from that string -instead of the buffer. +instead of the buffer. @var{temp-map} is a pseudo variable that +represents the effect of a @code{set-temporary-overlay-map} call. When a match is found (@pxref{Key Lookup}), if the binding in the keymap is a function, the search is over. However if the keymap entry @@ -950,6 +954,21 @@ are used before @code{minor-mode-map-alist} and @code{minor-mode-overriding-map-alist}. @end defvar +@defun set-temporary-overlay-map keymap &optional keep +This function adds @var{keymap} as a temporary keymap that takes +precedence over most other keymaps. It does not take precedence over +the ``overriding'' maps (see above); and unlike them, if no match for +a key is found in @var{keymap}, the search continues. + +Normally, @var{keymap} is used only once. If the optional argument +@var{pred} is @code{t}, the map stays active if a key from @var{keymap} +is used. @var{pred} can also be a function of no arguments: if it returns +non-@code{nil} then @var{keymap} stays active. + +For a pseudo-Lisp description of exactly how and when this keymap applies, +@pxref{Searching Keymaps}. +@end defun + @node Key Lookup @section Key Lookup @cindex key lookup diff --git a/etc/NEWS b/etc/NEWS index e7e178744a7..84bedfbc257 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -932,7 +932,7 @@ describing the cycle. *** `function-get' fetches a function property, following aliases. +++ *** `posnp' tests if an object is a `posn'. - ++++ *** `set-temporary-overlay-map' sets up a temporary keymap that takes precedence over most other maps for a short while (normally one key). +++ -- cgit v1.2.1 From 77731919f923a5fc81db60d19952776417a00037 Mon Sep 17 00:00:00 2001 From: Dmitry Antipov Date: Wed, 14 Nov 2012 15:13:33 +0400 Subject: * xdisp.c (echo_area_display, redisplay_internal): Omit redundant check whether frame_garbaged is set. --- src/ChangeLog | 5 +++++ src/xdisp.c | 12 ++++-------- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index a6b42e8a58c..99f3128b321 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2012-11-14 Dmitry Antipov + + * xdisp.c (echo_area_display, redisplay_internal): + Omit redundant check whether frame_garbaged is set. + 2012-11-14 Paul Eggert Use faccessat, not access, when checking file permissions (Bug#12632). diff --git a/src/xdisp.c b/src/xdisp.c index a74628db392..27d9fff0b7d 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10816,8 +10816,7 @@ echo_area_display (int update_frame_p) #endif /* HAVE_WINDOW_SYSTEM */ /* Redraw garbaged frames. */ - if (frame_garbaged) - clear_garbaged_frames (); + clear_garbaged_frames (); if (!NILP (echo_area_buffer[0]) || minibuf_level == 0) { @@ -13104,8 +13103,7 @@ redisplay_internal (void) } /* Clear frames marked as garbaged. */ - if (frame_garbaged) - clear_garbaged_frames (); + clear_garbaged_frames (); /* Build menubar and tool-bar items. */ if (NILP (Vmemory_full)) @@ -13189,8 +13187,7 @@ redisplay_internal (void) /* If window configuration was changed, frames may have been marked garbaged. Clear them or we will experience surprises wrt scrolling. */ - if (frame_garbaged) - clear_garbaged_frames (); + clear_garbaged_frames (); } } else if (EQ (selected_window, minibuf_window) @@ -13213,8 +13210,7 @@ redisplay_internal (void) /* If window configuration was changed, frames may have been marked garbaged. Clear them or we will experience surprises wrt scrolling. */ - if (frame_garbaged) - clear_garbaged_frames (); + clear_garbaged_frames (); } -- cgit v1.2.1 From 710f581278f6eaea5dbc5c0bcc7c206be9690746 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 14 Nov 2012 06:17:36 -0500 Subject: Auto-commit of generated files. --- autogen/Makefile.in | 91 +++- autogen/aclocal.m4 | 5 + autogen/config.in | 27 ++ autogen/configure | 1206 +++++++++++++++++++++++++++++++++++++++++++-------- 4 files changed, 1124 insertions(+), 205 deletions(-) diff --git a/autogen/Makefile.in b/autogen/Makefile.in index d7855ac46ee..cea3da9a81d 100644 --- a/autogen/Makefile.in +++ b/autogen/Makefile.in @@ -36,7 +36,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub utimens warnings +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=at-internal --avoid=errno --avoid=fchdir --avoid=fcntl --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=openat-h --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub utimens warnings VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ @@ -66,14 +66,17 @@ am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \ $(top_srcdir)/m4/alloca.m4 $(top_srcdir)/m4/c-strtod.m4 \ $(top_srcdir)/m4/clock_time.m4 \ $(top_srcdir)/m4/close-stream.m4 $(top_srcdir)/m4/dup2.m4 \ - $(top_srcdir)/m4/environ.m4 $(top_srcdir)/m4/execinfo.m4 \ - $(top_srcdir)/m4/extensions.m4 \ - $(top_srcdir)/m4/extern-inline.m4 $(top_srcdir)/m4/filemode.m4 \ - $(top_srcdir)/m4/fpending.m4 $(top_srcdir)/m4/getloadavg.m4 \ + $(top_srcdir)/m4/environ.m4 $(top_srcdir)/m4/euidaccess.m4 \ + $(top_srcdir)/m4/execinfo.m4 $(top_srcdir)/m4/extensions.m4 \ + $(top_srcdir)/m4/extern-inline.m4 \ + $(top_srcdir)/m4/faccessat.m4 $(top_srcdir)/m4/fcntl_h.m4 \ + $(top_srcdir)/m4/filemode.m4 $(top_srcdir)/m4/fpending.m4 \ + $(top_srcdir)/m4/getgroups.m4 $(top_srcdir)/m4/getloadavg.m4 \ $(top_srcdir)/m4/getopt.m4 $(top_srcdir)/m4/gettime.m4 \ $(top_srcdir)/m4/gettimeofday.m4 \ $(top_srcdir)/m4/gnulib-common.m4 \ $(top_srcdir)/m4/gnulib-comp.m4 \ + $(top_srcdir)/m4/group-member.m4 \ $(top_srcdir)/m4/include_next.m4 $(top_srcdir)/m4/inttypes.m4 \ $(top_srcdir)/m4/largefile.m4 $(top_srcdir)/m4/longlong.m4 \ $(top_srcdir)/m4/lstat.m4 $(top_srcdir)/m4/manywarnings.m4 \ @@ -213,6 +216,7 @@ GNULIB_FCHDIR = @GNULIB_FCHDIR@ GNULIB_FCHMODAT = @GNULIB_FCHMODAT@ GNULIB_FCHOWNAT = @GNULIB_FCHOWNAT@ GNULIB_FCLOSE = @GNULIB_FCLOSE@ +GNULIB_FCNTL = @GNULIB_FCNTL@ GNULIB_FDATASYNC = @GNULIB_FDATASYNC@ GNULIB_FDOPEN = @GNULIB_FDOPEN@ GNULIB_FFLUSH = @GNULIB_FFLUSH@ @@ -279,8 +283,11 @@ GNULIB_MKSTEMP = @GNULIB_MKSTEMP@ GNULIB_MKSTEMPS = @GNULIB_MKSTEMPS@ GNULIB_MKTIME = @GNULIB_MKTIME@ GNULIB_NANOSLEEP = @GNULIB_NANOSLEEP@ +GNULIB_NONBLOCKING = @GNULIB_NONBLOCKING@ GNULIB_OBSTACK_PRINTF = @GNULIB_OBSTACK_PRINTF@ GNULIB_OBSTACK_PRINTF_POSIX = @GNULIB_OBSTACK_PRINTF_POSIX@ +GNULIB_OPEN = @GNULIB_OPEN@ +GNULIB_OPENAT = @GNULIB_OPENAT@ GNULIB_PCLOSE = @GNULIB_PCLOSE@ GNULIB_PERROR = @GNULIB_PERROR@ GNULIB_PIPE = @GNULIB_PIPE@ @@ -408,6 +415,7 @@ HAVE_FACCESSAT = @HAVE_FACCESSAT@ HAVE_FCHDIR = @HAVE_FCHDIR@ HAVE_FCHMODAT = @HAVE_FCHMODAT@ HAVE_FCHOWNAT = @HAVE_FCHOWNAT@ +HAVE_FCNTL = @HAVE_FCNTL@ HAVE_FDATASYNC = @HAVE_FDATASYNC@ HAVE_FSEEKO = @HAVE_FSEEKO@ HAVE_FSTATAT = @HAVE_FSTATAT@ @@ -444,6 +452,7 @@ HAVE_MKOSTEMPS = @HAVE_MKOSTEMPS@ HAVE_MKSTEMP = @HAVE_MKSTEMP@ HAVE_MKSTEMPS = @HAVE_MKSTEMPS@ HAVE_NANOSLEEP = @HAVE_NANOSLEEP@ +HAVE_OPENAT = @HAVE_OPENAT@ HAVE_OS_H = @HAVE_OS_H@ HAVE_PCLOSE = @HAVE_PCLOSE@ HAVE_PIPE = @HAVE_PIPE@ @@ -563,6 +572,7 @@ LIBXTR6 = @LIBXTR6@ LIBXT_OTHER = @LIBXT_OTHER@ LIBX_OTHER = @LIBX_OTHER@ LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ +LIB_EACCESS = @LIB_EACCESS@ LIB_EXECINFO = @LIB_EXECINFO@ LIB_GCC = @LIB_GCC@ LIB_MATH = @LIB_MATH@ @@ -578,6 +588,7 @@ M17N_FLT_LIBS = @M17N_FLT_LIBS@ MAKEINFO = @MAKEINFO@ MKDEPDIR = @MKDEPDIR@ MKDIR_P = @MKDIR_P@ +NEXT_AS_FIRST_DIRECTIVE_FCNTL_H = @NEXT_AS_FIRST_DIRECTIVE_FCNTL_H@ NEXT_AS_FIRST_DIRECTIVE_GETOPT_H = @NEXT_AS_FIRST_DIRECTIVE_GETOPT_H@ NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H = @NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H@ NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H = @NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H@ @@ -591,6 +602,7 @@ NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H@ NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H@ NEXT_AS_FIRST_DIRECTIVE_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_TIME_H@ NEXT_AS_FIRST_DIRECTIVE_UNISTD_H = @NEXT_AS_FIRST_DIRECTIVE_UNISTD_H@ +NEXT_FCNTL_H = @NEXT_FCNTL_H@ NEXT_GETOPT_H = @NEXT_GETOPT_H@ NEXT_INTTYPES_H = @NEXT_INTTYPES_H@ NEXT_SIGNAL_H = @NEXT_SIGNAL_H@ @@ -641,6 +653,7 @@ REPLACE_DUP = @REPLACE_DUP@ REPLACE_DUP2 = @REPLACE_DUP2@ REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@ REPLACE_FCLOSE = @REPLACE_FCLOSE@ +REPLACE_FCNTL = @REPLACE_FCNTL@ REPLACE_FDOPEN = @REPLACE_FDOPEN@ REPLACE_FFLUSH = @REPLACE_FFLUSH@ REPLACE_FOPEN = @REPLACE_FOPEN@ @@ -680,6 +693,8 @@ REPLACE_MKTIME = @REPLACE_MKTIME@ REPLACE_NANOSLEEP = @REPLACE_NANOSLEEP@ REPLACE_NULL = @REPLACE_NULL@ REPLACE_OBSTACK_PRINTF = @REPLACE_OBSTACK_PRINTF@ +REPLACE_OPEN = @REPLACE_OPEN@ +REPLACE_OPENAT = @REPLACE_OPENAT@ REPLACE_PERROR = @REPLACE_PERROR@ REPLACE_POPEN = @REPLACE_POPEN@ REPLACE_PREAD = @REPLACE_PREAD@ @@ -859,18 +874,20 @@ x_default_search_path = @x_default_search_path@ # statements but through direct file reference. Therefore this snippet must be # present in all Makefile.am that need it. This is ensured by the applicability # 'all' defined above. -BUILT_SOURCES = $(ALLOCA_H) $(EXECINFO_H) $(GETOPT_H) inttypes.h \ - signal.h arg-nonnull.h c++defs.h warn-on-use.h $(STDALIGN_H) \ - $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) stdio.h \ - stdlib.h sys/select.h sys/stat.h sys/time.h time.h unistd.h +BUILT_SOURCES = $(ALLOCA_H) $(EXECINFO_H) fcntl.h $(GETOPT_H) \ + inttypes.h signal.h arg-nonnull.h c++defs.h warn-on-use.h \ + $(STDALIGN_H) $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) \ + stdio.h stdlib.h sys/select.h sys/stat.h sys/time.h time.h \ + unistd.h EXTRA_DIST = alloca.in.h allocator.h careadlinkat.h close-stream.h \ md5.h sha1.h sha256.h sha512.h dosname.h ftoastr.c ftoastr.h \ - dup2.c execinfo.c execinfo.in.h filemode.h fpending.c \ - fpending.h getloadavg.c getopt.c getopt.in.h getopt1.c \ - getopt_int.h gettimeofday.c ignore-value.h intprops.h \ - inttypes.in.h lstat.c mktime-internal.h mktime.c pathmax.h \ - pselect.c pthread_sigmask.c readlink.c signal.in.h \ - $(top_srcdir)/build-aux/snippet/_Noreturn.h \ + dup2.c euidaccess.c execinfo.c execinfo.in.h at-func.c \ + faccessat.c fcntl.in.h filemode.h fpending.c fpending.h \ + getgroups.c getloadavg.c getopt.c getopt.in.h getopt1.c \ + getopt_int.h gettimeofday.c group-member.c ignore-value.h \ + intprops.h inttypes.in.h lstat.c mktime-internal.h mktime.c \ + pathmax.h pselect.c pthread_sigmask.c readlink.c root-uid.h \ + signal.in.h $(top_srcdir)/build-aux/snippet/_Noreturn.h \ $(top_srcdir)/build-aux/snippet/arg-nonnull.h \ $(top_srcdir)/build-aux/snippet/c++defs.h \ $(top_srcdir)/build-aux/snippet/warn-on-use.h stat.c \ @@ -879,12 +896,12 @@ EXTRA_DIST = alloca.in.h allocator.h careadlinkat.h close-stream.h \ strtol.c strtoll.c strtol.c strtoul.c strtoull.c strtoimax.c \ strtoumax.c symlink.c sys_select.in.h sys_stat.in.h \ sys_time.in.h time.in.h time_r.c timespec.h u64.h unistd.in.h \ - utimens.h verify.h + utimens.h verify.h xalloc-oversized.h MOSTLYCLEANDIRS = sys sys MOSTLYCLEANFILES = core *.stackdump alloca.h alloca.h-t execinfo.h \ - execinfo.h-t getopt.h getopt.h-t inttypes.h inttypes.h-t \ - signal.h signal.h-t arg-nonnull.h arg-nonnull.h-t c++defs.h \ - c++defs.h-t warn-on-use.h warn-on-use.h-t stdalign.h \ + execinfo.h-t fcntl.h fcntl.h-t getopt.h getopt.h-t inttypes.h \ + inttypes.h-t signal.h signal.h-t arg-nonnull.h arg-nonnull.h-t \ + c++defs.h c++defs.h-t warn-on-use.h warn-on-use.h-t stdalign.h \ stdalign.h-t stdarg.h stdarg.h-t stdbool.h stdbool.h-t \ stddef.h stddef.h-t stdint.h stdint.h-t stdio.h stdio.h-t \ stdlib.h stdlib.h-t sys/select.h sys/select.h-t sys/stat.h \ @@ -900,8 +917,9 @@ libgnu_a_SOURCES = allocator.c c-ctype.h c-ctype.c c-strcase.h \ timespec.c timespec-add.c timespec-sub.c u64.c utimens.c libgnu_a_LIBADD = $(gl_LIBOBJS) libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) -EXTRA_libgnu_a_SOURCES = ftoastr.c dup2.c execinfo.c fpending.c \ - getloadavg.c getopt.c getopt1.c gettimeofday.c lstat.c \ +EXTRA_libgnu_a_SOURCES = ftoastr.c dup2.c euidaccess.c execinfo.c \ + at-func.c faccessat.c fpending.c getgroups.c getloadavg.c \ + getopt.c getopt1.c gettimeofday.c group-member.c lstat.c \ mktime.c pselect.c pthread_sigmask.c readlink.c stat.c \ strtoimax.c strtol.c strtoll.c strtol.c strtoul.c strtoull.c \ strtoimax.c strtoumax.c symlink.c time_r.c @@ -963,6 +981,7 @@ distclean-compile: -rm -f *.tab.c @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/allocator.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/at-func.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-ctype.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strcasecmp.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strncasecmp.Po@am__quote@ @@ -971,15 +990,19 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtoastr.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtotimespec.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dup2.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/euidaccess.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/execinfo.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/faccessat.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/filemode.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fpending.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ftoastr.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getgroups.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getloadavg.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt1.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gettime.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gettimeofday.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/group-member.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lstat.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/md5.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mktime.Po@am__quote@ @@ -1243,6 +1266,32 @@ uninstall-am: @GL_GENERATE_EXECINFO_H_FALSE@execinfo.h: $(top_builddir)/config.status @GL_GENERATE_EXECINFO_H_FALSE@ rm -f $@ +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +fcntl.h: fcntl.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_FCNTL_H''@|$(NEXT_FCNTL_H)|g' \ + -e 's/@''GNULIB_FCNTL''@/$(GNULIB_FCNTL)/g' \ + -e 's/@''GNULIB_NONBLOCKING''@/$(GNULIB_NONBLOCKING)/g' \ + -e 's/@''GNULIB_OPEN''@/$(GNULIB_OPEN)/g' \ + -e 's/@''GNULIB_OPENAT''@/$(GNULIB_OPENAT)/g' \ + -e 's|@''HAVE_FCNTL''@|$(HAVE_FCNTL)|g' \ + -e 's|@''HAVE_OPENAT''@|$(HAVE_OPENAT)|g' \ + -e 's|@''REPLACE_FCNTL''@|$(REPLACE_FCNTL)|g' \ + -e 's|@''REPLACE_OPEN''@|$(REPLACE_OPEN)|g' \ + -e 's|@''REPLACE_OPENAT''@|$(REPLACE_OPENAT)|g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \ + < $(srcdir)/fcntl.in.h; \ + } > $@-t && \ + mv $@-t $@ + # We need the following in order to create when the system # doesn't have one that works with the given compiler. getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H) diff --git a/autogen/aclocal.m4 b/autogen/aclocal.m4 index 37d734c2c7f..f423953b3c8 100644 --- a/autogen/aclocal.m4 +++ b/autogen/aclocal.m4 @@ -991,17 +991,22 @@ m4_include([m4/clock_time.m4]) m4_include([m4/close-stream.m4]) m4_include([m4/dup2.m4]) m4_include([m4/environ.m4]) +m4_include([m4/euidaccess.m4]) m4_include([m4/execinfo.m4]) m4_include([m4/extensions.m4]) m4_include([m4/extern-inline.m4]) +m4_include([m4/faccessat.m4]) +m4_include([m4/fcntl_h.m4]) m4_include([m4/filemode.m4]) m4_include([m4/fpending.m4]) +m4_include([m4/getgroups.m4]) m4_include([m4/getloadavg.m4]) m4_include([m4/getopt.m4]) m4_include([m4/gettime.m4]) m4_include([m4/gettimeofday.m4]) m4_include([m4/gnulib-common.m4]) m4_include([m4/gnulib-comp.m4]) +m4_include([m4/group-member.m4]) m4_include([m4/include_next.m4]) m4_include([m4/inttypes.m4]) m4_include([m4/largefile.m4]) diff --git a/autogen/config.in b/autogen/config.in index 05418e64623..5388b8dc046 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -174,6 +174,14 @@ along with GNU Emacs. If not, see . */ garbage collection in the jmp_buf. */ #undef GC_SETJMP_WORKS +/* Define to the type of elements in the array set by `getgroups'. Usually + this is either `int' or `gid_t'. */ +#undef GETGROUPS_T + +/* Define this to 1 if getgroups(0,NULL) does not return the number of groups. + */ +#undef GETGROUPS_ZERO_BUG + /* Define if gettimeofday clobbers the localtime buffer. */ #undef GETTIMEOFDAY_CLOBBERS_LOCALTIME @@ -188,6 +196,10 @@ along with GNU Emacs. If not, see . */ whether the gnulib module close-stream shall be considered present. */ #undef GNULIB_CLOSE_STREAM +/* Define to a C preprocessor expression that evaluates to 1 or 0, depending + whether the gnulib module faccessat shall be considered present. */ +#undef GNULIB_FACCESSAT + /* Define to a C preprocessor expression that evaluates to 1 or 0, depending whether the gnulib module fscanf shall be considered present. */ #undef GNULIB_FSCANF @@ -209,6 +221,9 @@ along with GNU Emacs. If not, see . */ startup, if using GTK. */ #undef G_SLICE_ALWAYS_MALLOC +/* Define to 1 if you have the `access' function. */ +#undef HAVE_ACCESS + /* Define to 1 if the file /usr/lpp/X11/bin/smt.exp exists. */ #undef HAVE_AIX_SMT_EXP @@ -333,6 +348,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the 'dup2' function. */ #undef HAVE_DUP2 +/* Define to 1 if you have the `eaccess' function. */ +#undef HAVE_EACCESS + /* Define to 1 if you have the `endgrent' function. */ #undef HAVE_ENDGRENT @@ -348,6 +366,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the header file. */ #undef HAVE_EXECINFO_H +/* Define to 1 if you have the `faccessat' function. */ +#undef HAVE_FACCESSAT + /* Define to 1 if you have the header file. */ #undef HAVE_FCNTL_H @@ -396,6 +417,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `getgrent' function. */ #undef HAVE_GETGRENT +/* Define to 1 if your system has a working `getgroups' function. */ +#undef HAVE_GETGROUPS + /* Define to 1 if you have the `gethostname' function. */ #undef HAVE_GETHOSTNAME @@ -562,6 +586,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `dnet' library (-ldnet). */ #undef HAVE_LIBDNET +/* Define to 1 if you have the header file. */ +#undef HAVE_LIBGEN_H + /* Define to 1 if you have the hesiod library (-lhesiod). */ #undef HAVE_LIBHESIOD diff --git a/autogen/configure b/autogen/configure index 159a91bb48c..e44b44a0a00 100755 --- a/autogen/configure +++ b/autogen/configure @@ -611,6 +611,8 @@ LD_SWITCH_SYSTEM_TEMACS LIBGNU_LTLIBDEPS LIBGNU_LIBDEPS gltests_WITNESS +gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE +gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE gl_GNULIB_ENABLED_verify_FALSE gl_GNULIB_ENABLED_verify_TRUE gl_GNULIB_ENABLED_strtoull_FALSE @@ -619,14 +621,23 @@ gl_GNULIB_ENABLED_strtoll_FALSE gl_GNULIB_ENABLED_strtoll_TRUE gl_GNULIB_ENABLED_stat_FALSE gl_GNULIB_ENABLED_stat_TRUE +gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE +gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE gl_GNULIB_ENABLED_pathmax_FALSE gl_GNULIB_ENABLED_pathmax_TRUE +gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE +gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE +gl_GNULIB_ENABLED_getgroups_FALSE +gl_GNULIB_ENABLED_getgroups_TRUE +gl_GNULIB_ENABLED_euidaccess_FALSE +gl_GNULIB_ENABLED_euidaccess_TRUE gl_GNULIB_ENABLED_dosname_FALSE gl_GNULIB_ENABLED_dosname_TRUE LTLIBINTL LIBINTL +LIB_EACCESS WINDOWS_64_BIT_OFF_T HAVE_UNISTD_H NEXT_AS_FIRST_DIRECTIVE_UNISTD_H @@ -895,10 +906,6 @@ GETOPT_H HAVE_GETOPT_H NEXT_AS_FIRST_DIRECTIVE_GETOPT_H NEXT_GETOPT_H -PRAGMA_COLUMNS -PRAGMA_SYSTEM_HEADER -INCLUDE_NEXT_AS_FIRST_DIRECTIVE -INCLUDE_NEXT GETLOADAVG_LIBS REPLACE_WCTOMB REPLACE_UNSETENV @@ -974,6 +981,21 @@ GNULIB_CANONICALIZE_FILE_NAME GNULIB_CALLOC_POSIX GNULIB_ATOLL GNULIB__EXIT +NEXT_AS_FIRST_DIRECTIVE_FCNTL_H +NEXT_FCNTL_H +PRAGMA_COLUMNS +PRAGMA_SYSTEM_HEADER +INCLUDE_NEXT_AS_FIRST_DIRECTIVE +INCLUDE_NEXT +REPLACE_OPENAT +REPLACE_OPEN +REPLACE_FCNTL +HAVE_OPENAT +HAVE_FCNTL +GNULIB_OPENAT +GNULIB_OPEN +GNULIB_NONBLOCKING +GNULIB_FCNTL GL_GENERATE_EXECINFO_H_FALSE GL_GENERATE_EXECINFO_H_TRUE LIB_EXECINFO @@ -3205,6 +3227,7 @@ as_fn_append ac_header_list " sys/un.h" as_fn_append ac_func_list " tzset" as_fn_append ac_func_list " readlinkat" as_fn_append ac_header_list " execinfo.h" +as_fn_append ac_func_list " faccessat" as_fn_append ac_header_list " stdio_ext.h" as_fn_append ac_func_list " __fpending" gl_getopt_required=GNU @@ -5738,6 +5761,8 @@ else test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS" fi +# Avoid gnulib's tests for O_NOATIME and O_NOFOLLOW, as we don't use them. + # Avoid gnulib's threadlib module, as we do threads our own way. @@ -6969,18 +6994,23 @@ esac # Code from module dtotimespec: # Code from module dup2: # Code from module environ: + # Code from module euidaccess: # Code from module execinfo: # Code from module extensions: # Code from module extern-inline: + # Code from module faccessat: + # Code from module fcntl-h: # Code from module filemode: # Code from module fpending: + # Code from module getgroups: # Code from module getloadavg: # Code from module getopt-gnu: # Code from module getopt-posix: # Code from module gettext-h: # Code from module gettime: # Code from module gettimeofday: + # Code from module group-member: # Code from module ignore-value: # Code from module include_next: # Code from module intprops: @@ -6996,6 +7026,7 @@ esac # Code from module pselect: # Code from module pthread_sigmask: # Code from module readlink: + # Code from module root-uid: # Code from module signal-h: # Code from module snippet/_Noreturn: # Code from module snippet/arg-nonnull: @@ -7035,6 +7066,7 @@ esac # Code from module utimens: # Code from module verify: # Code from module warnings: + # Code from module xalloc-oversized: # It's helpful to have C macros available to GDB, so prefer -g3 to -g @@ -13417,7 +13449,7 @@ esac for ac_func in gethostname \ closedir getrusage get_current_dir_name \ lrand48 \ -fpathconf select euidaccess getpagesize setlocale \ +fpathconf select getpagesize setlocale \ utimes getrlimit setrlimit getcwd shutdown getaddrinfo \ strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ @@ -16777,6 +16809,145 @@ $as_echo "#define HAVE_ENVIRON_DECL 1" >>confdefs.h + + + + GNULIB_FCNTL=0; + GNULIB_NONBLOCKING=0; + GNULIB_OPEN=0; + GNULIB_OPENAT=0; + HAVE_FCNTL=1; + HAVE_OPENAT=1; + REPLACE_FCNTL=0; + REPLACE_OPEN=0; + REPLACE_OPENAT=0; + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the preprocessor supports include_next" >&5 +$as_echo_n "checking whether the preprocessor supports include_next... " >&6; } +if test "${gl_cv_have_include_next+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + rm -rf conftestd1a conftestd1b conftestd2 + mkdir conftestd1a conftestd1b conftestd2 + cat < conftestd1a/conftest.h +#define DEFINED_IN_CONFTESTD1 +#include_next +#ifdef DEFINED_IN_CONFTESTD2 +int foo; +#else +#error "include_next doesn't work" +#endif +EOF + cat < conftestd1b/conftest.h +#define DEFINED_IN_CONFTESTD1 +#include +#include_next +#ifdef DEFINED_IN_CONFTESTD2 +int foo; +#else +#error "include_next doesn't work" +#endif +EOF + cat < conftestd2/conftest.h +#ifndef DEFINED_IN_CONFTESTD1 +#error "include_next test doesn't work" +#endif +#define DEFINED_IN_CONFTESTD2 +EOF + gl_save_CPPFLAGS="$CPPFLAGS" + CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1b -Iconftestd2" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gl_cv_have_include_next=yes +else + CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1a -Iconftestd2" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + gl_cv_have_include_next=buggy +else + gl_cv_have_include_next=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CPPFLAGS="$gl_save_CPPFLAGS" + rm -rf conftestd1a conftestd1b conftestd2 + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_have_include_next" >&5 +$as_echo "$gl_cv_have_include_next" >&6; } + PRAGMA_SYSTEM_HEADER= + if test $gl_cv_have_include_next = yes; then + INCLUDE_NEXT=include_next + INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include_next + if test -n "$GCC"; then + PRAGMA_SYSTEM_HEADER='#pragma GCC system_header' + fi + else + if test $gl_cv_have_include_next = buggy; then + INCLUDE_NEXT=include + INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include_next + else + INCLUDE_NEXT=include + INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include + fi + fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether system header files limit the line length" >&5 +$as_echo_n "checking whether system header files limit the line length... " >&6; } +if test "${gl_cv_pragma_columns+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef __TANDEM +choke me +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "choke me" >/dev/null 2>&1; then : + gl_cv_pragma_columns=yes +else + gl_cv_pragma_columns=no +fi +rm -f conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_pragma_columns" >&5 +$as_echo "$gl_cv_pragma_columns" >&6; } + if test $gl_cv_pragma_columns = yes; then + PRAGMA_COLUMNS="#pragma COLUMNS 10000" + else + PRAGMA_COLUMNS= + fi + + +ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default" +if test "x$ac_cv_type_mode_t" = x""yes; then : + +else + +cat >>confdefs.h <<_ACEOF +#define mode_t int +_ACEOF + +fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for st_dm_mode in struct stat" >&5 $as_echo_n "checking for st_dm_mode in struct stat... " >&6; } if test "${ac_cv_struct_st_dm_mode+set}" = set; then : @@ -16905,120 +17076,6 @@ _ACEOF - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the preprocessor supports include_next" >&5 -$as_echo_n "checking whether the preprocessor supports include_next... " >&6; } -if test "${gl_cv_have_include_next+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - rm -rf conftestd1a conftestd1b conftestd2 - mkdir conftestd1a conftestd1b conftestd2 - cat < conftestd1a/conftest.h -#define DEFINED_IN_CONFTESTD1 -#include_next -#ifdef DEFINED_IN_CONFTESTD2 -int foo; -#else -#error "include_next doesn't work" -#endif -EOF - cat < conftestd1b/conftest.h -#define DEFINED_IN_CONFTESTD1 -#include -#include_next -#ifdef DEFINED_IN_CONFTESTD2 -int foo; -#else -#error "include_next doesn't work" -#endif -EOF - cat < conftestd2/conftest.h -#ifndef DEFINED_IN_CONFTESTD1 -#error "include_next test doesn't work" -#endif -#define DEFINED_IN_CONFTESTD2 -EOF - gl_save_CPPFLAGS="$CPPFLAGS" - CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1b -Iconftestd2" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_have_include_next=yes -else - CPPFLAGS="$gl_save_CPPFLAGS -Iconftestd1a -Iconftestd2" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - gl_cv_have_include_next=buggy -else - gl_cv_have_include_next=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CPPFLAGS="$gl_save_CPPFLAGS" - rm -rf conftestd1a conftestd1b conftestd2 - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_have_include_next" >&5 -$as_echo "$gl_cv_have_include_next" >&6; } - PRAGMA_SYSTEM_HEADER= - if test $gl_cv_have_include_next = yes; then - INCLUDE_NEXT=include_next - INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include_next - if test -n "$GCC"; then - PRAGMA_SYSTEM_HEADER='#pragma GCC system_header' - fi - else - if test $gl_cv_have_include_next = buggy; then - INCLUDE_NEXT=include - INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include_next - else - INCLUDE_NEXT=include - INCLUDE_NEXT_AS_FIRST_DIRECTIVE=include - fi - fi - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether system header files limit the line length" >&5 -$as_echo_n "checking whether system header files limit the line length... " >&6; } -if test "${gl_cv_pragma_columns+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#ifdef __TANDEM -choke me -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "choke me" >/dev/null 2>&1; then : - gl_cv_pragma_columns=yes -else - gl_cv_pragma_columns=no -fi -rm -f conftest* - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_pragma_columns" >&5 -$as_echo "$gl_cv_pragma_columns" >&6; } - if test $gl_cv_pragma_columns = yes; then - PRAGMA_COLUMNS="#pragma COLUMNS 10000" - else - PRAGMA_COLUMNS= - fi - - - - @@ -19735,17 +19792,6 @@ fi -ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default" -if test "x$ac_cv_type_mode_t" = x""yes; then : - -else - -cat >>confdefs.h <<_ACEOF -#define mode_t int -_ACEOF - -fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timespec in " >&5 @@ -20113,6 +20159,74 @@ $as_echo "#define HAVE_STRUCT_UTIMBUF 1" >>confdefs.h +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking type of array argument to getgroups" >&5 +$as_echo_n "checking type of array argument to getgroups... " >&6; } +if test "${ac_cv_type_getgroups+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + ac_cv_type_getgroups=cross +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Thanks to Mike Rendell for this test. */ +$ac_includes_default +#define NGID 256 +#undef MAX +#define MAX(x, y) ((x) > (y) ? (x) : (y)) + +int +main () +{ + gid_t gidset[NGID]; + int i, n; + union { gid_t gval; long int lval; } val; + + val.lval = -1; + for (i = 0; i < NGID; i++) + gidset[i] = val.gval; + n = getgroups (sizeof (gidset) / MAX (sizeof (int), sizeof (gid_t)) - 1, + gidset); + /* Exit non-zero if getgroups seems to require an array of ints. This + happens when gid_t is short int but getgroups modifies an array + of ints. */ + return n > 0 && gidset[n] != val.gval; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_type_getgroups=gid_t +else + ac_cv_type_getgroups=int +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +if test $ac_cv_type_getgroups = cross; then + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "getgroups.*int.*gid_t" >/dev/null 2>&1; then : + ac_cv_type_getgroups=gid_t +else + ac_cv_type_getgroups=int +fi +rm -f conftest* + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_getgroups" >&5 +$as_echo "$ac_cv_type_getgroups" >&6; } + +cat >>confdefs.h <<_ACEOF +#define GETGROUPS_T $ac_cv_type_getgroups +_ACEOF + + + if false; then GL_COND_LIBTOOL_TRUE= @@ -20526,6 +20640,136 @@ fi + if test $ac_cv_func_faccessat = no; then + HAVE_FACCESSAT=0 + fi + + if test $HAVE_FACCESSAT = 0; then + + + + + + + + + gl_LIBOBJS="$gl_LIBOBJS faccessat.$ac_objext" + + + for ac_func in access +do : + ac_fn_c_check_func "$LINENO" "access" "ac_cv_func_access" +if test "x$ac_cv_func_access" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_ACCESS 1 +_ACEOF + +fi +done + + + fi + + +cat >>confdefs.h <<_ACEOF +#define GNULIB_FACCESSAT 1 +_ACEOF + + + + + + + + GNULIB_FACCESSAT=1 + + + + + + + + + + + + + + + + + if test $gl_cv_have_include_next = yes; then + gl_cv_next_fcntl_h='<'fcntl.h'>' + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 +$as_echo_n "checking absolute name of ... " >&6; } +if test "${gl_cv_next_fcntl_h+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF + case "$host_os" in + aix*) gl_absname_cpp="$ac_cpp -C" ;; + *) gl_absname_cpp="$ac_cpp" ;; + esac + + case "$host_os" in + mingw*) + gl_dirsep_regex='[/\\]' + ;; + *) + gl_dirsep_regex='\/' + ;; + esac + gl_make_literal_regex_sed='s,[]$^\\.*/[],\\&,g' + + gl_header_literal_regex=`echo 'fcntl.h' \ + | sed -e "$gl_make_literal_regex_sed"` + gl_absolute_header_sed="/${gl_dirsep_regex}${gl_header_literal_regex}/"'{ + s/.*"\(.*'"${gl_dirsep_regex}${gl_header_literal_regex}"'\)".*/\1/ + s|^/[^/]|//&| + p + q + }' + gl_cv_next_fcntl_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | + sed -n "$gl_absolute_header_sed"`'"' + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_fcntl_h" >&5 +$as_echo "$gl_cv_next_fcntl_h" >&6; } + fi + NEXT_FCNTL_H=$gl_cv_next_fcntl_h + + if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then + # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next' + gl_next_as_first_directive='<'fcntl.h'>' + else + # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' + gl_next_as_first_directive=$gl_cv_next_fcntl_h + fi + NEXT_AS_FIRST_DIRECTIVE_FCNTL_H=$gl_next_as_first_directive + + + + + + + + + + + + + + + + + fp_headers=' # include @@ -24124,108 +24368,630 @@ $as_echo "#define FUTIMESAT_NULL_BUG 1" >>confdefs.h fi gl_gnulib_enabled_dosname=false + gl_gnulib_enabled_euidaccess=false + gl_gnulib_enabled_getgroups=false gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false + gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false gl_gnulib_enabled_pathmax=false + gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false gl_gnulib_enabled_stat=false gl_gnulib_enabled_strtoll=false gl_gnulib_enabled_strtoull=false gl_gnulib_enabled_verify=false + gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false func_gl_gnulib_m4code_dosname () { if ! $gl_gnulib_enabled_dosname; then gl_gnulib_enabled_dosname=true fi } - func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 () + func_gl_gnulib_m4code_euidaccess () { - if ! $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then + if ! $gl_gnulib_enabled_euidaccess; then - gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true - fi - } - func_gl_gnulib_m4code_pathmax () - { - if ! $gl_gnulib_enabled_pathmax; then - gl_gnulib_enabled_pathmax=true - fi - } - func_gl_gnulib_m4code_stat () - { - if ! $gl_gnulib_enabled_stat; then + for ac_func in euidaccess +do : + ac_fn_c_check_func "$LINENO" "euidaccess" "ac_cv_func_euidaccess" +if test "x$ac_cv_func_euidaccess" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_EUIDACCESS 1 +_ACEOF +fi +done + if test $ac_cv_func_euidaccess = no; then + HAVE_EUIDACCESS=0 + fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat handles trailing slashes on directories" >&5 -$as_echo_n "checking whether stat handles trailing slashes on directories... " >&6; } -if test "${gl_cv_func_stat_dir_slash+set}" = set; then : + if test $HAVE_EUIDACCESS = 0; then + + + + + + + + + gl_LIBOBJS="$gl_LIBOBJS euidaccess.$ac_objext" + + + + for ac_header in libgen.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "libgen.h" "ac_cv_header_libgen_h" "$ac_includes_default" +if test "x$ac_cv_header_libgen_h" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBGEN_H 1 +_ACEOF + +fi + +done + + + ac_fn_c_check_func "$LINENO" "getgroups" "ac_cv_func_getgroups" +if test "x$ac_cv_func_getgroups" = x""yes; then : + +fi + + + # If we don't yet have getgroups, see if it's in -lbsd. + # This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1. + ac_save_LIBS=$LIBS + if test $ac_cv_func_getgroups = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgroups in -lbsd" >&5 +$as_echo_n "checking for getgroups in -lbsd... " >&6; } +if test "${ac_cv_lib_bsd_getgroups+set}" = set; then : $as_echo_n "(cached) " >&6 else - if test "$cross_compiling" = yes; then : - case $host_os in - mingw*) gl_cv_func_stat_dir_slash="guessing no";; - *) gl_cv_func_stat_dir_slash="guessing yes";; - esac -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + ac_check_lib_save_LIBS=$LIBS +LIBS="-lbsd $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#include +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char getgroups (); int main () { -struct stat st; return stat (".", &st) != stat ("./", &st); +return getgroups (); ; return 0; } _ACEOF -if ac_fn_c_try_run "$LINENO"; then : - gl_cv_func_stat_dir_slash=yes +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_bsd_getgroups=yes else - gl_cv_func_stat_dir_slash=no + ac_cv_lib_bsd_getgroups=no fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS fi - +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bsd_getgroups" >&5 +$as_echo "$ac_cv_lib_bsd_getgroups" >&6; } +if test "x$ac_cv_lib_bsd_getgroups" = x""yes; then : + GETGROUPS_LIB=-lbsd fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_stat_dir_slash" >&5 -$as_echo "$gl_cv_func_stat_dir_slash" >&6; } - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat handles trailing slashes on files" >&5 -$as_echo_n "checking whether stat handles trailing slashes on files... " >&6; } -if test "${gl_cv_func_stat_file_slash+set}" = set; then : + + fi + + # Run the program to test the functionality of the system-supplied + # getgroups function only if there is such a function. + if test $ac_cv_func_getgroups = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working getgroups" >&5 +$as_echo_n "checking for working getgroups... " >&6; } +if test "${ac_cv_func_getgroups_works+set}" = set; then : $as_echo_n "(cached) " >&6 else - touch conftest.tmp - # Assume that if we have lstat, we can also check symlinks. - if test $ac_cv_func_lstat = yes; then - ln -s conftest.tmp conftest.lnk - fi - if test "$cross_compiling" = yes; then : - case "$host_os" in + if test "$cross_compiling" = yes; then : + case "$host_os" in # (( # Guess yes on glibc systems. - *-gnu*) gl_cv_func_stat_file_slash="guessing yes" ;; + *-gnu*) ac_cv_func_getgroups_works="guessing yes" ;; # If we don't know, assume the worst. - *) gl_cv_func_stat_file_slash="guessing no" ;; + *) ac_cv_func_getgroups_works="guessing no" ;; esac else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#include - +$ac_includes_default int main () { -int result = 0; - struct stat st; - if (!stat ("conftest.tmp/", &st)) - result |= 1; -#if HAVE_LSTAT - if (!stat ("conftest.lnk/", &st)) +/* On Ultrix 4.3, getgroups (0, 0) always fails. */ + return getgroups (0, 0) == -1; + ; + return 0; +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_func_getgroups_works=yes +else + ac_cv_func_getgroups_works=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getgroups_works" >&5 +$as_echo "$ac_cv_func_getgroups_works" >&6; } + else + ac_cv_func_getgroups_works=no + fi + case "$ac_cv_func_getgroups_works" in + *yes) + +$as_echo "#define HAVE_GETGROUPS 1" >>confdefs.h + + ;; + esac + LIBS=$ac_save_LIBS + + + # Solaris 9 and 10 need -lgen to get the eaccess function. + # Save and restore LIBS so -lgen isn't added to it. Otherwise, *all* + # programs in the package would end up linked with that potentially-shared + # library, inducing unnecessary run-time overhead. + LIB_EACCESS= + + gl_saved_libs=$LIBS + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing eaccess" >&5 +$as_echo_n "checking for library containing eaccess... " >&6; } +if test "${ac_cv_search_eaccess+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char eaccess (); +int +main () +{ +return eaccess (); + ; + return 0; +} +_ACEOF +for ac_lib in '' gen; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if ac_fn_c_try_link "$LINENO"; then : + ac_cv_search_eaccess=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext + if test "${ac_cv_search_eaccess+set}" = set; then : + break +fi +done +if test "${ac_cv_search_eaccess+set}" = set; then : + +else + ac_cv_search_eaccess=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_eaccess" >&5 +$as_echo "$ac_cv_search_eaccess" >&6; } +ac_res=$ac_cv_search_eaccess +if test "$ac_res" != no; then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + test "$ac_cv_search_eaccess" = "none required" || + LIB_EACCESS=$ac_cv_search_eaccess +fi + + for ac_func in eaccess +do : + ac_fn_c_check_func "$LINENO" "eaccess" "ac_cv_func_eaccess" +if test "x$ac_cv_func_eaccess" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_EACCESS 1 +_ACEOF + +fi +done + + LIBS=$gl_saved_libs + + fi + + + + + + GNULIB_EUIDACCESS=1 + + + + + + gl_gnulib_enabled_euidaccess=true + if test $HAVE_EUIDACCESS = 0; then + func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1 + fi + func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c + if test $HAVE_EUIDACCESS = 0; then + func_gl_gnulib_m4code_stat + fi + fi + } + func_gl_gnulib_m4code_getgroups () + { + if ! $gl_gnulib_enabled_getgroups; then + + + + + + ac_fn_c_check_func "$LINENO" "getgroups" "ac_cv_func_getgroups" +if test "x$ac_cv_func_getgroups" = x""yes; then : + +fi + + + # If we don't yet have getgroups, see if it's in -lbsd. + # This is reported to be necessary on an ITOS 3000WS running SEIUX 3.1. + ac_save_LIBS=$LIBS + if test $ac_cv_func_getgroups = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgroups in -lbsd" >&5 +$as_echo_n "checking for getgroups in -lbsd... " >&6; } +if test "${ac_cv_lib_bsd_getgroups+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lbsd $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char getgroups (); +int +main () +{ +return getgroups (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_bsd_getgroups=yes +else + ac_cv_lib_bsd_getgroups=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bsd_getgroups" >&5 +$as_echo "$ac_cv_lib_bsd_getgroups" >&6; } +if test "x$ac_cv_lib_bsd_getgroups" = x""yes; then : + GETGROUPS_LIB=-lbsd +fi + + fi + + # Run the program to test the functionality of the system-supplied + # getgroups function only if there is such a function. + if test $ac_cv_func_getgroups = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working getgroups" >&5 +$as_echo_n "checking for working getgroups... " >&6; } +if test "${ac_cv_func_getgroups_works+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + case "$host_os" in # (( + # Guess yes on glibc systems. + *-gnu*) ac_cv_func_getgroups_works="guessing yes" ;; + # If we don't know, assume the worst. + *) ac_cv_func_getgroups_works="guessing no" ;; + esac + +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +/* On Ultrix 4.3, getgroups (0, 0) always fails. */ + return getgroups (0, 0) == -1; + ; + return 0; +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_func_getgroups_works=yes +else + ac_cv_func_getgroups_works=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getgroups_works" >&5 +$as_echo "$ac_cv_func_getgroups_works" >&6; } + else + ac_cv_func_getgroups_works=no + fi + case "$ac_cv_func_getgroups_works" in + *yes) + +$as_echo "#define HAVE_GETGROUPS 1" >>confdefs.h + + ;; + esac + LIBS=$ac_save_LIBS + + if test $ac_cv_func_getgroups != yes; then + HAVE_GETGROUPS=0 + else + if test "$ac_cv_type_getgroups" != gid_t \ + || { case "$ac_cv_func_getgroups_works" in + *yes) false;; + *) true;; + esac + }; then + REPLACE_GETGROUPS=1 + +$as_echo "#define GETGROUPS_ZERO_BUG 1" >>confdefs.h + + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getgroups handles negative values" >&5 +$as_echo_n "checking whether getgroups handles negative values... " >&6; } +if test "${gl_cv_func_getgroups_works+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + case "$host_os" in + # Guess yes on glibc systems. + *-gnu*) gl_cv_func_getgroups_works="guessing yes" ;; + # If we don't know, assume the worst. + *) gl_cv_func_getgroups_works="guessing no" ;; + esac + +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +int size = getgroups (0, 0); + gid_t *list = malloc (size * sizeof *list); + return getgroups (-1, list) != -1; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + gl_cv_func_getgroups_works=yes +else + gl_cv_func_getgroups_works=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_getgroups_works" >&5 +$as_echo "$gl_cv_func_getgroups_works" >&6; } + case "$gl_cv_func_getgroups_works" in + *yes) ;; + *) REPLACE_GETGROUPS=1 ;; + esac + fi + fi + test -n "$GETGROUPS_LIB" && LIBS="$GETGROUPS_LIB $LIBS" + + if test $HAVE_GETGROUPS = 0 || test $REPLACE_GETGROUPS = 1; then + + + + + + + + + gl_LIBOBJS="$gl_LIBOBJS getgroups.$ac_objext" + + fi + + + + + + GNULIB_GETGROUPS=1 + + + + + + gl_gnulib_enabled_getgroups=true + fi + } + func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 () + { + if ! $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then + + + gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=true + fi + } + func_gl_gnulib_m4code_a9786850e999ae65a836a6041e8e5ed1 () + { + if ! $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then + + + + + + ac_fn_c_check_func "$LINENO" "group_member" "ac_cv_func_group_member" +if test "x$ac_cv_func_group_member" = x""yes; then : + +else + + HAVE_GROUP_MEMBER=0 + +fi + + + if test $HAVE_GROUP_MEMBER = 0; then + + + + + + + + + gl_LIBOBJS="$gl_LIBOBJS group-member.$ac_objext" + + + + + fi + + + + + + GNULIB_GROUP_MEMBER=1 + + + + + + gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=true + if test $HAVE_GROUP_MEMBER = 0; then + func_gl_gnulib_m4code_getgroups + fi + if test $HAVE_GROUP_MEMBER = 0; then + func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec + fi + fi + } + func_gl_gnulib_m4code_pathmax () + { + if ! $gl_gnulib_enabled_pathmax; then + + + + gl_gnulib_enabled_pathmax=true + fi + } + func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c () + { + if ! $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then + gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=true + fi + } + func_gl_gnulib_m4code_stat () + { + if ! $gl_gnulib_enabled_stat; then + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat handles trailing slashes on directories" >&5 +$as_echo_n "checking whether stat handles trailing slashes on directories... " >&6; } +if test "${gl_cv_func_stat_dir_slash+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + case $host_os in + mingw*) gl_cv_func_stat_dir_slash="guessing no";; + *) gl_cv_func_stat_dir_slash="guessing yes";; + esac +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +int +main () +{ +struct stat st; return stat (".", &st) != stat ("./", &st); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + gl_cv_func_stat_dir_slash=yes +else + gl_cv_func_stat_dir_slash=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_stat_dir_slash" >&5 +$as_echo "$gl_cv_func_stat_dir_slash" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat handles trailing slashes on files" >&5 +$as_echo_n "checking whether stat handles trailing slashes on files... " >&6; } +if test "${gl_cv_func_stat_file_slash+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + touch conftest.tmp + # Assume that if we have lstat, we can also check symlinks. + if test $ac_cv_func_lstat = yes; then + ln -s conftest.tmp conftest.lnk + fi + if test "$cross_compiling" = yes; then : + case "$host_os" in + # Guess yes on glibc systems. + *-gnu*) gl_cv_func_stat_file_slash="guessing yes" ;; + # If we don't know, assume the worst. + *) gl_cv_func_stat_file_slash="guessing no" ;; + esac + +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +int +main () +{ +int result = 0; + struct stat st; + if (!stat ("conftest.tmp/", &st)) + result |= 1; +#if HAVE_LSTAT + if (!stat ("conftest.lnk/", &st)) result |= 2; #endif return result; @@ -24409,6 +25175,18 @@ done gl_gnulib_enabled_verify=true fi } + func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec () + { + if ! $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then + gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=true + fi + } + if test $HAVE_FACCESSAT = 0; then + func_gl_gnulib_m4code_dosname + fi + if test $HAVE_FACCESSAT = 0; then + func_gl_gnulib_m4code_euidaccess + fi if test $REPLACE_GETOPT = 1; then func_gl_gnulib_m4code_be453cec5eecf5731a274f2de7f2db36 fi @@ -24442,6 +25220,22 @@ else gl_GNULIB_ENABLED_dosname_FALSE= fi + if $gl_gnulib_enabled_euidaccess; then + gl_GNULIB_ENABLED_euidaccess_TRUE= + gl_GNULIB_ENABLED_euidaccess_FALSE='#' +else + gl_GNULIB_ENABLED_euidaccess_TRUE='#' + gl_GNULIB_ENABLED_euidaccess_FALSE= +fi + + if $gl_gnulib_enabled_getgroups; then + gl_GNULIB_ENABLED_getgroups_TRUE= + gl_GNULIB_ENABLED_getgroups_FALSE='#' +else + gl_GNULIB_ENABLED_getgroups_TRUE='#' + gl_GNULIB_ENABLED_getgroups_FALSE= +fi + if $gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36; then gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE= gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE='#' @@ -24450,6 +25244,14 @@ else gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE= fi + if $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then + gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE= + gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE='#' +else + gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE='#' + gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE= +fi + if $gl_gnulib_enabled_pathmax; then gl_GNULIB_ENABLED_pathmax_TRUE= gl_GNULIB_ENABLED_pathmax_FALSE='#' @@ -24458,6 +25260,14 @@ else gl_GNULIB_ENABLED_pathmax_FALSE= fi + if $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then + gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE= + gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE='#' +else + gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE='#' + gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE= +fi + if $gl_gnulib_enabled_stat; then gl_GNULIB_ENABLED_stat_TRUE= gl_GNULIB_ENABLED_stat_FALSE='#' @@ -24490,6 +25300,14 @@ else gl_GNULIB_ENABLED_verify_FALSE= fi + if $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then + gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE= + gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE='#' +else + gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE='#' + gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE= +fi + # End of code from modules @@ -24970,14 +25788,30 @@ if test -z "${gl_GNULIB_ENABLED_dosname_TRUE}" && test -z "${gl_GNULIB_ENABLED_d as_fn_error "conditional \"gl_GNULIB_ENABLED_dosname\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 fi +if test -z "${gl_GNULIB_ENABLED_euidaccess_TRUE}" && test -z "${gl_GNULIB_ENABLED_euidaccess_FALSE}"; then + as_fn_error "conditional \"gl_GNULIB_ENABLED_euidaccess\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${gl_GNULIB_ENABLED_getgroups_TRUE}" && test -z "${gl_GNULIB_ENABLED_getgroups_FALSE}"; then + as_fn_error "conditional \"gl_GNULIB_ENABLED_getgroups\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi if test -z "${gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_TRUE}" && test -z "${gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36_FALSE}"; then as_fn_error "conditional \"gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 fi +if test -z "${gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_TRUE}" && test -z "${gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_FALSE}"; then + as_fn_error "conditional \"gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi if test -z "${gl_GNULIB_ENABLED_pathmax_TRUE}" && test -z "${gl_GNULIB_ENABLED_pathmax_FALSE}"; then as_fn_error "conditional \"gl_GNULIB_ENABLED_pathmax\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 fi +if test -z "${gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_TRUE}" && test -z "${gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c_FALSE}"; then + as_fn_error "conditional \"gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi if test -z "${gl_GNULIB_ENABLED_stat_TRUE}" && test -z "${gl_GNULIB_ENABLED_stat_FALSE}"; then as_fn_error "conditional \"gl_GNULIB_ENABLED_stat\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 @@ -24993,6 +25827,10 @@ fi if test -z "${gl_GNULIB_ENABLED_verify_TRUE}" && test -z "${gl_GNULIB_ENABLED_verify_FALSE}"; then as_fn_error "conditional \"gl_GNULIB_ENABLED_verify\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_TRUE}" && test -z "${gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec_FALSE}"; then + as_fn_error "conditional \"gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 fi gl_libobjs= -- cgit v1.2.1 From c62792e7dfa403db8c36cb92f32fb69258a199ef Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 14 Nov 2012 16:17:21 +0400 Subject: * lisp/progmodes/ruby-mode.el (ruby-syntax-propertize-function): After everything else, search for expansions in string literals, mark their insides as whitespace syntax and save match data for font-lock. (ruby-font-lock-keywords): Highlight just the 2nd group from expression expansion matches. (ruby-match-expression-expansion): Use the match data saved to the text property in ruby-syntax-propertize-function. * test/automated/ruby-mode-tests.el Change direct font-lock face references to var references. (ruby-interpolation-suppresses-syntax-inside): New test. (ruby-interpolation-inside-percent-literal-with-paren): New failing test. --- lisp/ChangeLog | 9 +++++++++ lisp/progmodes/ruby-mode.el | 32 ++++++++++++++++++++++++++------ test/ChangeLog | 4 ++++ test/automated/ruby-mode-tests.el | 30 +++++++++++++++++++++++------- 4 files changed, 62 insertions(+), 13 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 19623bd06b7..99bfabb8115 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -2,6 +2,15 @@ * progmodes/ruby-mode.el (ruby-expr-beg): Make heredoc detection more strict. Add docstring. + (ruby-expression-expansion-re): Extract from + `ruby-match-expression-expansion'. + (ruby-syntax-propertize-function): After everything else, search + for expansions in string literals, mark their insides as + whitespace syntax and save match data for font-lock. + (ruby-font-lock-keywords): Use the 2nd group from expression + expansion matches. + (ruby-match-expression-expansion): Use the match data saved to the + text property in ruby-syntax-propertize-function. 2012-11-14 Stefan Monnier diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 686bec89a95..9d78b20ba4c 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -105,7 +105,10 @@ (eval-and-compile (defconst ruby-here-doc-beg-re "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)" - "Regexp to match the beginning of a heredoc.")) + "Regexp to match the beginning of a heredoc.") + + (defconst ruby-expression-expansion-re + "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)")) (defun ruby-here-doc-end-match () "Return a regexp to find the end of a heredoc. @@ -1249,7 +1252,19 @@ It will be properly highlighted even when the call omits parens.")) ;; Handle percent literals: %w(), %q{}, etc. ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re) (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end))))) - (point) end)) + (point) end) + (remove-text-properties start end '(ruby-expansion-match-data)) + (goto-char start) + ;; Find all expression expansions and + ;; - set the syntax of all text inside to whitespace, + ;; - save the match data to a text property, for font-locking later. + (while (re-search-forward ruby-expression-expansion-re end 'move) + (when (ruby-in-ppss-context-p 'string) + (put-text-property (match-beginning 2) (match-end 2) + 'syntax-table (string-to-syntax "-")) + (put-text-property (match-beginning 2) (1+ (match-beginning 2)) + 'ruby-expansion-match-data + (match-data))))) (defun ruby-syntax-propertize-heredoc (limit) (let ((ppss (syntax-ppss)) @@ -1582,7 +1597,7 @@ See `font-lock-syntax-table'.") '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face) ;; expression expansion '(ruby-match-expression-expansion - 0 font-lock-variable-name-face t) + 2 font-lock-variable-name-face t) ;; warn lower camel case ;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)" ; 0 font-lock-warning-face) @@ -1590,9 +1605,14 @@ See `font-lock-syntax-table'.") "Additional expressions to highlight in Ruby mode.") (defun ruby-match-expression-expansion (limit) - (when (re-search-forward "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)" limit 'move) - (or (ruby-in-ppss-context-p 'string) - (ruby-match-expression-expansion limit)))) + (let ((prop 'ruby-expansion-match-data) pos value) + (when (and (setq pos (next-single-char-property-change (point) prop + nil limit)) + (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos prop)) + (progn (set-match-data value) t)) + (ruby-match-expression-expansion limit))))) ;;;###autoload (define-derived-mode ruby-mode prog-mode "Ruby" diff --git a/test/ChangeLog b/test/ChangeLog index 5a796408a3b..f11325d0318 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -3,6 +3,10 @@ * automated/ruby-mode-tests.el (ruby-indent-singleton-class): Pass. (ruby-indent-inside-heredoc-after-operator) (ruby-indent-inside-heredoc-after-space): New tests. + Change direct font-lock face references to var references. + (ruby-interpolation-suppresses-syntax-inside): New test. + (ruby-interpolation-inside-percent-literal-with-paren): New + failing test. 2012-11-13 Dmitry Gutov diff --git a/test/automated/ruby-mode-tests.el b/test/automated/ruby-mode-tests.el index 7d633be0f53..ad48413b030 100644 --- a/test/automated/ruby-mode-tests.el +++ b/test/automated/ruby-mode-tests.el @@ -80,7 +80,7 @@ VALUES-PLIST is a list with alternating index and value elements." (ert-deftest ruby-heredoc-font-lock () (let ((s "foo <
  • #{@files.join(\"
  • \")}
    • \"")) + (ruby-assert-state s 8 nil) + (ruby-assert-face s 9 font-lock-string-face) + (ruby-assert-face s 10 font-lock-variable-name-face) + (ruby-assert-face s 41 font-lock-string-face))) + +(ert-deftest ruby-interpolation-inside-percent-literal-with-paren () + :expected-result :failed + (let ((s "%(^#{\")\"}^)")) + (ruby-assert-face s 3 font-lock-string-face) + (ruby-assert-face s 4 font-lock-variable-name-face) + (ruby-assert-face s 10 font-lock-string-face) + ;; It's confused by the closing paren in the middle. + (ruby-assert-state s 8 nil))) (ert-deftest ruby-add-log-current-method-examples () (let ((pairs '(("foo" . "#foo") -- cgit v1.2.1 From 730b2d8f6b5851dc462b79b8bd48068c1b9f1932 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 14 Nov 2012 18:41:43 +0200 Subject: Clean up w32 timer thread code in the hope of solving bug #12832. src/w32proc.c (timer_loop): Make sure SuspendThread and ResumeThread use the same value of thread handle. (start_timer_thread): If the timer thread exited (due to error), clean up by closing the two handles it used. Duplicate the caller thread's handle here, so it gets duplicated only once, when launching the timer thread. Set priority of the timer thread, not the caller thread. (getitimer): Don't duplicate the caller thread's handle here. --- src/ChangeLog | 12 ++++++++++++ src/w32proc.c | 38 ++++++++++++++++++++++++++------------ 2 files changed, 38 insertions(+), 12 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index d72091c0ed6..9caa5113444 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,15 @@ +2012-11-14 Eli Zaretskii + + * w32proc.c (timer_loop): Make sure SuspendThread and ResumeThread + use the same value of thread handle. + (start_timer_thread): If the timer thread exited (due to error), + clean up by closing the two handles it used. Duplicate the caller + thread's handle here, so it gets duplicated only once, when + launching the timer thread. Set priority of the timer thread, not + the caller thread. + (getitimer): Don't duplicate the caller thread's handle here. + (Bug#12832) + 2012-11-13 Jan Djärv * nsterm.m (hold_event): Send SIGIO to make sure ns_read_socket is diff --git a/src/w32proc.c b/src/w32proc.c index adef7651b8c..e3c54fe5460 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -425,13 +425,14 @@ timer_loop (LPVOID arg) /* Simulate a signal delivered to the thread which installed the timer, by suspending that thread while the handler runs. */ - DWORD result = SuspendThread (itimer->caller_thread); + HANDLE th = itimer->caller_thread; + DWORD result = SuspendThread (th); if (result == (DWORD)-1) return 2; handler (sig); - ResumeThread (itimer->caller_thread); + ResumeThread (th); } /* Update expiration time and loop. */ @@ -556,6 +557,7 @@ static int start_timer_thread (int which) { DWORD exit_code; + HANDLE th; struct itimer_data *itimer = (which == ITIMER_REAL) ? &real_itimer : &prof_itimer; @@ -564,9 +566,29 @@ start_timer_thread (int which) && exit_code == STILL_ACTIVE) return 0; + /* Clean up after possibly exited thread. */ + if (itimer->timer_thread) + { + CloseHandle (itimer->timer_thread); + itimer->timer_thread = NULL; + } + if (itimer->caller_thread) + { + CloseHandle (itimer->caller_thread); + itimer->caller_thread = NULL; + } + /* Start a new thread. */ + if (!DuplicateHandle (GetCurrentProcess (), GetCurrentThread (), + GetCurrentProcess (), &th, 0, FALSE, + DUPLICATE_SAME_ACCESS)) + { + errno = ESRCH; + return -1; + } itimer->terminate = 0; itimer->type = which; + itimer->caller_thread = th; /* Request that no more than 64KB of stack be reserved for this thread, to avoid reserving too much memory, which would get in the way of threads we start to wait for subprocesses. See also @@ -585,7 +607,7 @@ start_timer_thread (int which) /* This is needed to make sure that the timer thread running for profiling gets CPU as soon as the Sleep call terminates. */ if (which == ITIMER_PROF) - SetThreadPriority (itimer->caller_thread, THREAD_PRIORITY_TIME_CRITICAL); + SetThreadPriority (itimer->timer_thread, THREAD_PRIORITY_TIME_CRITICAL); return 0; } @@ -620,17 +642,9 @@ getitimer (int which, struct itimerval *value) itimer = (which == ITIMER_REAL) ? &real_itimer : &prof_itimer; - if (!DuplicateHandle (GetCurrentProcess (), GetCurrentThread (), - GetCurrentProcess (), &itimer->caller_thread, 0, - FALSE, DUPLICATE_SAME_ACCESS)) - { - errno = ESRCH; - return -1; - } - ticks_now = w32_get_timer_time ((which == ITIMER_REAL) ? NULL - : itimer->caller_thread); + : GetCurrentThread ()); t_expire = &itimer->expire; t_reload = &itimer->reload; -- cgit v1.2.1 From 14f207289c224b3ad12fc8704c2183ef8fbcab28 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 14 Nov 2012 19:22:55 +0200 Subject: MS-Windows followup for 2012-11-14T04:55:41Z!eggert@cs.ucla.edu, regarding faccessat. nt/inc/unistd.h (faccessat): Add prototype. (AT_FDCWD, AT_EACCESS, AT_SYMLINK_NOFOLLOW): New macros; the first 2 moved from ms-w32.h. nt/inc/ms-w32.h (AT_FDCWD, AT_EACCESS, faccessat): Remove macros. src/w32.c (faccessat): Rename from sys_faccessat. (No need to use a different name, as the MS runtime does not have such a function, and probably never will.) All callers changed. Ignore DIRFD value if PATH is an absolute file name, to match Posix spec better. If AT_SYMLINK_NOFOLLOW is set in FLAGS, don't resolve symlinks. Fixes: debbugs:12632 --- nt/ChangeLog | 8 ++++++++ nt/inc/ms-w32.h | 5 ----- nt/inc/unistd.h | 8 ++++++++ src/ChangeLog | 9 +++++++++ src/w32.c | 30 +++++++++++++++++------------- 5 files changed, 42 insertions(+), 18 deletions(-) diff --git a/nt/ChangeLog b/nt/ChangeLog index 320c9e6366e..685e291e272 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,11 @@ +2012-11-14 Eli Zaretskii + + * inc/unistd.h (faccessat): Add prototype. + (AT_FDCWD, AT_EACCESS, AT_SYMLINK_NOFOLLOW): New macros; the first + 2 moved from ms-w32.h. + + * inc/ms-w32.h (AT_FDCWD, AT_EACCESS, faccessat): Remove macros. + 2012-11-14 Paul Eggert Use faccessat, not access, when checking file permissions (Bug#12632). diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 0f6b51d3915..1b2a309e1be 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -124,10 +124,6 @@ extern char *getenv (); #define MAXPATHLEN _MAX_PATH #endif -/* Use values compatible with gnulib, as there's no reason to differ. */ -#define AT_FDCWD (-3041965) -#define AT_EACCESS 4 - #ifdef HAVE_NTGUI #define HAVE_WINDOW_SYSTEM 1 #define HAVE_MENUS 1 @@ -163,7 +159,6 @@ extern char *getenv (); #define dup sys_dup #undef dup2 #define dup2 sys_dup2 -#define faccessat sys_faccessat #define fopen sys_fopen #define link sys_link #define localtime sys_localtime diff --git a/nt/inc/unistd.h b/nt/inc/unistd.h index 4c5f7d4c124..b0f3092cafb 100644 --- a/nt/inc/unistd.h +++ b/nt/inc/unistd.h @@ -18,4 +18,12 @@ extern pid_t getpgrp (void); extern pid_t setsid (void); extern pid_t tcgetpgrp (int); +extern int faccessat (int, char const *, int, int); + +/* These are normally on fcntl.h, but we don't override that header. */ +/* Use values compatible with gnulib, as there's no reason to differ. */ +#define AT_FDCWD (-3041965) +#define AT_EACCESS 4 +#define AT_SYMLINK_NOFOLLOW 4096 + #endif /* _UNISTD_H */ diff --git a/src/ChangeLog b/src/ChangeLog index 99f3128b321..ec8f7e219f7 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,12 @@ +2012-11-14 Eli Zaretskii + + * w32.c (faccessat): Rename from sys_faccessat. (No need to use a + different name, as the MS runtime does not have such a function, + and probably never will.) All callers changed. Ignore DIRFD + value if PATH is an absolute file name, to match Posix spec + better. If AT_SYMLINK_NOFOLLOW is set in FLAGS, don't resolve + symlinks. + 2012-11-14 Dmitry Antipov * xdisp.c (echo_area_display, redisplay_internal): diff --git a/src/w32.c b/src/w32.c index 0e7da449b81..eb07e13a2fb 100644 --- a/src/w32.c +++ b/src/w32.c @@ -1597,7 +1597,7 @@ init_environment (char ** argv) see if it succeeds. But I think that's too much to ask. */ /* MSVCRT's _access crashes with D_OK. */ - if (tmp && sys_faccessat (AT_FDCWD, tmp, D_OK, AT_EACCESS) == 0) + if (tmp && faccessat (AT_FDCWD, tmp, D_OK, AT_EACCESS) == 0) { char * var = alloca (strlen (tmp) + 8); sprintf (var, "TMPDIR=%s", tmp); @@ -2708,17 +2708,15 @@ logon_network_drive (const char *path) WNetAddConnection2 (&resource, NULL, NULL, CONNECT_INTERACTIVE); } -/* Shadow some MSVC runtime functions to map requests for long filenames - to reasonable short names if necessary. This was originally added to - permit running Emacs on NT 3.1 on a FAT partition, which doesn't support - long file names. */ - +/* Emulate faccessat(2). */ int -sys_faccessat (int dirfd, const char * path, int mode, int flags) +faccessat (int dirfd, const char * path, int mode, int flags) { DWORD attributes; - if (dirfd != AT_FDCWD) + if (dirfd != AT_FDCWD + && !(IS_DIRECTORY_SEP (path[0]) + || IS_DEVICE_SEP (path[1]))) { errno = EBADF; return -1; @@ -2731,7 +2729,8 @@ sys_faccessat (int dirfd, const char * path, int mode, int flags) to get the attributes of its target file. Note: any symlinks in PATH elements other than the last one are transparently resolved by GetFileAttributes below. */ - if ((volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) != 0) + if ((volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) != 0 + && (flags & AT_SYMLINK_NOFOLLOW) == 0) path = chase_symlinks (path); if ((attributes = GetFileAttributes (path)) == -1) @@ -2781,6 +2780,11 @@ sys_faccessat (int dirfd, const char * path, int mode, int flags) return 0; } +/* Shadow some MSVC runtime functions to map requests for long filenames + to reasonable short names if necessary. This was originally added to + permit running Emacs on NT 3.1 on a FAT partition, which doesn't support + long file names. */ + int sys_chdir (const char * path) { @@ -2966,7 +2970,7 @@ sys_mktemp (char * template) { int save_errno = errno; p[0] = first_char[i]; - if (sys_faccessat (AT_FDCWD, template, F_OK, AT_EACCESS) < 0) + if (faccessat (AT_FDCWD, template, F_OK, AT_EACCESS) < 0) { errno = save_errno; return template; @@ -4017,7 +4021,7 @@ symlink (char const *filename, char const *linkname) { /* Non-absolute FILENAME is understood as being relative to LINKNAME's directory. We need to prepend that directory to - FILENAME to get correct results from sys_faccessat below, since + FILENAME to get correct results from faccessat below, since otherwise it will interpret FILENAME relative to the directory where the Emacs process runs. Note that make-symbolic-link always makes sure LINKNAME is a fully @@ -4031,10 +4035,10 @@ symlink (char const *filename, char const *linkname) strncpy (tem, linkfn, p - linkfn); tem[p - linkfn] = '\0'; strcat (tem, filename); - dir_access = sys_faccessat (AT_FDCWD, tem, D_OK, AT_EACCESS); + dir_access = faccessat (AT_FDCWD, tem, D_OK, AT_EACCESS); } else - dir_access = sys_faccessat (AT_FDCWD, filename, D_OK, AT_EACCESS); + dir_access = faccessat (AT_FDCWD, filename, D_OK, AT_EACCESS); /* Since Windows distinguishes between symlinks to directories and to files, we provide a kludgy feature: if FILENAME doesn't -- cgit v1.2.1 From 22b762c7e3b370c5d9e02b4369daa3177df30f60 Mon Sep 17 00:00:00 2001 From: David Engster Date: Wed, 14 Nov 2012 21:20:20 +0100 Subject: Merge bug fixes from CEDET upstream. * semantic/symref/list.el (semantic-symref-symbol): Use `semantic-complete-read-tag-project' instead of `semantic-complete-read-tag-buffer-deep', since the latter is not working correctly. * semantic/symref.el (semantic-symref-result-get-tags): Use `find-buffer-visiting' to follow symbolic links. * semantic/fw.el (semantic-find-file-noselect): Always set `enable-local-variables' to `:safe' when loading files. --- lisp/cedet/ChangeLog | 13 +++++++++++++ lisp/cedet/semantic/fw.el | 9 +-------- lisp/cedet/semantic/symref.el | 2 +- lisp/cedet/semantic/symref/list.el | 2 +- 4 files changed, 16 insertions(+), 10 deletions(-) diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 56207c7ae57..4bde3421f13 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,16 @@ +2012-11-14 David Engster + + * semantic/symref/list.el (semantic-symref-symbol): Use + `semantic-complete-read-tag-project' instead of + `semantic-complete-read-tag-buffer-deep', since the latter is not + working correctly. + + * semantic/symref.el (semantic-symref-result-get-tags): Use + `find-buffer-visiting' to follow symbolic links. + + * semantic/fw.el (semantic-find-file-noselect): Always set + `enable-local-variables' to `:safe' when loading files. + 2012-11-13 Glenn Morris * semantic/lex-spp.el (semantic-lex-spp-lex-text-string): diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 5a12047eb76..14ffc808c44 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -421,14 +421,7 @@ into `mode-local-init-hook'." file filename) ;; Don't prompt to insert a template if we visit an empty file (auto-insert nil) ;; We don't want emacs to query about unsafe local variables - (enable-local-variables - (if (featurep 'xemacs) - ;; XEmacs only has nil as an option? - nil - ;; Emacs 23 has the spiffy :safe option, nil otherwise. - (if (>= emacs-major-version 22) - nil - :safe))) + (enable-local-variables :safe) ;; ... or eval variables (enable-local-eval nil) ) diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index 540c766cc94..ad897680d7f 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -356,7 +356,7 @@ already." (lambda (hit) (let* ((line (car hit)) (file (cdr hit)) - (buff (get-file-buffer file)) + (buff (find-buffer-visiting file)) (tag nil) ) (cond diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index 55ccf1c103f..729bd8e153c 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -69,7 +69,7 @@ current project to find references to the input SYM. The references are organized by file and the name of the function they are used in. Display the references in `semantic-symref-results-mode'." - (interactive (list (semantic-tag-name (semantic-complete-read-tag-buffer-deep + (interactive (list (semantic-tag-name (semantic-complete-read-tag-project "Symrefs for: ")))) (semantic-fetch-tags) (let ((res nil) -- cgit v1.2.1 From 1668ea9062effeaf84e2fcf1e97c9b174c66a4ec Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 14 Nov 2012 15:27:42 -0500 Subject: * lisp/emacs-lisp/nadvice.el: Add around advice for interactive specs. (advice-eval-interactive-spec): New function. (advice--make-interactive-form): Support around advice. Fixes: debbugs:12844 --- lisp/ChangeLog | 6 +++++ lisp/emacs-lisp/nadvice.el | 66 ++++++++++++++++++++++++++++------------------ 2 files changed, 47 insertions(+), 25 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 99bfabb8115..01b7532e56d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2012-11-14 Stefan Monnier + + * emacs-lisp/nadvice.el: Add around advice for interactive specs. + (advice-eval-interactive-spec): New function. + (advice--make-interactive-form): Support around advice (bug#12844). + 2012-11-14 Dmitry Gutov * progmodes/ruby-mode.el (ruby-expr-beg): Make heredoc detection diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index ff30d9e7fa4..873a1695867 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -109,18 +109,33 @@ Each element has the form (WHERE BYTECODE STACK) where: (propertize "Advised function" 'dynamic-docstring-function #'advice--make-docstring)) ;; ) +(defun advice-eval-interactive-spec (spec) + "Evaluate the interactive spec SPEC." + (cond + ((stringp spec) + ;; There's no direct access to the C code (in call-interactively) that + ;; processes those specs, but that shouldn't stop us, should it? + ;; FIXME: Despite appearances, this is not faithful: SPEC and + ;; (advice-eval-interactive-spec SPEC) will behave subtly differently w.r.t + ;; command-history (and maybe a few other details). + (call-interactively `(lambda (&rest args) (interactive ,spec) args))) + ;; ((functionp spec) (funcall spec)) + (t (eval spec)))) + (defun advice--make-interactive-form (function main) - ;; TODO: Make it possible to do around-like advising on the - ;; interactive forms (bug#12844). ;; TODO: make it so that interactive spec can be a constant which ;; dynamically checks the advice--car/cdr to do its job. - ;; TODO: Implement interactive-read-args: - ;;(when (or (commandp function) (commandp main)) - ;; `(interactive-read-args - ;; (cadr (or (interactive-form function) (interactive-form main))))) - ;; FIXME: This loads autoloaded functions too eagerly. + ;; For that, advice-eval-interactive-spec needs to be more faithful. + ;; FIXME: The calls to interactive-form below load autoloaded functions + ;; too eagerly. + (let ((fspec (cadr (interactive-form function)))) + (when (eq 'function (car fspec)) ;; Macroexpanded lambda? + (setq fspec (nth 1 fspec))) + (if (functionp fspec) + `(funcall ',fspec + ',(cadr (interactive-form main))) (cadr (or (interactive-form function) - (interactive-form main)))) + (interactive-form main)))))) (defsubst advice--make-1 (byte-code stack-depth function main props) "Build a function value that adds FUNCTION to MAIN." @@ -197,7 +212,15 @@ call OLDFUN here: If FUNCTION was already added, do nothing. PROPS is an alist of additional properties, among which the following have a special meaning: -- `name': a string or symbol. It can be used to refer to this piece of advice." +- `name': a string or symbol. It can be used to refer to this piece of advice. + +If one of FUNCTION or OLDFUN is interactive, then the resulting function +is also interactive. There are 3 cases: +- FUNCTION is not interactive: the interactive spec of OLDFUN is used. +- The interactive spec of FUNCTION is itself a function: it should take one + argument (the interactive spec of OLDFUN, which it can pass to + `advice-eval-interactive-spec') and return the list of arguments to use. +- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN." (declare (debug t)) ;;(indent 2) `(advice--add-function ,where (gv-ref ,place) ,function ,props)) @@ -285,28 +308,21 @@ is defined as a macro, alias, command, ..." ;; - change all defadvice in lisp/**/*.el. ;; - rewrite advice.el on top of this. ;; - obsolete advice.el. - ;; To make advice.el and nadvice.el interoperate properly I see 2 different - ;; ways: - ;; - keep them separate: complete the defalias-fset-function setter with - ;; a matching accessor which both nadvice.el and advice.el will have to use - ;; in place of symbol-function. This can probably be made to work, but - ;; they have to agree on a "protocol". - ;; - layer advice.el on top of nadvice.el. I prefer this approach. the - ;; simplest way is to make advice.el build one ad-Advice-foo function for - ;; each advised function which is advice-added/removed whenever ad-activate - ;; ad-deactivate is called. (let* ((f (and (fboundp symbol) (symbol-function symbol))) (nf (advice--normalize symbol f))) (unless (eq f nf) ;; Most importantly, if nf == nil! (fset symbol nf)) (add-function where (cond ((eq (car-safe nf) 'macro) (cdr nf)) - ;; If the function is not yet defined, we can't yet - ;; install the advice. - ;; FIXME: If it's an autoloaded command, we also - ;; have a problem because we need to load the - ;; command to build the interactive-form. - ((or (not nf) (and (autoloadp nf))) ;; (commandp nf) + ;; Reasons to delay installation of the advice: + ;; - If the function is not yet defined, installing + ;; the advice would affect `fboundp'ness. + ;; - If it's an autoloaded command, + ;; advice--make-interactive-form would end up + ;; loading the command eagerly. + ;; - `autoload' does nothing if the function is + ;; not an autoload or undefined. + ((or (not nf) (autoloadp nf)) (get symbol 'advice--pending)) (t (symbol-function symbol))) function props) -- cgit v1.2.1 From bf20ea80f6331aaea18042a92928deb9db1b66f3 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 14 Nov 2012 16:41:32 -0800 Subject: * eval.c (mark_backtrace) [BYTE_MARK_STACK]: Remove stray '*'. This follows up on the 2012-09-29 patch that removed indirection for the 'function' field. Reported by Sergey Vinokurov in . --- src/ChangeLog | 7 +++++++ src/eval.c | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index ec8f7e219f7..d309931e8e6 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2012-11-15 Paul Eggert + + * eval.c (mark_backtrace) [BYTE_MARK_STACK]: Remove stray '*'. + This follows up on the 2012-09-29 patch that removed indirection + for the 'function' field. Reported by Sergey Vinokurov in + . + 2012-11-14 Eli Zaretskii * w32.c (faccessat): Rename from sys_faccessat. (No need to use a diff --git a/src/eval.c b/src/eval.c index dcd48cb7250..c9f27ea8d77 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3369,7 +3369,7 @@ mark_backtrace (void) for (backlist = backtrace_list; backlist; backlist = backlist->next) { - mark_object (*backlist->function); + mark_object (backlist->function); if (backlist->nargs == UNEVALLED || backlist->nargs == MANY) /* FIXME: Can this happen? */ -- cgit v1.2.1 From 589fc4791fb569279b23e5a09243115a7b52cf74 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 14 Nov 2012 20:26:52 -0500 Subject: * lisp/emacs-lisp/cl-macs.el (cl--transform-lambda): Defend against potential binding of print-gensym to t, and prettify (back)quotes in case they appear in args's default values. Fixes: debbugs:12884 --- lisp/ChangeLog | 6 ++++++ lisp/emacs-lisp/cl-macs.el | 8 +++++--- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 01b7532e56d..1a86637f4ed 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2012-11-15 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl--transform-lambda): Defend against + potential binding of print-gensym to t, and prettify (back)quotes in + case they appear in args's default values (bug#12884). + 2012-11-14 Stefan Monnier * emacs-lisp/nadvice.el: Add around advice for interactive specs. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 3c46c40242d..f83bfe00666 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -260,9 +260,11 @@ The name is made by appending a number to PREFIX, default \"G\"." (require 'help-fns) (cons (help-add-fundoc-usage (if (stringp (car hdr)) (pop hdr)) - (format "%S" - (cons 'fn - (cl--make-usage-args orig-args)))) + ;; Be careful with make-symbol and (back)quote, + ;; see bug#12884. + (let ((print-gensym nil) (print-quoted t)) + (format "%S" (cons 'fn (cl--make-usage-args + orig-args))))) hdr))) (list `(let* ,cl--bind-lets ,@(nreverse cl--bind-forms) -- cgit v1.2.1 From 3a514ab07e4f632f1870b029d616217bb8b50221 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 14 Nov 2012 20:27:52 -0500 Subject: Backport fix for bug#12879 from trunk * lisp/emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments --- lisp/ChangeLog | 5 +++++ lisp/emacs-lisp/gv.el | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 80ae61df8c1..f78240cdced 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-15 Stefan Monnier + + * emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments + (bug#12879). + 2012-11-14 Glenn Morris * subr.el (set-temporary-overlay-map): Doc fix. diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 965fc1c3ef0..49fefcf5233 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -236,7 +236,7 @@ For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y). The return value is the last VAL in the list. \(fn PLACE VAL PLACE VAL ...)" - (declare (debug (gv-place form))) + (declare (debug (&rest [gv-place form]))) (if (and args (null (cddr args))) (let ((place (pop args)) (val (car args))) -- cgit v1.2.1 From 875ce3a7c5cb1b1b49cad6f1ecdff752c7923a70 Mon Sep 17 00:00:00 2001 From: Drew Adams Date: Wed, 14 Nov 2012 21:02:00 -0500 Subject: * lisp/imenu.el (imenu--split-submenus): Use imenu--subalist-p. Fixes: debbugs:12717 --- lisp/ChangeLog | 4 ++++ lisp/imenu.el | 4 +--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1a86637f4ed..fb783aca16f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2012-11-15 Drew Adams + + * imenu.el (imenu--split-submenus): Use imenu--subalist-p (bug#12717). + 2012-11-15 Stefan Monnier * emacs-lisp/cl-macs.el (cl--transform-lambda): Defend against diff --git a/lisp/imenu.el b/lisp/imenu.el index 4686d1cf538..1d3da2db15b 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -546,9 +546,7 @@ The returned alist DOES NOT share structure with MENULIST." Return a split and sorted copy of ALIST. The returned alist DOES NOT share structure with ALIST." (mapcar (lambda (elt) - (if (and (consp elt) - (stringp (car elt)) - (listp (cdr elt))) + (if (imenu--subalist-p elt) (imenu--split-menu (cdr elt) (car elt)) elt)) alist)) -- cgit v1.2.1 From a61428c42db53e4b90d4bf12bb49aeec7abbd13a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 14 Nov 2012 22:20:49 -0500 Subject: * lisp/emacs-lisp/nadvice.el: Add buffer-local support to add-function. (advice--buffer-local-function-sample): New var. (advice--set-buffer-local, advice--buffer-local): New functions. (add-function, remove-function): Use them. --- lisp/ChangeLog | 7 +++++++ lisp/emacs-lisp/cl-loaddefs.el | 2 +- lisp/emacs-lisp/nadvice.el | 34 ++++++++++++++++++++++++++++++---- 3 files changed, 38 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fb783aca16f..51efba25f97 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2012-11-15 Stefan Monnier + + * emacs-lisp/nadvice.el: Add buffer-local support to add-function. + (advice--buffer-local-function-sample): New var. + (advice--set-buffer-local, advice--buffer-local): New functions. + (add-function, remove-function): Use them. + 2012-11-15 Drew Adams * imenu.el (imenu--split-submenus): Use imenu--subalist-p (bug#12717). diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index eb58d17c02e..765bdf71519 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'. ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "c7ad09a74a1d2969406e7e2aaf3812fc") +;;;;;; "cl-macs" "cl-macs.el" "887ee7c4b9eb5766c6483d27e84aac21") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 873a1695867..0c3b267f9e1 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -182,17 +182,31 @@ WHERE is a symbol to select an entry in `advice--where-alist'." (advice--make-1 (aref flist 1) (aref flist 3) first nrest props))))))) +(defvar advice--buffer-local-function-sample nil) + +(defun advice--set-buffer-local (var val) + (if (function-equal val advice--buffer-local-function-sample) + (kill-local-variable var) + (set (make-local-variable var) val))) + +;;;###autoload +(defun advice--buffer-local (var) + "Buffer-local value of VAR, presumed to contain a function." + (declare (gv-setter advice--set-buffer-local)) + (if (local-variable-p var) (symbol-value var) + (setq advice--buffer-local-function-sample + (lambda (&rest args) (apply (default-value var) args))))) + ;;;###autoload (defmacro add-function (where place function &optional props) ;; TODO: - ;; - provide something like `around' for interactive forms. - ;; - provide some kind of buffer-local functionality at least when `place' - ;; is a variable. ;; - obsolete with-wrapper-hook (mostly requires buffer-local support). ;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP ;; and tracing want to stay first. - ;; - maybe also let `where' specify some kind of predicate and use it + ;; - maybe let `where' specify some kind of predicate and use it ;; to implement things like mode-local or eieio-defmethod. + ;; Of course, that only makes sense if the predicates of all advices can + ;; be combined and made more efficient. ;; :before is like a normal add-hook on a normal hook. ;; :before-while is like add-hook on run-hook-with-args-until-failure. ;; :before-until is like add-hook on run-hook-with-args-until-success. @@ -214,6 +228,10 @@ PROPS is an alist of additional properties, among which the following have a special meaning: - `name': a string or symbol. It can be used to refer to this piece of advice. +PLACE cannot be a simple variable. Instead it should either be +\(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION +should be applied to VAR buffer-locally or globally. + If one of FUNCTION or OLDFUN is interactive, then the resulting function is also interactive. There are 3 cases: - FUNCTION is not interactive: the interactive spec of OLDFUN is used. @@ -222,6 +240,10 @@ is also interactive. There are 3 cases: `advice-eval-interactive-spec') and return the list of arguments to use. - Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN." (declare (debug t)) ;;(indent 2) + (cond ((eq 'local (car-safe place)) + (setq place `(advice--buffer-local ,@(cdr place)))) + ((symbolp place) + (error "Use (default-value '%S) or (local '%S)" place place))) `(advice--add-function ,where (gv-ref ,place) ,function ,props)) ;;;###autoload @@ -236,6 +258,10 @@ If FUNCTION was not added to PLACE, do nothing. Instead of FUNCTION being the actual function, it can also be the `name' of the piece of advice." (declare (debug t)) + (cond ((eq 'local (car-safe place)) + (setq place `(advice--buffer-local ,@(cdr place)))) + ((symbolp place) + (error "Use (default-value '%S) or (local '%S)" place place))) (gv-letplace (getter setter) place (macroexp-let2 nil new `(advice--remove-function ,getter ,function) `(unless (eq ,new ,getter) ,(funcall setter new))))) -- cgit v1.2.1 From 47f01a8af9660c018cafa3a97632c8bcb2417cec Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Wed, 14 Nov 2012 22:30:25 -0500 Subject: * lisp/emacs-lisp/advice.el (ad-make-advised-definition): Fix undefined case. * lisp/emacs-lisp/nadvice.el (advice--make-interactive-form): Fix string-spec case. --- lisp/ChangeLog | 7 +++++++ lisp/emacs-lisp/advice.el | 2 +- lisp/emacs-lisp/nadvice.el | 2 +- 3 files changed, 9 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 51efba25f97..dccdc429ebc 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2012-11-15 Katsumi Yamaoka + + * emacs-lisp/nadvice.el (advice--make-interactive-form): + Fix string-spec case. + + * emacs-lisp/advice.el (ad-make-advised-definition): Fix undefined case. + 2012-11-15 Stefan Monnier * emacs-lisp/nadvice.el: Add buffer-local support to add-function. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index f9b4491e6e0..b99e614bec5 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2597,7 +2597,7 @@ in any of these classes." (ad-has-redefining-advice function)) (let* ((origdef (ad-real-orig-definition function)) ;; Construct the individual pieces that we need for assembly: - (orig-arglist (ad-arglist origdef)) + (orig-arglist (and origdef (ad-arglist origdef))) (advised-arglist (or (ad-advised-arglist function) orig-arglist)) (interactive-form (ad-advised-interactive-form function)) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 0c3b267f9e1..540e0166ec2 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -129,7 +129,7 @@ Each element has the form (WHERE BYTECODE STACK) where: ;; FIXME: The calls to interactive-form below load autoloaded functions ;; too eagerly. (let ((fspec (cadr (interactive-form function)))) - (when (eq 'function (car fspec)) ;; Macroexpanded lambda? + (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda? (setq fspec (nth 1 fspec))) (if (functionp fspec) `(funcall ',fspec -- cgit v1.2.1 From 1232d6c2e4c41cc5c3296058a3750a662aaab2a1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 14 Nov 2012 23:42:14 -0500 Subject: * lisp/emacs-lisp/advice.el (ad-definition-type): Make sure we don't use a preactivated advice from an old advice.el; they're not compatible! --- lisp/ChangeLog | 5 +++++ lisp/emacs-lisp/advice.el | 17 ++++++++--------- 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dccdc429ebc..b86e03b42af 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-15 Stefan Monnier + + * emacs-lisp/advice.el (ad-definition-type): Make sure we don't use + a preactivated advice from an old advice.el; they're not compatible! + 2012-11-15 Katsumi Yamaoka * emacs-lisp/nadvice.el (advice--make-interactive-form): diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index b99e614bec5..60c1a846a79 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2239,16 +2239,15 @@ definition (see the code for `documentation')." (defun ad-definition-type (definition) "Return symbol that describes the type of DEFINITION." + ;; These symbols are only ever used to check a cache entry's validity. + ;; The suffix `2' reflects the fact that we're using version 2 of advice + ;; representations, so cache entries preactivated with version + ;; 1 can't be used. (cond - ((ad-macro-p definition) 'macro) - ((ad-subr-p definition) - (if (special-form-p definition) - 'special-form - 'subr)) - ((or (ad-lambda-p definition) - (ad-compiled-p definition)) - 'function) - ((ad-advice-p definition) 'advice))) + ((ad-macro-p definition) 'macro2) + ((ad-subr-p definition) 'subr2) + ((or (ad-lambda-p definition) (ad-compiled-p definition)) 'fun2) + ((ad-advice-p definition) 'advice2))) ;; FIXME: Can this ever happen? (defun ad-has-proper-definition (function) "True if FUNCTION is a symbol with a proper definition. -- cgit v1.2.1 From 74934dccc4d793557c1880034fd5433d9b97ae52 Mon Sep 17 00:00:00 2001 From: Dmitry Antipov Date: Thu, 15 Nov 2012 09:25:05 +0400 Subject: * internals.texi (Garbage Collection): Update descriptions of vectorlike_header, garbage-collect and gc-cons-threshold. (Object Internals): Explain Lisp_Object layout and the basics of an internal type system. (Buffer Internals): Update description of struct buffer. --- doc/lispref/ChangeLog | 8 ++ doc/lispref/internals.texi | 295 +++++++++++++++++++++++++++++++-------------- 2 files changed, 212 insertions(+), 91 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 6d6ddf4da9a..d157fec9a6c 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,11 @@ +2012-11-15 Dmitry Antipov + + * internals.texi (Garbage Collection): Update descriptions + of vectorlike_header, garbage-collect and gc-cons-threshold. + (Object Internals): Explain Lisp_Object layout and the basics + of an internal type system. + (Buffer Internals): Update description of struct buffer. + 2012-11-13 Glenn Morris * variables.texi (Adding Generalized Variables): diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 1459f52d979..2a2846921c5 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -226,12 +226,11 @@ of 8k bytes, and small vectors are packed into blocks of 4k bytes). Beyond the basic vector, a lot of objects like window, buffer, and frame are managed as if they were vectors. The corresponding C data structures include the @code{struct vectorlike_header} field whose -@code{next} field points to the next object in the chain: -@code{header.next.buffer} points to the next buffer (which could be -a killed buffer), and @code{header.next.vector} points to the next -vector in a free list. If a vector is small (smaller than or equal to -@code{VBLOCK_BYTES_MAX} bytes, see @file{alloc.c}), then -@code{header.next.nbytes} contains the vector size in bytes. +@code{size} member contains the subtype enumerated by @code{enum pvec_type} +and an information about how many @code{Lisp_Object} fields this structure +contains and what the size of the rest data is. This information is +needed to calculate the memory footprint of an object, and used +by the vector allocation code while iterating over the vector blocks. @cindex garbage collection It is quite common to use some storage for a while, then release it @@ -284,88 +283,147 @@ the amount of space in use. (Garbage collection can also occur spontaneously if you use more than @code{gc-cons-threshold} bytes of Lisp data since the previous garbage collection.) -@code{garbage-collect} returns a list containing the following -information: +@code{garbage-collect} returns a list with information on amount of space in +use, where each entry has the form @samp{(@var{name} @var{size} @var{used})} +or @samp{(@var{name} @var{size} @var{used} @var{free})}. In the entry, +@var{name} is a symbol describing the kind of objects this entry represents, +@var{size} is the number of bytes used by each one, @var{used} is the number +of those objects that were found live in the heap, and optional @var{free} is +the number of those objects that are not live but that Emacs keeps around for +future allocations. So an overall result is: @example -@group -((@var{used-conses} . @var{free-conses}) - (@var{used-syms} . @var{free-syms}) -@end group - (@var{used-miscs} . @var{free-miscs}) - @var{used-string-chars} - @var{used-vector-slots} - (@var{used-floats} . @var{free-floats}) - (@var{used-intervals} . @var{free-intervals}) - (@var{used-strings} . @var{free-strings})) +((@code{conses} @var{cons-size} @var{used-conse} @var{free-conses}) + (@code{symbols} @var{symbol-size} @var{used-symbols} @var{free-symbols}) + (@code{miscs} @var{misc-size} @var{used-miscs} @var{free-miscs}) + (@code{strings} @var{string-size} @var{used-strings} @var{free-strings}) + (@code{string-bytes} @var{byte-size} @var{used-bytes}) + (@code{vectors} @var{vector-size} @var{used-vectors}) + (@code{vector-slots} @var{slot-size} @var{used-slots} @var{free-slots}) + (@code{floats} @var{float-size} @var{used-floats} @var{free-floats}) + (@code{intervals} @var{interval-size} @var{used-intervals} @var{free-intervals}) + (@code{buffers} @var{buffer-size} @var{used-buffers}) + (@code{heap} @var{unit-size} @var{total-size} @var{free-size})) @end example Here is an example: @example -@group (garbage-collect) - @result{} ((106886 . 13184) (9769 . 0) - (7731 . 4651) 347543 121628 - (31 . 94) (1273 . 168) - (25474 . 3569)) -@end group + @result{} ((conses 16 49126 8058) (symbols 48 14607 0) + (miscs 40 34 56) (strings 32 2942 2607) + (string-bytes 1 78607) (vectors 16 7247) + (vector-slots 8 341609 29474) (floats 8 71 102) + (intervals 56 27 26) (buffers 944 8) + (heap 1024 11715 2678)) @end example -Here is a table explaining each element: +Below is a table explaining each element. Note that last @code{heap} entry +is optional and present only if an underlying @code{malloc} implementation +provides @code{mallinfo} function. @table @var +@item cons-size +Internal size of a cons cell, i.e.@: @code{sizeof (struct Lisp_Cons)}. + @item used-conses The number of cons cells in use. @item free-conses -The number of cons cells for which space has been obtained from the -operating system, but that are not currently being used. +The number of cons cells for which space has been obtained from +the operating system, but that are not currently being used. -@item used-syms +@item symbol-size +Internal size of a symbol, i.e.@: @code{sizeof (struct Lisp_Symbol)}. + +@item used-symbols The number of symbols in use. -@item free-syms -The number of symbols for which space has been obtained from the -operating system, but that are not currently being used. +@item free-symbols +The number of symbols for which space has been obtained from +the operating system, but that are not currently being used. + +@item misc-size +Internal size of a miscellaneous entity, i.e.@: +@code{sizeof (union Lisp_Misc)}, which is a size of the +largest type enumerated in @code{enum Lisp_Misc_Type}. @item used-miscs -The number of miscellaneous objects in use. These include markers and -overlays, plus certain objects not visible to users. +The number of miscellaneous objects in use. These include markers +and overlays, plus certain objects not visible to users. @item free-miscs The number of miscellaneous objects for which space has been obtained from the operating system, but that are not currently being used. -@item used-string-chars -The total size of all strings, in characters. +@item string-size +Internal size of a string header, i.e.@: @code{sizeof (struct Lisp_String)}. + +@item used-strings +The number of string headers in use. + +@item free-strings +The number of string headers for which space has been obtained +from the operating system, but that are not currently being used. + +@item byte-size +This is used for convenience and equals to @code{sizeof (char)}. + +@item used-bytes +The total size of all string data in bytes. + +@item vector-size +Internal size of a vector header, i.e.@: @code{sizeof (struct Lisp_Vector)}. -@item used-vector-slots -The total number of elements of existing vectors. +@item used-vectors +The number of vector headers allocated from the vector blocks. + +@item slot-size +Internal size of a vector slot, always equal to @code{sizeof (Lisp_Object)}. + +@item used-slots +The number of slots in all used vectors. + +@item free-slots +The number of free slots in all vector blocks. + +@item float-size +Internal size of a float object, i.e.@: @code{sizeof (struct Lisp_Float)}. +(Do not confuse it with the native platform @code{float} or @code{double}.) @item used-floats The number of floats in use. @item free-floats -The number of floats for which space has been obtained from the -operating system, but that are not currently being used. +The number of floats for which space has been obtained from +the operating system, but that are not currently being used. + +@item interval-size +Internal size of an interval object, i.e.@: @code{sizeof (struct interval)}. @item used-intervals -The number of intervals in use. Intervals are an internal -data structure used for representing text properties. +The number of intervals in use. @item free-intervals -The number of intervals for which space has been obtained -from the operating system, but that are not currently being used. +The number of intervals for which space has been obtained from +the operating system, but that are not currently being used. -@item used-strings -The number of strings in use. +@item buffer-size +Internal size of a buffer, i.e.@: @code{sizeof (struct buffer)}. +(Do not confuse with the value returned by @code{buffer-size} function.) -@item free-strings -The number of string headers for which the space was obtained from the -operating system, but which are currently not in use. (A string -object consists of a header and the storage for the string text -itself; the latter is only allocated when the string is created.) +@item used-buffers +The number of buffer objects in use. This includes killed buffers +invisible to users, i.e.@: all buffers in @code{all_buffers} list. + +@item unit-size +The unit of heap space measurement, always equal to 1024 bytes. + +@item total-size +Total heap size, in @var{unit-size} units. + +@item free-size +Heap space which is not currently used, in @var{unit-size} units. @end table If there was overflow in pure space (@pxref{Pure Storage}), @@ -388,23 +446,25 @@ careful writing them. @defopt gc-cons-threshold The value of this variable is the number of bytes of storage that must be allocated for Lisp objects after one garbage collection in order to -trigger another garbage collection. A cons cell counts as eight bytes, -a string as one byte per character plus a few bytes of overhead, and so -on; space allocated to the contents of buffers does not count. Note -that the subsequent garbage collection does not happen immediately when -the threshold is exhausted, but only the next time the Lisp evaluator is -called. - -The initial threshold value is 800,000. If you specify a larger -value, garbage collection will happen less often. This reduces the -amount of time spent garbage collecting, but increases total memory use. -You may want to do this when running a program that creates lots of -Lisp data. - -You can make collections more frequent by specifying a smaller value, -down to 10,000. A value less than 10,000 will remain in effect only -until the subsequent garbage collection, at which time -@code{garbage-collect} will set the threshold back to 10,000. +trigger another garbage collection. You can use the result returned by +@code{garbage-collect} to get an information about size of the particular +object type; space allocated to the contents of buffers does not count. +Note that the subsequent garbage collection does not happen immediately +when the threshold is exhausted, but only the next time the Lisp interpreter +is called. + +The initial threshold value is @code{GC_DEFAULT_THRESHOLD}, defined in +@file{alloc.c}. Since it's defined in @code{word_size} units, the value +is 400,000 for the default 32-bit configuration and 800,000 for the 64-bit +one. If you specify a larger value, garbage collection will happen less +often. This reduces the amount of time spent garbage collecting, but +increases total memory use. You may want to do this when running a program +that creates lots of Lisp data. + +You can make collections more frequent by specifying a smaller value, down +to 1/10th of @code{GC_DEFAULT_THRESHOLD}. A value less than this minimum +will remain in effect only until the subsequent garbage collection, at which +time @code{garbage-collect} will set the threshold back to the minimum. @end defopt @defopt gc-cons-percentage @@ -639,7 +699,12 @@ in the file @file{lisp.h}.) If the primitive has no upper limit on the number of Lisp arguments, it must have exactly two C arguments: the first is the number of Lisp arguments, and the second is the address of a block containing their values. These have types -@code{int} and @w{@code{Lisp_Object *}} respectively. +@code{int} and @w{@code{Lisp_Object *}} respectively. Since +@code{Lisp_Object} can hold any Lisp object of any data type, you +can determine the actual data type only at run time; so if you want +a primitive to accept only a certain type of argument, you must check +the type explicitly using a suitable predicate (@pxref{Type Predicates}). +@cindex type checking internals @cindex @code{GCPRO} and @code{UNGCPRO} @cindex protect C variables from garbage collection @@ -820,23 +885,70 @@ knows about it. @section Object Internals @cindex object internals -@c FIXME Is this still true? Does --with-wide-int affect anything? - GNU Emacs Lisp manipulates many different types of data. The actual -data are stored in a heap and the only access that programs have to it -is through pointers. Each pointer is 32 bits wide on 32-bit machines, -and 64 bits wide on 64-bit machines; three of these bits are used for -the tag that identifies the object's type, and the remainder are used -to address the object. - - Because Lisp objects are represented as tagged pointers, it is always -possible to determine the Lisp data type of any object. The C data type -@code{Lisp_Object} can hold any Lisp object of any data type. Ordinary -variables have type @code{Lisp_Object}, which means they can hold any -type of Lisp value; you can determine the actual data type only at run -time. The same is true for function arguments; if you want a function -to accept only a certain type of argument, you must check the type -explicitly using a suitable predicate (@pxref{Type Predicates}). -@cindex type checking internals + Emacs Lisp provides a rich set of the data types. Some of them, like cons +cells, integers and stirngs, are common to nearly all Lisp dialects. Some +others, like markers and buffers, are quite special and needed to provide +the basic support to write editor commands in Lisp. To implement such +a variety of object types and provide an efficient way to pass objects between +the subsystems of an interpreter, there is a set of C data structures and +a special type to represent the pointers to all of them, which is known as +@dfn{tagged pointer}. + + In C, the tagged pointer is an object of type @code{Lisp_Object}. Any +initialized variable of such a type always holds the value of one of the +following basic data types: integer, symbol, string, cons cell, float, +vectorlike or miscellaneous object. Each of these data types has the +corresponding tag value. All tags are enumerated by @code{enum Lisp_Type} +and placed into a 3-bit bitfield of the @code{Lisp_Object}. The rest of the +bits is the value itself. Integer values are immediate, i.e.@: directly +represented by those @dfn{value bits}, and all other objects are represented +by the C pointers to a corresponding object allocated from the heap. Width +of the @code{Lisp_Object} is platform- and configuration-dependent: usually +it's equal to the width of an underlying platform pointer (i.e.@: 32-bit on +a 32-bit machine and 64-bit on a 64-bit one), but also there is a special +configuration where @code{Lisp_Object} is 64-bit but all pointers are 32-bit. +The latter trick was designed to overcome the limited range of values for +Lisp integers on a 32-bit system by using 64-bit @code{long long} type for +@code{Lisp_Object}. + + The following C data structures are defined in @file{lisp.h} to represent +the basic data types beyond integers: + +@table @code +@item struct Lisp_Cons +Cons cell, an object used to construct lists. + +@item struct Lisp_String +String, the basic object to represent a sequence of characters. + +@item struct Lisp_Vector +Array, a fixed-size set of Lisp objects which may be accessed by an index. + +@item struct Lisp_Symbol +Symbol, the unique-named entity commonly used as an identifier. + +@item struct Lisp_Float +Floating point value. + +@item union Lisp_Misc +Miscellaneous kinds of objects which don't fit into any of the above. +@end table + + These types are the first-class citizens of an internal type system. +Since the tag space is limited, all other types are the subtypes of either +@code{Lisp_Vectorlike} or @code{Lisp_Misc}. Vector subtypes are enumerated +by @code{enum pvec_type}, and nearly all complex objects like windows, buffers, +frames, and processes fall into this category. The rest of special types, +including markers and overlays, are enumerated by @code{enum Lisp_Misc_Type} +and form the set of subtypes of @code{Lisp_Misc}. + + Below there is a description of a few subtypes of @code{Lisp_Vectorlike}. +Buffer object represents the text to display and edit. Window is the part +of display structure which shows the buffer or used as a container to +recursively place other windows on the same frame. (Do not confuse Emacs Lisp +window object with the window as an entity managed by the user interface +system like X; in Emacs terminology, the latter is called frame.) Finally, +process object is used to manage the subprocesses. @menu * Buffer Internals:: Components of a buffer structure. @@ -912,12 +1024,8 @@ Some of the fields of @code{struct buffer} are: @table @code @item header -A @code{struct vectorlike_header} structure where @code{header.next} -points to the next buffer, in the chain of all buffers (including -killed buffers). This chain is used only for garbage collection, in -order to collect killed buffers properly. Note that vectors, and most -kinds of objects allocated as vectors, are all on one chain, but -buffers are on a separate chain of their own. +A header of type @code{struct vectorlike_header} is common to all +vectorlike objects. @item own_text A @code{struct buffer_text} structure that ordinarily holds the buffer @@ -928,6 +1036,11 @@ A pointer to the @code{buffer_text} structure for this buffer. In an ordinary buffer, this is the @code{own_text} field above. In an indirect buffer, this is the @code{own_text} field of the base buffer. +@item next +A pointer to the next buffer, in the chain of all buffers, including +killed buffers. This chain is used only for allocation and garbage +collection, in order to collect killed buffers properly. + @item pt @itemx pt_byte The character and byte positions of point in a buffer. -- cgit v1.2.1 From dc26b31073f26baf3c84a11106127dc083d6eeb5 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 14 Nov 2012 22:12:46 -0800 Subject: * subr.el (set-temporary-overlay-map): Fix previous doc fix (don't quote `t') --- lisp/subr.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/subr.el b/lisp/subr.el index d02b889ec44..bb142e8680f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3967,7 +3967,7 @@ Note that this does NOT take precedence over the \"overriding\" maps found in MAP, the normal key lookup sequence then continues. Normally, MAP is used only once. If the optional argument -KEEP-PRED is `t', MAP stays active if a key from MAP is used. +KEEP-PRED is t, MAP stays active if a key from MAP is used. KEEP-PRED can also be a function of no arguments: if it returns non-nil then MAP stays active." (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map")) -- cgit v1.2.1 From c79c7f2f4f3967ec03120cdc53e0e864e1ff7176 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 14 Nov 2012 22:13:46 -0800 Subject: * display.texi (Face Attributes): Fix :underline COLOR description. --- doc/lispref/ChangeLog | 4 ++++ doc/lispref/display.texi | 7 +++---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index e5320bf9343..d05f48b9f2d 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,7 @@ +2012-11-15 Glenn Morris + + * display.texi (Face Attributes): Fix :underline COLOR description. + 2012-11-14 Glenn Morris * keymaps.texi (Searching Keymaps, Tool Bar): Untabify examples, diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 68701a47126..6c77a9937d7 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2009,12 +2009,11 @@ Don't underline. Underline with the foreground color of the face. @item @var{color} -Underline in color @var{color}; which should be either a string -specifying a color, or the symbol @code{foreground-color}, meaning the -foreground color of the face. +Underline in color @var{color}, a string specifying a color. @item @code{(:color @var{color} :style @var{style})} -@var{color} is as described above. Omitting the attribute +@var{color} is either a string, or the symbol @code{foreground-color}, +meaning the foreground color of the face. Omitting the attribute @code{:color} means to use the foreground color of the face. @var{style} should be a symbol @code{line} or @code{wave}, meaning to use a straight or wavy line. Omitting the attribute @code{:style} -- cgit v1.2.1 From e2e13f1831a71b558b3625c4ecf3d35100236870 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 14 Nov 2012 22:17:56 -0800 Subject: ansi-term escape-char fix * lisp/term.el (ansi-term): Don't let C-x escape-char binding clobber the more standard C-c binding. Fixes: debbugs:12842 --- lisp/ChangeLog | 5 +++++ lisp/term.el | 15 ++++++++++----- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f78240cdced..01ccb886434 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-15 Glenn Morris + + * term.el (ansi-term): Don't let C-x escape-char binding + clobber the more standard C-c binding. (Bug#12842) + 2012-11-15 Stefan Monnier * emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments diff --git a/lisp/term.el b/lisp/term.el index e6466b8fa95..d6acaef1ae9 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -4178,11 +4178,16 @@ the process. Any more args are arguments to PROGRAM." (term-mode) (term-char-mode) - ;; I wanna have find-file on C-x C-f -mm - ;; your mileage may definitely vary, maybe it's better to put this in your - ;; .emacs ... - - (term-set-escape-char ?\C-x) + ;; Historical baggage. A call to term-set-escape-char used to not + ;; undo any previous call to t-s-e-c. Because of this, ansi-term + ;; ended up with both C-x and C-c as escape chars. Who knows what + ;; the original intention was, but people could have become used to + ;; either. (Bug#12842) + (let (term-escape-char) + ;; I wanna have find-file on C-x C-f -mm + ;; your mileage may definitely vary, maybe it's better to put this in your + ;; .emacs ... + (term-set-escape-char ?\C-x)) (switch-to-buffer term-ansi-buffer-name)) -- cgit v1.2.1 From bde3c6c0f79ab814e12ea0f04b06625f91f5cd52 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 14 Nov 2012 23:30:46 -0800 Subject: Fixes related to face underlining * lisp/faces.el (face-underline-p): Doc fix. Handle :underline being things other than `t' (a string, a list). (face-inverse-video-p): Doc fix. (set-face-underline): Rename it back from set-face-underline-p. Doc fix. Allow interactive input of values other than t. (read-face-attribute): Apply formatting to :underline, since like :box and :stipple it can take list values. * doc/lispref/display.texi (Face Attributes): Fix :underline COLOR description. (Attribute Functions): Update for set-face-underline rename. Tweak descriptions of face-underline-p, face-inverse-video-p. * etc/NEWS: Related edit. --- doc/lispref/ChangeLog | 2 ++ doc/lispref/display.texi | 10 ++++++--- etc/NEWS | 2 +- lisp/ChangeLog | 8 +++++++ lisp/faces.el | 58 +++++++++++++++++++++++++++++------------------- src/xfaces.c | 8 +++++++ 6 files changed, 61 insertions(+), 27 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index d05f48b9f2d..68d7bee2b64 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,6 +1,8 @@ 2012-11-15 Glenn Morris * display.texi (Face Attributes): Fix :underline COLOR description. + (Attribute Functions): Update for set-face-underline rename. + Tweak descriptions of face-underline-p, face-inverse-video-p. 2012-11-14 Glenn Morris diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 6c77a9937d7..9fedd162da6 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2403,7 +2403,7 @@ This sets the @code{:slant} attribute of @var{face} to @var{normal} if @var{italic-p} is @code{nil}, and to @var{italic} otherwise. @end defun -@defun set-face-underline-p face underline &optional frame +@defun set-face-underline face underline &optional frame This sets the @code{:underline} attribute of @var{face} to @var{underline}. @end defun @@ -2466,12 +2466,16 @@ attribute of @var{face} is @code{italic} or @code{oblique}, and @code{nil} otherwise. @end defun +@c Note the weasel words. A face that inherits from an underlined +@c face but does not specify :underline will return nil. @defun face-underline-p face &optional frame -This function returns the @code{:underline} attribute of face @var{face}. +This function returns non-@code{nil} if face @var{face} specifies +a non-@code{nil} @code{:underline} attribute. @end defun @defun face-inverse-video-p face &optional frame -This function returns the @code{:inverse-video} attribute of face @var{face}. +This function returns non-@code{nil} if face @var{face} specifies +a non-@code{nil} @code{:inverse-video} attribute. @end defun @node Displaying Faces diff --git a/etc/NEWS b/etc/NEWS index 84bedfbc257..b69240e081a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -948,8 +948,8 @@ takes precedence over most other maps for a short while (normally one key). +++ ** New fringe bitmap `exclamation-mark'. ++++ ** Face underlining can now use a wave. -See the "Face Attributes" section of the Elisp manual. ** The following functions and variables are obsolete: --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 01ccb886434..e53b667b2b2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,13 @@ 2012-11-15 Glenn Morris + * faces.el (face-underline-p): Doc fix. Handle :underline being + things other than `t' (a string, a list). + (face-inverse-video-p): Doc fix. + (set-face-underline): Rename it back from set-face-underline-p. + Doc fix. Allow interactive input of values other than t. + (read-face-attribute): Apply formatting to :underline, + since like :box and :stipple it can take list values. + * term.el (ansi-term): Don't let C-x escape-char binding clobber the more standard C-c binding. (Bug#12842) diff --git a/lisp/faces.el b/lisp/faces.el index f5ef88d08b0..d07c4d6f5a5 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -487,16 +487,21 @@ with the `default' face (which is always completely specified)." (defalias 'face-background-pixmap 'face-stipple) +;; FIXME all of these -p functions ignore inheritance (cf face-stipple). +;; Ie, a face that inherits from an underlined face but does not +;; specify :underline will return nil. +;; So these functions don't actually tell you anything about how the +;; face will _appear_. So not very useful IMO. (defun face-underline-p (face &optional frame) - "Return non-nil if FACE is underlined. + "Return non-nil if FACE specifies a non-nil underlining. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." - (eq (face-attribute face :underline frame) t)) + (not (memq (face-attribute face :underline frame) '(unspecified nil)))) (defun face-inverse-video-p (face &optional frame) - "Return non-nil if FACE is in inverse video on FRAME. + "Return non-nil if FACE specifies a non-nil inverse-video. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." @@ -837,21 +842,24 @@ and DATA is a string, containing the raw bits of the bitmap." (set-face-attribute face frame :stipple (or stipple 'unspecified))) -(defun set-face-underline-p (face underline &optional frame) +(defun set-face-underline (face underline &optional frame) "Specify whether face FACE is underlined. UNDERLINE nil means FACE explicitly doesn't underline. -UNDERLINE non-nil means FACE explicitly does underlining -with the same of the foreground color. -If UNDERLINE is a string, underline with the color named UNDERLINE. +UNDERLINE t means FACE underlines with its foreground color. +If UNDERLINE is a string, underline with that color. + +UNDERLINE may also be a list of the form (:color COLOR :style STYLE), +where COLOR is a string or `foreground-color', and STYLE is either +`line' or `wave'. :color may be omitted, which means to use the +foreground color. :style may be omitted, which means to use a line. + FRAME nil or not specified means change face on all frames. Use `set-face-attribute' to ``unspecify'' underlining." - (interactive - (let ((list (read-face-and-attribute :underline))) - (list (car list) (eq (car (cdr list)) t)))) + (interactive (read-face-and-attribute :underline)) (set-face-attribute face frame :underline underline)) -(define-obsolete-function-alias 'set-face-underline - 'set-face-underline-p "22.1") +(define-obsolete-function-alias 'set-face-underline-p + 'set-face-underline "24.3") (defun set-face-inverse-video-p (face inverse-video-p &optional frame) @@ -866,6 +874,9 @@ Use `set-face-attribute' to ``unspecify'' the inverse video attribute." (set-face-attribute face frame :inverse-video inverse-video-p)) +;; The -p suffix is a hostage to fortune. What if we want to extend +;; this to allow more than boolean options? Exactly this happened +;; to set-face-underline-p. (defun set-face-bold-p (face bold-p &optional frame) "Specify whether face FACE is bold. BOLD-P non-nil means FACE should explicitly display bold. @@ -1114,6 +1125,9 @@ name of the attribute for prompting. Value is the new attribute value." (string-to-number new-value))))) +;; FIXME this does allow you to enter the list forms of :box, +;; :stipple, or :underline, because face-valid-attribute-values does +;; not return those forms. (defun read-face-attribute (face attribute &optional frame) "Interactively read a new value for FACE's ATTRIBUTE. Optional argument FRAME nil or unspecified means read an attribute value @@ -1125,12 +1139,11 @@ of a global face. Value is the new attribute value." ;; Represent complex attribute values as strings by printing them ;; out. Stipple can be a vector; (WIDTH HEIGHT DATA). Box can be ;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow - ;; SHADOW)'. - (when (and (or (eq attribute :stipple) - (eq attribute :box)) - (or (consp old-value) - (vectorp old-value))) - (setq old-value (prin1-to-string old-value))) + ;; SHADOW)'. Underline can be `(:color COLOR :style STYLE)'. + (and (memq attribute '(:box :stipple :underline)) + (or (consp old-value) + (vectorp old-value)) + (setq old-value (prin1-to-string old-value))) (cond ((listp valid) (let ((default (or (car (rassoc old-value valid)) @@ -1160,11 +1173,10 @@ of a global face. Value is the new attribute value." ;; Convert stipple and box value text we read back to a list or ;; vector if it looks like one. This makes the assumption that a ;; pixmap file name won't start with an open-paren. - (when (and (or (eq attribute :stipple) - (eq attribute :box)) - (stringp new-value) - (string-match "^[[(]" new-value)) - (setq new-value (read new-value))) + (and (memq attribute '(:stipple :box :underline)) + (stringp new-value) + (string-match "^[[(]" new-value) + (setq new-value (read new-value))) new-value)) (declare-function fontset-list "fontset.c" ()) diff --git a/src/xfaces.c b/src/xfaces.c index 221387c4b6d..5eda6dca6da 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -2906,6 +2906,12 @@ FRAME 0 means change the face on all frames, and change the default Lisp_Object key, val, list; list = value; + /* FIXME? This errs on the side of acceptance. Eg it accepts: + (defface foo '((t :underline 'foo) "doc") + Maybe this is intentional, maybe it isn't. + Non-nil symbols other than t are not documented as being valid. + Eg compare with inverse-video, which explicitly rejects them. + */ valid_p = 1; while (!NILP (CAR_SAFE(list))) @@ -5727,6 +5733,8 @@ realize_x_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]) face->underline_defaulted_p = 1; face->underline_type = FACE_UNDER_LINE; + /* FIXME? This is also not robust about checking the precise form. + See comments in Finternal_set_lisp_face_attribute. */ while (CONSP (underline)) { Lisp_Object keyword, value; -- cgit v1.2.1 From 17c083ac218b2a560b84a11df22366c0b9f7b636 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 14 Nov 2012 23:59:46 -0800 Subject: * lisp/eshell/em-cmpl.el (eshell-pcomplete): New command. (eshell-cmpl-initialize): Bind eshell-pcomplete to TAB, C-i. Fixes: debbugs:12838 --- lisp/ChangeLog | 3 +++ lisp/eshell/em-cmpl.el | 11 +++++++++-- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e53b667b2b2..74981d0c241 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2012-11-15 Glenn Morris + * eshell/em-cmpl.el (eshell-pcomplete): New command. (Bug#12838) + (eshell-cmpl-initialize): Bind eshell-pcomplete to TAB, C-i. + * faces.el (face-underline-p): Doc fix. Handle :underline being things other than `t' (a string, a list). (face-inverse-video-p): Doc fix. diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index a67861e83a9..aa8aae2d245 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -295,8 +295,8 @@ to writing a completion function." 'pcomplete-expand-and-complete) (define-key eshell-command-map [space] 'pcomplete-expand) (define-key eshell-command-map [? ] 'pcomplete-expand) - (define-key eshell-mode-map [tab] 'pcomplete) - (define-key eshell-mode-map [(control ?i)] 'pcomplete) + (define-key eshell-mode-map [tab] 'eshell-pcomplete) + (define-key eshell-mode-map [(control ?i)] 'eshell-pcomplete) ;; jww (1999-10-19): Will this work on anything but X? (if (featurep 'xemacs) (define-key eshell-mode-map [iso-left-tab] 'pcomplete-reverse) @@ -449,6 +449,13 @@ to writing a completion function." (all-completions filename obarray 'functionp)) completions))))))) +(defun eshell-pcomplete () + "Eshell wrapper for `pcomplete'." + (interactive) + (if eshell-cmpl-ignore-case + (pcomplete-expand-and-complete) ; hack workaround for bug#12838 + (pcomplete))) + (provide 'em-cmpl) ;; Local Variables: -- cgit v1.2.1 From c8915b6779ac09e69f6b213b0ed7bd55b0cc761f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 15 Nov 2012 09:17:11 -0500 Subject: * doc/lispref/keymaps.texi (Translation Keymaps): Add a subsection "Interaction with normal keymaps" (bug#12868). --- doc/lispref/ChangeLog | 5 +++++ doc/lispref/keymaps.texi | 45 ++++++++++++++++++++++++++++++++------------- 2 files changed, 37 insertions(+), 13 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index d157fec9a6c..23f8c0c6d36 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,8 @@ +2012-11-15 Stefan Monnier + + * keymaps.texi (Translation Keymaps): Add a subsection "Interaction + with normal keymaps". + 2012-11-15 Dmitry Antipov * internals.texi (Garbage Collection): Update descriptions diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index f658f7e66fb..14f804bf5c5 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1540,14 +1540,11 @@ sequence, to translate certain event sequences into others. being read, as it is read, against @code{input-decode-map}, then @code{local-function-key-map}, and then against @code{key-translation-map}. -@defvar input-decode-map -This variable holds a keymap that describes the character sequences sent -by function keys on an ordinary character terminal. This keymap has the -same structure as other keymaps, but is used differently: it specifies -translations to make while reading key sequences, rather than bindings -for key sequences. +These keymaps have the same structure as other keymaps, but they are used +differently: they specify translations to make while reading key sequences, +rather than bindings for key sequences. -If @code{input-decode-map} ``binds'' a key sequence @var{k} to a vector +If one of these keymaps ``binds'' a key sequence @var{k} to a vector @var{v}, then when @var{k} appears as a subsequence @emph{anywhere} in a key sequence, it is replaced with the events in @var{v}. @@ -1562,6 +1559,10 @@ Thus, typing @kbd{C-c @key{PF1}} sends the character sequence @kbd{C-c this back into @kbd{C-c @key{PF1}}, which it returns as the vector @code{[?\C-c pf1]}. +@defvar input-decode-map +This variable holds a keymap that describes the character sequences sent +by function keys on an ordinary character terminal. + The value of @code{input-decode-map} is usually set up automatically according to the terminal's Terminfo or Termcap entry, but sometimes those need help from terminal-specific Lisp files. Emacs comes with @@ -1636,8 +1637,6 @@ to turn the character that follows into a Hyper character: (let ((symbol (if (symbolp e) e (car e)))) (setq symbol (intern (concat string (symbol-name symbol)))) -@end group -@group (if (symbolp e) symbol (cons symbol (cdr e))))) @@ -1647,10 +1646,30 @@ to turn the character that follows into a Hyper character: @end example If you have enabled keyboard character set decoding using -@code{set-keyboard-coding-system}, decoding is done after the -translations listed above. @xref{Terminal I/O Encoding}. However, in -future Emacs versions, character set decoding may be done at an -earlier stage. +@code{set-keyboard-coding-system}, decoding is done before the +translations listed above. @xref{Terminal I/O Encoding}. + +@subsection Interaction with normal keymaps + +The end of a key sequence is detected when that key sequence either is bound +to a command, or when Emacs determines that no additional event can lead +to a sequence that is bound to a command. + +This means that, while @code{input-decode-map} and @code{key-translation-map} +apply regardless of whether the original key sequence would have a binding, the +presence of such a binding can still prevent translation from taking place. +For example, let us return to our VT100 example above and add a binding for +@kbd{C-c @key{ESC}} to the global map; now when the user hits @kbd{C-c +@key{PF1}} Emacs will fail to decode @kbd{C-c @key{ESC} O P} into @kbd{C-c +@key{PF1}} because it will stop reading keys right after @kbd{C-x @key{ESC}}, +leaving @kbd{O P} for later. This is in case the user really hit @kbd{C-c +@key{ESC}}, in which case Emacs should not sit there waiting for the next key +to decide whether the user really pressed @kbd{@key{ESC}} or @kbd{@key{PF1}}. + +For that reason, it is better to avoid binding commands to key sequences where +the end of the key sequence is a prefix of a key translation. The main such +problematic suffixes/prefixes are @kbd{@key{ESC}}, @kbd{M-O} (which is really +@kbd{@key{ESC} O}) and @kbd{M-[} (which is really @kbd{@key{ESC} [}). @node Key Binding Commands @section Commands for Binding Keys -- cgit v1.2.1 From 96a6857705884d96b9026e80d2bc551d9079cee2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 15 Nov 2012 09:20:45 -0500 Subject: * doc/lispref/keymaps.texi (Translation Keymaps): Backport subsection "Interaction with normal keymaps". Fixes: debbugs:12868 --- doc/lispref/ChangeLog | 5 +++++ doc/lispref/keymaps.texi | 45 ++++++++++++++++++++++++++++++++------------- 2 files changed, 37 insertions(+), 13 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 68d7bee2b64..89b456f5c22 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,8 @@ +2012-11-15 Stefan Monnier + + * keymaps.texi (Translation Keymaps): Add a subsection "Interaction + with normal keymaps" (bug#12868). + 2012-11-15 Glenn Morris * display.texi (Face Attributes): Fix :underline COLOR description. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index f6d571ecc68..d01ecba4bed 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1559,14 +1559,11 @@ sequence, to translate certain event sequences into others. being read, as it is read, against @code{input-decode-map}, then @code{local-function-key-map}, and then against @code{key-translation-map}. -@defvar input-decode-map -This variable holds a keymap that describes the character sequences sent -by function keys on an ordinary character terminal. This keymap has the -same structure as other keymaps, but is used differently: it specifies -translations to make while reading key sequences, rather than bindings -for key sequences. +These keymaps have the same structure as other keymaps, but they are used +differently: they specify translations to make while reading key sequences, +rather than bindings for key sequences. -If @code{input-decode-map} ``binds'' a key sequence @var{k} to a vector +If one of these keymaps ``binds'' a key sequence @var{k} to a vector @var{v}, then when @var{k} appears as a subsequence @emph{anywhere} in a key sequence, it is replaced with the events in @var{v}. @@ -1581,6 +1578,10 @@ Thus, typing @kbd{C-c @key{PF1}} sends the character sequence @kbd{C-c this back into @kbd{C-c @key{PF1}}, which it returns as the vector @code{[?\C-c pf1]}. +@defvar input-decode-map +This variable holds a keymap that describes the character sequences sent +by function keys on an ordinary character terminal. + The value of @code{input-decode-map} is usually set up automatically according to the terminal's Terminfo or Termcap entry, but sometimes those need help from terminal-specific Lisp files. Emacs comes with @@ -1655,8 +1656,6 @@ to turn the character that follows into a Hyper character: (let ((symbol (if (symbolp e) e (car e)))) (setq symbol (intern (concat string (symbol-name symbol)))) -@end group -@group (if (symbolp e) symbol (cons symbol (cdr e))))) @@ -1666,10 +1665,30 @@ to turn the character that follows into a Hyper character: @end example If you have enabled keyboard character set decoding using -@code{set-keyboard-coding-system}, decoding is done after the -translations listed above. @xref{Terminal I/O Encoding}. However, in -future Emacs versions, character set decoding may be done at an -earlier stage. +@code{set-keyboard-coding-system}, decoding is done before the +translations listed above. @xref{Terminal I/O Encoding}. + +@subsection Interaction with normal keymaps + +The end of a key sequence is detected when that key sequence either is bound +to a command, or when Emacs determines that no additional event can lead +to a sequence that is bound to a command. + +This means that, while @code{input-decode-map} and @code{key-translation-map} +apply regardless of whether the original key sequence would have a binding, the +presence of such a binding can still prevent translation from taking place. +For example, let us return to our VT100 example above and add a binding for +@kbd{C-c @key{ESC}} to the global map; now when the user hits @kbd{C-c +@key{PF1}} Emacs will fail to decode @kbd{C-c @key{ESC} O P} into @kbd{C-c +@key{PF1}} because it will stop reading keys right after @kbd{C-x @key{ESC}}, +leaving @kbd{O P} for later. This is in case the user really hit @kbd{C-c +@key{ESC}}, in which case Emacs should not sit there waiting for the next key +to decide whether the user really pressed @kbd{@key{ESC}} or @kbd{@key{PF1}}. + +For that reason, it is better to avoid binding commands to key sequences where +the end of the key sequence is a prefix of a key translation. The main such +problematic suffixes/prefixes are @kbd{@key{ESC}}, @kbd{M-O} (which is really +@kbd{@key{ESC} O}) and @kbd{M-[} (which is really @kbd{@key{ESC} [}). @node Key Binding Commands @section Commands for Binding Keys -- cgit v1.2.1 From b24696b8c857f76f4fa5769578e9b8db279a2aa8 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Thu, 15 Nov 2012 15:47:31 +0100 Subject: nt/config.nt: Sync with autogen/config.in. (GETGROUPS_T, GETGROUPS_ZERO_BUG, GNULIB_FACCESSAT, HAVE_ACCESS) (HAVE_EACCESS, HAVE_FACCESSAT, HAVE_GETGROUPS, HAVE_LIBGEN_H): New macros. --- nt/ChangeLog | 7 +++++++ nt/config.nt | 27 +++++++++++++++++++++++++++ 2 files changed, 34 insertions(+) diff --git a/nt/ChangeLog b/nt/ChangeLog index 685e291e272..d5df1e10857 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,10 @@ +2012-11-15 Juanma Barranquero + + * config.nt: Sync with autogen/config.in. + (GETGROUPS_T, GETGROUPS_ZERO_BUG, GNULIB_FACCESSAT, HAVE_ACCESS) + (HAVE_EACCESS, HAVE_FACCESSAT, HAVE_GETGROUPS, HAVE_LIBGEN_H): + New macros. + 2012-11-14 Eli Zaretskii * inc/unistd.h (faccessat): Add prototype. diff --git a/nt/config.nt b/nt/config.nt index 443a1025761..69549fb2087 100644 --- a/nt/config.nt +++ b/nt/config.nt @@ -180,6 +180,14 @@ along with GNU Emacs. If not, see . */ setjmp does work. */ #define GC_SETJMP_WORKS 1 +/* Define to the type of elements in the array set by `getgroups'. Usually + this is either `int' or `gid_t'. */ +#undef GETGROUPS_T + +/* Define this to 1 if getgroups(0,NULL) does not return the number of groups. + */ +#undef GETGROUPS_ZERO_BUG + /* Define if gettimeofday clobbers the localtime buffer. */ #undef GETTIMEOFDAY_CLOBBERS_LOCALTIME @@ -194,6 +202,10 @@ along with GNU Emacs. If not, see . */ whether the gnulib module close-stream shall be considered present. */ #undef GNULIB_CLOSE_STREAM +/* Define to a C preprocessor expression that evaluates to 1 or 0, depending + whether the gnulib module faccessat shall be considered present. */ +#undef GNULIB_FACCESSAT + /* Define to a C preprocessor expression that evaluates to 1 or 0, depending whether the gnulib module fscanf shall be considered present. */ #undef GNULIB_FSCANF @@ -215,6 +227,9 @@ along with GNU Emacs. If not, see . */ startup, if using GTK. */ #undef G_SLICE_ALWAYS_MALLOC +/* Define to 1 if you have the `access' function. */ +#undef HAVE_ACCESS + /* Define to 1 if the file /usr/lpp/X11/bin/smt.exp exists. */ #undef HAVE_AIX_SMT_EXP @@ -339,6 +354,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the 'dup2' function. */ #define HAVE_DUP2 1 +/* Define to 1 if you have the `eaccess' function. */ +#undef HAVE_EACCESS + /* Define to 1 if you have the `endgrent' function. */ #undef HAVE_ENDGRENT @@ -354,6 +372,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the header file. */ #define HAVE_EXECINFO_H 1 +/* Define to 1 if you have the `faccessat' function. */ +#undef HAVE_FACCESSAT + /* Define to 1 if you have the header file. */ #undef HAVE_FCNTL_H @@ -405,6 +426,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `getgrent' function. */ #undef HAVE_GETGRENT +/* Define to 1 if your system has a working `getgroups' function. */ +#undef HAVE_GETGROUPS + /* Define to 1 if you have the `gethostname' function. */ #define HAVE_GETHOSTNAME 1 @@ -571,6 +595,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `dnet' library (-ldnet). */ #undef HAVE_LIBDNET +/* Define to 1 if you have the header file. */ +#undef HAVE_LIBGEN_H + /* Define to 1 if you have the hesiod library (-lhesiod). */ #undef HAVE_LIBHESIOD -- cgit v1.2.1 From b72c161c5bda1836b0a86ceba1bd968abd00ff1a Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Thu, 15 Nov 2012 17:21:50 +0100 Subject: src/makefile.w32-in: Update dependencies. --- src/ChangeLog | 5 +++++ src/makefile.w32-in | 2 ++ 2 files changed, 7 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index d309931e8e6..8caaa2f68e0 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2012-11-15 Juanma Barranquero + + * makefile.w32-in ($(BLD)/dispnew.$(O), $(BLD)/emacs.$(O)): + Update dependencies. + 2012-11-15 Paul Eggert * eval.c (mark_backtrace) [BYTE_MARK_STACK]: Remove stray '*'. diff --git a/src/makefile.w32-in b/src/makefile.w32-in index f5cab34d7dc..69fd6857f86 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -737,6 +737,7 @@ $(BLD)/dispnew.$(O) : \ $(SRC)/termchar.h \ $(SRC)/w32.h \ $(NT_INC)/unistd.h \ + $(GNU_LIB)/fpending.h \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CONFIG_H) \ @@ -802,6 +803,7 @@ $(BLD)/emacs.$(O) : \ $(SRC)/w32select.h \ $(NT_INC)/sys/file.h \ $(NT_INC)/unistd.h \ + $(GNU_LIB)/close-stream.h \ $(GNU_LIB)/ignore-value.h \ $(ATIMER_H) \ $(BUFFER_H) \ -- cgit v1.2.1 From 5c2a71483b029100aabf5d64717120b31f4d6fa4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 15 Nov 2012 12:17:23 -0500 Subject: * src/eval.c (Finteractive_p): Revert lexbind-merge mishap. --- src/ChangeLog | 16 ++++++++++------ src/eval.c | 2 +- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 9caa5113444..d2e7a96f275 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2012-11-15 Stefan Monnier + + * eval.c (Finteractive_p): Revert lexbind-merge mishap. + 2012-11-14 Eli Zaretskii * w32proc.c (timer_loop): Make sure SuspendThread and ResumeThread @@ -28,16 +32,16 @@ * window.c (Fsplit_window_internal): Set combination limit of new parent window to t iff Vwindow_combination_limit is t; fixing a regression introduced with the change from 2012-09-22. - (Fwindow_combination_limit, Fset_window_combination_limit): Fix - doc-strings. + (Fwindow_combination_limit, Fset_window_combination_limit): + Fix doc-strings. 2012-11-06 Eli Zaretskii * xdisp.c (try_scrolling): Fix correction of aggressive-scroll amount when the scroll margins are too large. When scrolling backwards in the buffer, give up if cannot reach point or the - scroll margin within a reasonable number of screen lines. Fixes - point position in window under scroll-up/down-aggressively when + scroll margin within a reasonable number of screen lines. + Fixes point position in window under scroll-up/down-aggressively when point is positioned many lines beyond the window top/bottom. (Bug#12811) @@ -118,8 +122,8 @@ 2012-10-29 Daniel Colascione - * cygw32.h, cygw32.c (Qutf_16le, from_unicode, to_unicode): In - preparation for fixing bug#12739, move these functions from + * cygw32.h, cygw32.c (Qutf_16le, from_unicode, to_unicode): + In preparation for fixing bug#12739, move these functions from here... * coding.h, coding.c: ... to here, and compile them only when diff --git a/src/eval.c b/src/eval.c index 975204da017..58fa92cd7b5 100644 --- a/src/eval.c +++ b/src/eval.c @@ -508,7 +508,7 @@ spec that specifies non-nil unconditionally (such as \"p\"); or (ii) use `called-interactively-p'. */) (void) { - return interactive_p () ? Qt : Qnil; + return (INTERACTIVE && interactive_p ()) ? Qt : Qnil; } -- cgit v1.2.1 From eb31fa401dd2163032c6d3320778008043bfde55 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 15 Nov 2012 13:35:05 -0500 Subject: * lisp/emacs-lisp/cl-macs.el (cl-flet, cl-flet*): Fix docstring. Fixes: debbugs:12895 --- lisp/ChangeLog | 4 ++++ lisp/emacs-lisp/cl-macs.el | 4 ++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 74981d0c241..c84c6fe9dd2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2012-11-15 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl-flet, cl-flet*): Fix docstring (bug#12895). + 2012-11-15 Glenn Morris * eshell/em-cmpl.el (eshell-pcomplete): New command. (Bug#12838) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index b28f8f7f9e9..52188c53e6f 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1648,7 +1648,7 @@ a `let' form, except that the list of symbols can be computed at run-time." ;;;###autoload (defmacro cl-flet (bindings &rest body) - "Make temporary function definitions. + "Make local function definitions. Like `cl-labels' but the definitions are not recursive. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" @@ -1672,7 +1672,7 @@ Like `cl-labels' but the definitions are not recursive. ;;;###autoload (defmacro cl-flet* (bindings &rest body) - "Make temporary function definitions. + "Make local function definitions. Like `cl-flet' but the definitions can refer to previous ones. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" -- cgit v1.2.1 From 662b0ee67c701dbae7c15094e2d6d3d64dfe5e8e Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Thu, 15 Nov 2012 22:01:25 +0100 Subject: lisp/emacs-lisp/cl-macs.el (cl-loop, cl-do, cl-do*): Doc fixes. --- lisp/ChangeLog | 4 ++++ lisp/emacs-lisp/cl-macs.el | 6 +++--- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c84c6fe9dd2..81204ca2332 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2012-11-15 Juanma Barranquero + + * emacs-lisp/cl-macs.el (cl-loop, cl-do, cl-do*): Doc fixes. + 2012-11-15 Stefan Monnier * emacs-lisp/cl-macs.el (cl-flet, cl-flet*): Fix docstring (bug#12895). diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 52188c53e6f..c0b6be44d7b 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -756,7 +756,7 @@ This is compatible with Common Lisp, but note that `defun' and ;;;###autoload (defmacro cl-loop (&rest loop-args) - "The Common Lisp `cl-loop' macro. + "The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, @@ -1501,7 +1501,7 @@ such that COMBO is equivalent to (and . CLAUSES)." ;;;###autoload (defmacro cl-do (steps endtest &rest body) - "The Common Lisp `cl-do' loop. + "The Common Lisp `do' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (declare (indent 2) @@ -1513,7 +1513,7 @@ such that COMBO is equivalent to (and . CLAUSES)." ;;;###autoload (defmacro cl-do* (steps endtest &rest body) - "The Common Lisp `cl-do*' loop. + "The Common Lisp `do*' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (declare (indent 2) (debug cl-do)) -- cgit v1.2.1 From faeafc0133e90bdd6e1df134e507201d6e3c7a38 Mon Sep 17 00:00:00 2001 From: Daniel Colascione Date: Thu, 15 Nov 2012 15:28:27 -0800 Subject: Use right url-handler for drag-and-dropped files under Windows --- lisp/ChangeLog | 7 +++++++ lisp/term/w32-win.el | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bd535894cdf..3273baad872 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2012-11-15 Daniel Colascione + + * term/w32-win.el (w32-handle-dropped-file): Use a "file://" + prefix instead of "file:" so that when FILE-NAME begins with "//" + (as it does when the target file is on a network share), + url-handler isn't confused. + 2012-10-30 Glenn Morris * emacs-lisp/cl-extra.el (cl-mapc): Add autoload cookie. Doc fix. diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index ad6e1125027..224fb7c1442 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -116,7 +116,7 @@ "/") "/"))) (dnd-handle-one-url window 'private - (concat "file:" file-name))) + (concat "file://" file-name))) (defun w32-drag-n-drop (event &optional new-frame) "Edit the files listed in the drag-n-drop EVENT. -- cgit v1.2.1 From d56f2e49b2353336e853025219440c3e1572524e Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 15 Nov 2012 21:40:54 -0500 Subject: * src/editfns.c (Fmessage): Mention message-log-max. (Bug#12849) --- src/ChangeLog | 4 ++++ src/editfns.c | 4 ++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index d2e7a96f275..b218e42b3f2 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2012-11-16 Glenn Morris + + * editfns.c (Fmessage): Mention message-log-max. (Bug#12849) + 2012-11-15 Stefan Monnier * eval.c (Finteractive_p): Revert lexbind-merge mishap. diff --git a/src/editfns.c b/src/editfns.c index c5d4ed295ab..8122ffdd0d4 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3434,8 +3434,8 @@ static ptrdiff_t message_length; DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, doc: /* Display a message at the bottom of the screen. -The message also goes into the `*Messages*' buffer. -\(In keyboard macros, that's all it does.) +The message also goes into the `*Messages*' buffer, if `message-log-max' +is non-nil. (In keyboard macros, that's all it does.) Return the message. The first argument is a format control string, and the rest are data -- cgit v1.2.1 From dedd188497e04b8f0c1ade515e41511759316d2d Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 15 Nov 2012 21:44:02 -0500 Subject: * lisp/faces.el (face-underline-p): Use face-attribute-specified-or. --- lisp/ChangeLog | 4 ++++ lisp/faces.el | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 81204ca2332..a62288dd29a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2012-11-16 Glenn Morris + + * faces.el (face-underline-p): Use face-attribute-specified-or. + 2012-11-15 Juanma Barranquero * emacs-lisp/cl-macs.el (cl-loop, cl-do, cl-do*): Doc fixes. diff --git a/lisp/faces.el b/lisp/faces.el index d07c4d6f5a5..9e0ca962499 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -497,7 +497,7 @@ with the `default' face (which is always completely specified)." If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." - (not (memq (face-attribute face :underline frame) '(unspecified nil)))) + (face-attribute-specified-or (face-attribute face :underline frame) nil)) (defun face-inverse-video-p (face &optional frame) -- cgit v1.2.1 From e8693c969a822ad8192f2410fbf9a949a723ddce Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 15 Nov 2012 23:43:24 -0800 Subject: cl.texi flet clarification * doc/misc/cl.texi (Function Bindings): Clarify that cl-flet is lexical. (Obsolete Macros): Move example here from Function Bindings. * etc/NEWS: Related edit. --- doc/misc/ChangeLog | 5 +++++ doc/misc/cl.texi | 48 +++++++++++++++++++++++++++--------------------- etc/NEWS | 2 ++ 3 files changed, 34 insertions(+), 21 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 07f38d15dd9..4a3c8778e88 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,8 @@ +2012-11-16 Glenn Morris + + * cl.texi (Function Bindings): Clarify that cl-flet is lexical. + (Obsolete Macros): Move example here from Function Bindings. + 2012-11-13 Glenn Morris * erc.texi: Use @code{nil} rather than just "nil". diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index a50be1027f3..beefa3e9c40 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -1292,28 +1292,14 @@ it were a @code{cl-defun} form. The function @var{name} is defined accordingly for the duration of the body of the @code{cl-flet}; then the old function definition, or lack thereof, is restored. -You can use @code{cl-flet} to disable or modify the behavior of a -function in a temporary fashion. (Compare this with the idea -of advising functions. +You can use @code{cl-flet} to disable or modify the behavior of +functions (including Emacs primitives) in a temporary, localized fashion. +(Compare this with the idea of advising functions. @xref{Advising Functions,,,elisp,GNU Emacs Lisp Reference Manual}.) -This will even work on Emacs primitives, although note that some calls -to primitive functions internal to Emacs are made without going -through the symbol's function cell, and so will not be affected by -@code{cl-flet}. For example, - -@example -(cl-flet ((message (&rest args) (push args saved-msgs))) - (do-something)) -@end example -This code attempts to replace the built-in function @code{message} -with a function that simply saves the messages in a list rather -than displaying them. The original definition of @code{message} -will be restored after @code{do-something} exits. This code will -work fine on messages generated by other Lisp code, but messages -generated directly inside Emacs will not be caught since they make -direct C-language calls to the message routines rather than going -through the Lisp @code{message} function. +The bindings are lexical in scope. This means that all references to +the named functions must appear physically within the body of the +@code{cl-flet} form. Functions defined by @code{cl-flet} may use the full Common Lisp argument notation supported by @code{cl-defun}; also, the function @@ -1321,7 +1307,8 @@ body is enclosed in an implicit block as if by @code{cl-defun}. @xref{Program Structure}. Note that the @file{cl.el} version of this macro behaves slightly -differently. @xref{Obsolete Macros}. +differently. In particular, its binding is dynamic rather than +lexical. @xref{Obsolete Macros}. @end defmac @defmac cl-labels (bindings@dots{}) forms@dots{} @@ -4863,6 +4850,25 @@ time before Emacs had lexical binding). The result is that @code{flet} affects indirect calls to a function as well as calls directly inside the @code{flet} form itself. +This will even work on Emacs primitives, although note that some calls +to primitive functions internal to Emacs are made without going +through the symbol's function cell, and so will not be affected by +@code{flet}. For example, + +@example +(flet ((message (&rest args) (push args saved-msgs))) + (do-something)) +@end example + +This code attempts to replace the built-in function @code{message} +with a function that simply saves the messages in a list rather +than displaying them. The original definition of @code{message} +will be restored after @code{do-something} exits. This code will +work fine on messages generated by other Lisp code, but messages +generated directly inside Emacs will not be caught since they make +direct C-language calls to the message routines rather than going +through the Lisp @code{message} function. + @c Bug#411. Note that many primitives (e.g.@: @code{+}) have special byte-compile handling. Attempts to redefine such functions using @code{flet} will diff --git a/etc/NEWS b/etc/NEWS index b69240e081a..ba6dc68d72c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -320,6 +320,8 @@ provide the old non-prefixed names. Some exceptions are listed below. +++ *** `cl-flet' is not like `flet' (which is deprecated). Instead it obeys the behavior of Common-Lisp's `flet'. +In particular, in cl-flet function definitions are lexically scoped, +whereas in flet the scoping is dynamic. +++ *** `cl-labels' is slightly different from `labels'. -- cgit v1.2.1 From b0634f5d0a5ec5bc97c4d0cc7c8544611cbf0adc Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 16 Nov 2012 00:00:15 -0800 Subject: NEWS potential FIXME --- etc/NEWS | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index ba6dc68d72c..42e773b2a03 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -815,6 +815,12 @@ in the presence of quoting, such as file completion in shell buffers. *** New function `completion-table-subvert' to use an existing completion table, but with a different prefix. +FIXME? +*** There are several other completion-table- functions that never got +added to NEWS or documented: completion-table-case-fold (24.1), +completion-table-with-context (23,1), completion-table-with-terminator (23.1), +completion-table-with-predicate (23.1), completion-table-in-turn (23.1) + ** Debugger changes +++ -- cgit v1.2.1 From 7c82753d4cee69bc63cf19daee89b69873559221 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 16 Nov 2012 00:31:20 -0800 Subject: Doc fixes related to fit-frame-to-buffer * lisp/window.el (fit-frame-to-buffer-bottom-margin) (fit-frame-to-buffer, fit-window-to-buffer): Doc fixes. * etc/NEWS: Related edit. --- etc/NEWS | 8 ++++++-- lisp/ChangeLog | 3 +++ lisp/window.el | 26 +++++++++++++++++--------- 3 files changed, 26 insertions(+), 11 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 42e773b2a03..3bd4ebae4fa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -851,8 +851,12 @@ now accept a third argument to avoid choosing the selected window. *** `temp-buffer-resize-mode' no longer resizes windows that have been reused. -*** New function `fit-frame-to-buffer' and new options -`fit-frame-to-buffer' and `fit-frame-to-buffer-bottom-margin'. +*** New command `fit-frame-to-buffer' adjusts the frame height to +fit the contents. + +*** The command `fit-window-to-buffer' can adjust the frame height +if the new option `fit-frame-to-buffer' is non-nil. + +++ *** New option switch-to-buffer-preserve-window-point to restore a window's point when switching buffers. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a62288dd29a..74d66809d55 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2012-11-16 Glenn Morris + * window.el (fit-frame-to-buffer-bottom-margin) + (fit-frame-to-buffer, fit-window-to-buffer): Doc fixes. + * faces.el (face-underline-p): Use face-attribute-specified-or. 2012-11-15 Juanma Barranquero diff --git a/lisp/window.el b/lisp/window.el index 6ea66d9d0a2..c9ea8351e8c 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6074,22 +6074,26 @@ of `fit-frame-to-buffer-max-height' and `window-min-height'." :group 'help) (defcustom fit-frame-to-buffer-bottom-margin 4 - "Bottom margin for `fit-frame-to-buffer'. -This is the number of lines `fit-frame-to-buffer' leaves free at the -bottom of the display in order to not obscure the system task bar." + "Bottom margin for the command `fit-frame-to-buffer'. +This is the number of lines that function leaves free at the bottom of +the display, in order to not obscure any system task bar or panel. +If you do not have one (or if it is vertical) you might want to +reduce this. If it is thicker, you might want to increase this." + ;; If you set this too small, fit-frame-to-buffer can shift the + ;; frame up to avoid the panel. :type 'integer :version "24.3" :group 'windows) (defun fit-frame-to-buffer (&optional frame max-height min-height) - "Adjust height of FRAME to display its buffer's contents exactly. + "Adjust height of FRAME to display its buffer contents exactly. FRAME can be any live frame and defaults to the selected one. -Optional argument MAX-HEIGHT specifies the maximum height of -FRAME and defaults to the height of the display below the current -top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN. -Optional argument MIN-HEIGHT specifies the minimum height of -FRAME." +Optional argument MAX-HEIGHT specifies the maximum height of FRAME. +It defaults to the height of the display below the current +top line of FRAME, minus `fit-frame-to-buffer-bottom-margin'. +Optional argument MIN-HEIGHT specifies the minimum height of FRAME. +The default corresponds to `window-min-height'." (interactive) (setq frame (window-normalize-frame frame)) (let* ((root (frame-root-window frame)) @@ -6166,6 +6170,10 @@ defaults to `window-min-height'. Both MAX-HEIGHT and MIN-HEIGHT are specified in lines and include the mode line and header line, if any. +If WINDOW is a full height window, then if the option +`fit-frame-to-buffer' is non-nil, this calls the function +`fit-frame-to-buffer' to adjust the frame height. + Return the number of lines by which WINDOW was enlarged or shrunk. If an error occurs during resizing, return nil but don't signal an error. -- cgit v1.2.1 From a2cfe8a3b8d2368a96951710c774e126c8283c10 Mon Sep 17 00:00:00 2001 From: Jan Tatarik Date: Fri, 16 Nov 2012 10:44:35 +0100 Subject: [Gnus] Don't score by headers when scoring by body * gnus-score.el (gnus-score-body): * gnus-logic.el (gnus-advanced-body): Don't score by headers when scoring by body. --- lisp/gnus/ChangeLog | 6 ++++++ lisp/gnus/gnus-logic.el | 13 +++++++------ lisp/gnus/gnus-score.el | 17 +++++++++-------- 3 files changed, 22 insertions(+), 14 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index d1cf22fd971..55d11d4c6b1 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,9 @@ +2012-11-16 Jan Tatarik + + * gnus-score.el (gnus-score-body): + * gnus-logic.el (gnus-advanced-body): Don't score by headers when + scoring by body. + 2012-11-13 Glenn Morris * gnus-diary.el (nndiary-request-create-group-functions) diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el index a440b779930..60d7b31713b 100644 --- a/lisp/gnus/gnus-logic.el +++ b/lisp/gnus/gnus-logic.el @@ -181,17 +181,18 @@ (with-current-buffer nntp-server-buffer (let* ((request-func (cond ((string= "head" header) 'gnus-request-head) - ;; We need to peek at the headers to detect the - ;; content encoding ((string= "body" header) - 'gnus-request-article) + 'gnus-request-body) (t 'gnus-request-article))) ofunc article handles) ;; Not all backends support partial fetching. In that case, we ;; just fetch the entire article. - (unless (gnus-check-backend-function - (intern (concat "request-" header)) - gnus-newsgroup-name) + ;; When scoring by body, we need to peek at the headers to detect the + ;; content encoding + (unless (or (gnus-check-backend-function + (intern (concat "request-" header)) + gnus-newsgroup-name) + (string= "body" header)) (setq ofunc request-func) (setq request-func 'gnus-request-article)) (setq article (mail-header-number gnus-advanced-headers)) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index f215b845514..b7061960839 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -1762,21 +1762,22 @@ score in `gnus-newsgroup-scored' by SCORE." (all-scores scores) (request-func (cond ((string= "head" header) 'gnus-request-head) - ;; We need to peek at the headers to detect - ;; the content encoding ((string= "body" header) - 'gnus-request-article) + 'gnus-request-body) (t 'gnus-request-article))) entries alist ofunc article last) (when articles (setq last (mail-header-number (caar (last articles)))) ;; Not all backends support partial fetching. In that case, ;; we just fetch the entire article. - (unless (gnus-check-backend-function - (and (string-match "^gnus-" (symbol-name request-func)) - (intern (substring (symbol-name request-func) - (match-end 0)))) - gnus-newsgroup-name) + ;; When scoring by body, we need to peek at the headers to detect + ;; the content encoding + (unless (or (gnus-check-backend-function + (and (string-match "^gnus-" (symbol-name request-func)) + (intern (substring (symbol-name request-func) + (match-end 0)))) + gnus-newsgroup-name) + (string= "body" header)) (setq ofunc request-func) (setq request-func 'gnus-request-article)) (while articles -- cgit v1.2.1 From 0ff7851c6b4fa2e5c085ee8a42bbe7ccb16b115e Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Fri, 16 Nov 2012 11:29:48 +0100 Subject: Fix some display-buffer related issues. * window.el (enlarge-window, shrink-window): Don't mention return value in doc-string (Bug#12896). (window--display-buffer): Don't resize frames - it won't work with all window managers and defeat pop-up-frame-alist. (display-buffer-alist): In doc-string explain that CONDITION can be a function and which arguments are passed to it (Bug#12854). (display-buffer-assq-regexp): New argument ACTION. Handle lambda expressions (Bug#12854). (display-buffer): Pass ACTION argument to display-buffer-assq-regexp. * windows.texi (Choosing Window): Rewrite description of display-buffer-alist (Bug#12167). (Display Action Functions): Mention inhibit-switch-frame. Fix description of display-buffer-below-selected. Reorder actions. Add example (Bug#12848). --- doc/lispref/ChangeLog | 8 ++++ doc/lispref/windows.texi | 108 +++++++++++++++++++++++++++++++++++++++++------ lisp/ChangeLog | 13 ++++++ lisp/window.el | 75 +++++++++++++++----------------- 4 files changed, 149 insertions(+), 55 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 89b456f5c22..062692ee9f3 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,11 @@ +2012-11-16 Martin Rudalics + + * windows.texi (Choosing Window): Rewrite description of + display-buffer-alist (Bug#12167). + (Display Action Functions): Mention inhibit-switch-frame. Fix + description of display-buffer-below-selected. Reorder actions. + Add example (Bug#12848). + 2012-11-15 Stefan Monnier * keymaps.texi (Translation Keymaps): Add a subsection "Interaction diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index bb02b1d54fd..77f1ff9a179 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -1766,6 +1766,7 @@ Like @code{switch-to-buffer}, this function updates the buffer list unless @var{norecord} is non-@code{nil}. @end deffn + @node Choosing Window @section Choosing a Window for Display @@ -1851,10 +1852,14 @@ default value is empty, i.e. @code{(nil . nil)}. @end defvar @defopt display-buffer-alist -The value of this option is an alist mapping regular expressions to -display actions. If the name of the buffer passed to -@code{display-buffer} matches a regular expression in this alist, then -@code{display-buffer} uses the corresponding display action. +The value of this option is an alist mapping conditions to display +actions. Each condition may be either a regular expression matching a +buffer name or a function that takes two arguments - a buffer name and +the @var{action} argument passed to @code{display-buffer}. If the name +of the buffer passed to @code{display-buffer} either matches a regular +expression in this alist or the function specified by a condition +returns non-@code{nil}, then @code{display-buffer} uses the +corresponding display action to display the buffer. @end defopt @defopt display-buffer-base-action @@ -1868,6 +1873,7 @@ This display action specifies the fallback behavior for @code{display-buffer} if no other display actions are given. @end defvr + @node Display Action Functions @section Action Functions for @code{display-buffer} @@ -1911,8 +1917,9 @@ normally searches just the selected frame; however, if the variable @code{pop-up-frames} is non-@code{nil}, it searches all frames on the current terminal. @xref{Choosing Window Options}. -If this function chooses a window on another frame, it makes that -frame visible and raises it if necessary. +If this function chooses a window on another frame, it makes that frame +visible and, unless @var{alist} contains an @code{inhibit-switch-frame} +entry (@pxref{Choosing Window Options}), raises that frame if necessary. @end defun @defun display-buffer-pop-up-frame buffer alist @@ -1976,16 +1983,12 @@ reason (e.g. if there is just one frame and it has an @code{unsplittable} frame parameter; @pxref{Buffer Parameters}). @end defun -@defun display-buffer-use-some-window buffer alist -This function tries to display @var{buffer} by choosing an existing -window and displaying the buffer in that window. It can fail if all -windows are dedicated to another buffer (@pxref{Dedicated Windows}). -@end defun - @defun display-buffer-below-selected buffer alist This function tries to display @var{buffer} in a window below the -selected window. This means to either split the selected window or -reuse the window below the selected one. +selected window. This means to either split the selected window or use +the window below the selected one. If it does create a new window, it +will also adjust its size provided @var{alist} contains a suitable +@code{window-height} or @code{window-width} entry, see above. @end defun @defun display-buffer-in-previous-window buffer alist @@ -2001,6 +2004,83 @@ specified by that entry will override any other window found by the methods above, even if that window never showed @var{buffer} before. @end defun +@defun display-buffer-use-some-window buffer alist +This function tries to display @var{buffer} by choosing an existing +window and displaying the buffer in that window. It can fail if all +windows are dedicated to another buffer (@pxref{Dedicated Windows}). +@end defun + +To illustrate the use of action functions, consider the following +example. + +@example +@group +(display-buffer + (get-buffer-create "*foo*") + '((display-buffer-reuse-window + display-buffer-pop-up-window + display-buffer-pop-up-frame) + (reusable-frames . 0) + (window-height . 10) (window-width . 40))) +@end group +@end example + +@noindent +Evaluating the form above will cause @code{display-buffer} to proceed as +follows: If `*foo*' already appears on a visible or iconified frame, it +will reuse its window. Otherwise, it will try to pop up a new window +or, if that is impossible, a new frame. If all these steps fail, it +will try to use some existing window. + + Furthermore, @code{display-buffer} will try to adjust a reused window +(provided `*foo*' was put by @code{display-buffer} there before) or a +popped-up window as follows: If the window is part of a vertical +combination, it will set its height to ten lines. Note that if, instead +of the number ``10'', we specified the function +@code{fit-window-to-buffer}, @code{display-buffer} would come up with a +one-line window to fit the empty buffer. If the window is part of a +horizontal combination, it sets its width to 40 columns. Whether a new +window is vertically or horizontally combined depends on the shape of +the window split and the values of +@code{split-window-preferred-function}, @code{split-height-threshold} +and @code{split-width-threshold} (@pxref{Choosing Window Options}). + + Now suppose we combine this call with a preexisting setup for +`display-buffer-alist' as follows. + +@example +@group +(let ((display-buffer-alist + (cons + '("\\*foo\\*" + (display-buffer-reuse-window display-buffer-below-selected) + (reusable-frames) + (window-height . 5)) + display-buffer-alist))) + (display-buffer + (get-buffer-create "*foo*") + '((display-buffer-reuse-window + display-buffer-pop-up-window + display-buffer-pop-up-frame) + (reusable-frames . 0) + (window-height . 10) (window-width . 40)))) +@end group +@end example + +@noindent +Evaluating this form will cause @code{display-buffer} to first try +reusing a window showing @code{*foo*} on the selected frame. +If no such window exists, it will try to split the selected window or, +if that is impossible, use the window below the selected window. + + If there's no window below the selected one, or the window below the +selected one is dedicated to its buffer, @code{display-buffer} will +proceed as described in the previous example. Note, however, that when +it tries to adjust the height of any reused or popped-up window, it will +in any case try to set its number of lines to ``5'' since that value +overrides the corresponding specification in the @var{action} argument +of @code{display-buffer}. + @node Choosing Window Options @section Additional Options for Displaying Buffers diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 74d66809d55..a267c726986 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2012-11-16 Martin Rudalics + + * window.el (enlarge-window, shrink-window): Don't mention return + value in doc-string (Bug#12896). + (window--display-buffer): Don't resize frames - it won't work + with all window managers and defeat pop-up-frame-alist. + (display-buffer-alist): In doc-string explain that CONDITION can + be a function and which arguments are passed to it (Bug#12854). + (display-buffer-assq-regexp): New argument ACTION. Handle lambda + expressions (Bug#12854). + (display-buffer): Pass ACTION argument to + display-buffer-assq-regexp. + 2012-11-16 Glenn Morris * window.el (fit-frame-to-buffer-bottom-margin) diff --git a/lisp/window.el b/lisp/window.el index c9ea8351e8c..9ac3a4ecda0 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2571,8 +2571,7 @@ move it as far as possible in the desired direction." Interactively, if no argument is given, make the selected window one line taller. If optional argument HORIZONTAL is non-nil, make selected window wider by DELTA columns. If DELTA is -negative, shrink selected window by -DELTA lines or columns. -Return nil." +negative, shrink selected window by -DELTA lines or columns." (interactive "p") (let ((minibuffer-window (minibuffer-window))) (cond @@ -2605,8 +2604,7 @@ Interactively, if no argument is given, make the selected window one line smaller. If optional argument HORIZONTAL is non-nil, make selected window narrower by DELTA columns. If DELTA is negative, enlarge selected window by -DELTA lines or columns. -Also see the `window-min-height' variable. -Return nil." +Also see the `window-min-height' variable." (interactive "p") (let ((minibuffer-window (minibuffer-window))) (cond @@ -5176,11 +5174,12 @@ is higher than WINDOW." (error nil)))) (defun window--display-buffer (buffer window type &optional alist dedicated) - "Display BUFFER in WINDOW and make its frame visible. + "Display BUFFER in WINDOW. TYPE must be one of the symbols `reuse', `window' or `frame' and -is passed unaltered to `display-buffer-record-window'. Set -`window-dedicated-p' to DEDICATED if non-nil. Return WINDOW if -BUFFER and WINDOW are live." +is passed unaltered to `display-buffer-record-window'. ALIST is +the alist argument of `display-buffer'. Set `window-dedicated-p' +to DEDICATED if non-nil. Return WINDOW if BUFFER and WINDOW are +live." (when (and (buffer-live-p buffer) (window-live-p window)) (display-buffer-record-window type window buffer) (unless (eq buffer (window-buffer window)) @@ -5193,10 +5192,10 @@ BUFFER and WINDOW are live." (let ((parameter (window-parameter window 'quit-restore)) (height (cdr (assq 'window-height alist))) (width (cdr (assq 'window-width alist)))) - (when (or (memq type '(window frame)) + (when (or (eq type 'window) (and (eq (car parameter) 'same) - (memq (nth 1 parameter) '(window frame)))) - ;; Adjust height of new window or frame. + (eq (nth 1 parameter) 'window))) + ;; Adjust height of window if asked for. (cond ((not height)) ((numberp height) @@ -5207,19 +5206,12 @@ BUFFER and WINDOW are live." (* (window-total-size (frame-root-window window)) height)))) (delta (- new-height (window-total-size window)))) - (cond - ((and (window--resizable-p window delta nil 'safe) - (window-combined-p window)) - (window-resize window delta nil 'safe)) - ((or (eq type 'frame) - (and (eq (car parameter) 'same) - (eq (nth 1 parameter) 'frame))) - (set-frame-height - (window-frame window) - (+ (frame-height (window-frame window)) delta)))))) + (when (and (window--resizable-p window delta nil 'safe) + (window-combined-p window)) + (window-resize window delta nil 'safe)))) ((functionp height) (ignore-errors (funcall height window)))) - ;; Adjust width of a window or frame. + ;; Adjust width of window if asked for. (cond ((not width)) ((numberp width) @@ -5230,18 +5222,12 @@ BUFFER and WINDOW are live." (* (window-total-size (frame-root-window window) t) width)))) (delta (- new-width (window-total-size window t)))) - (cond - ((and (window--resizable-p window delta t 'safe) - (window-combined-p window t)) - (window-resize window delta t 'safe)) - ((or (eq type 'frame) - (and (eq (car parameter) 'same) - (eq (nth 1 parameter) 'frame))) - (set-frame-width - (window-frame window) - (+ (frame-width (window-frame window)) delta)))))) + (when (and (window--resizable-p window delta t 'safe) + (window-combined-p window t)) + (window-resize window delta t 'safe)))) ((functionp width) (ignore-errors (funcall width window)))))) + window)) (defun window--maybe-raise-frame (frame) @@ -5301,13 +5287,19 @@ See `display-buffer' for details.") "Alist of conditional actions for `display-buffer'. This is a list of elements (CONDITION . ACTION), where: - CONDITION is either a regexp matching buffer names, or a function - that takes a buffer and returns a boolean. + CONDITION is either a regexp matching buffer names, or a + function that takes two arguments - a buffer name and the + ACTION argument of `display-buffer' - and returns a boolean. ACTION is a cons cell (FUNCTION . ALIST), where FUNCTION is a function or a list of functions. Each such function should accept two arguments: a buffer to display and an alist of the - same form as ALIST. See `display-buffer' for details." + same form as ALIST. See `display-buffer' for details. + +`display-buffer' scans this alist until it either finds a +matching regular expression or the function specified by a +condition returns non-nil. In any of these cases, it adds the +associated action to the list of actions it will try." :type `(alist :key-type (choice :tag "Condition" regexp @@ -5341,15 +5333,16 @@ specified, e.g. by the user options `display-buffer-alist' or `display-buffer-base-action'. See `display-buffer'.") (put 'display-buffer-fallback-action 'risky-local-variable t) -(defun display-buffer-assq-regexp (buffer-name alist) - "Retrieve ALIST entry corresponding to BUFFER-NAME." +(defun display-buffer-assq-regexp (buffer-name alist action) + "Retrieve ALIST entry corresponding to BUFFER-NAME. +ACTION is the action argument passed to `display-buffer'." (catch 'match (dolist (entry alist) (let ((key (car entry))) (when (or (and (stringp key) (string-match-p key buffer-name)) - (and (symbolp key) (functionp key) - (funcall key buffer-name alist))) + (and (functionp key) + (funcall key buffer-name action))) (throw 'match (cdr entry))))))) (defvar display-buffer--same-window-action @@ -5459,8 +5452,8 @@ argument, ACTION is t." (funcall display-buffer-function buffer inhibit-same-window) ;; Otherwise, use the defined actions. (let* ((user-action - (display-buffer-assq-regexp (buffer-name buffer) - display-buffer-alist)) + (display-buffer-assq-regexp + (buffer-name buffer) display-buffer-alist action)) (special-action (display-buffer--special-action buffer)) ;; Extra actions from the arguments to this function: (extra-action -- cgit v1.2.1 From 2a07c70a94109903838b81aa825f8f90bbe70a21 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 16 Nov 2012 07:17:47 -0500 Subject: Auto-commit of loaddefs files. --- lisp/emacs-lisp/cl-loaddefs.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index e18c32da996..eaae3ce1e9b 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'. ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "a7228877484d2b39e1c2bee40b011734") +;;;;;; "cl-macs" "cl-macs.el" "f254af8368e40df51f8b6440ec764a6a") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@ -416,7 +416,7 @@ This is compatible with Common Lisp, but note that `defun' and (put 'cl-return-from 'lisp-indent-function '1) (autoload 'cl-loop "cl-macs" "\ -The Common Lisp `cl-loop' macro. +The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, @@ -432,14 +432,14 @@ Valid clauses are: \(fn CLAUSE...)" nil t) (autoload 'cl-do "cl-macs" "\ -The Common Lisp `cl-do' loop. +The Common Lisp `do' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t) (put 'cl-do 'lisp-indent-function '2) (autoload 'cl-do* "cl-macs" "\ -The Common Lisp `cl-do*' loop. +The Common Lisp `do*' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t) @@ -501,7 +501,7 @@ a `let' form, except that the list of symbols can be computed at run-time. (put 'cl-progv 'lisp-indent-function '2) (autoload 'cl-flet "cl-macs" "\ -Make temporary function definitions. +Make local function definitions. Like `cl-labels' but the definitions are not recursive. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) @@ -509,7 +509,7 @@ Like `cl-labels' but the definitions are not recursive. (put 'cl-flet 'lisp-indent-function '1) (autoload 'cl-flet* "cl-macs" "\ -Make temporary function definitions. +Make local function definitions. Like `cl-flet' but the definitions can refer to previous ones. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) -- cgit v1.2.1 From 3d082a269ece18058ed82957f8a056822b39789e Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 16 Nov 2012 07:29:22 -0800 Subject: Remove no-longer-used pty_max_bytes variable. * configure.ac (fpathconf): Remove unnecessary check. * admin/CPP-DEFINES (HAVE_FPATHCONF): Remove. * src/process.c (pty_max_bytes): Remove; unused. (send_process): Do not set it. --- ChangeLog | 5 +++++ admin/CPP-DEFINES | 1 - admin/ChangeLog | 5 +++++ configure.ac | 2 +- src/ChangeLog | 6 ++++++ src/process.c | 16 ---------------- 6 files changed, 17 insertions(+), 18 deletions(-) diff --git a/ChangeLog b/ChangeLog index f5f649aae6d..1e5bf54a897 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-11-16 Paul Eggert + + Remove no-longer-used pty_max_bytes variable. + * configure.ac (fpathconf): Remove unnecessary check. + 2012-11-14 Paul Eggert Use faccessat, not access, when checking file permissions (Bug#12632). diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 0a4c14cb95c..17c56dc7e9e 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -152,7 +152,6 @@ HAVE_ENVIRON_DECL HAVE_EUIDACCESS HAVE_FCNTL_H HAVE_FORK -HAVE_FPATHCONF HAVE_FREEIFADDRS HAVE_FREETYPE HAVE_FSEEKO diff --git a/admin/ChangeLog b/admin/ChangeLog index fd28bf1228f..4eb413e948f 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,8 @@ +2012-11-16 Paul Eggert + + Remove no-longer-used pty_max_bytes variable. + * CPP-DEFINES (HAVE_FPATHCONF): Remove. + 2012-11-14 Paul Eggert Use faccessat, not access, when checking file permissions (Bug#12632). diff --git a/configure.ac b/configure.ac index b0c81a23f8a..937c645bb58 100644 --- a/configure.ac +++ b/configure.ac @@ -2874,7 +2874,7 @@ AC_SUBST(BLESSMAIL_TARGET) AC_CHECK_FUNCS(gethostname \ closedir getrusage get_current_dir_name \ lrand48 \ -fpathconf select getpagesize setlocale \ +select getpagesize setlocale \ utimes getrlimit setrlimit getcwd shutdown getaddrinfo \ strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ diff --git a/src/ChangeLog b/src/ChangeLog index 8caaa2f68e0..c9c754f8677 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2012-11-16 Paul Eggert + + Remove no-longer-used pty_max_bytes variable. + * process.c (pty_max_bytes): Remove; unused. + (send_process): Do not set it. + 2012-11-15 Juanma Barranquero * makefile.w32-in ($(BLD)/dispnew.$(O), $(BLD)/emacs.$(O)): diff --git a/src/process.c b/src/process.c index 728abebe758..785282fba36 100644 --- a/src/process.c +++ b/src/process.c @@ -340,9 +340,6 @@ static struct sockaddr_and_len { #define DATAGRAM_CONN_P(proc) (0) #endif -/* Maximum number of bytes to send to a pty without an eof. */ -static int pty_max_bytes; - /* These setters are used only in this file, so they can be private. */ static void pset_buffer (struct Lisp_Process *p, Lisp_Object val) @@ -5532,19 +5529,6 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, buf = SSDATA (object); } - if (pty_max_bytes == 0) - { -#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON) - pty_max_bytes = fpathconf (p->outfd, _PC_MAX_CANON); - if (pty_max_bytes < 0) - pty_max_bytes = 250; -#else - pty_max_bytes = 250; -#endif - /* Deduct one, to leave space for the eof. */ - pty_max_bytes--; - } - /* If there is already data in the write_queue, put the new data in the back of queue. Otherwise, ignore it. */ if (!NILP (p->write_queue)) -- cgit v1.2.1 From cdc5d88cf68f232a71560937b557af8fa36d50c5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 16 Nov 2012 10:59:40 -0500 Subject: * lisp/emacs-lisp/cl-lib.el: Set more meaningful version number. --- lisp/ChangeLog | 4 ++++ lisp/emacs-lisp/cl-lib.el | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a267c726986..343ea621e9e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2012-11-16 Stefan Monnier + + * emacs-lisp/cl-lib.el: Set more meaningful version number. + 2012-11-16 Martin Rudalics * window.el (enlarge-window, shrink-window): Don't mention return diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index e9b30a8f62d..9515c6fd12f 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc. ;; Author: Dave Gillespie -;; Version: 2.02 +;; Version: 1.0 ;; Keywords: extensions ;; This file is part of GNU Emacs. -- cgit v1.2.1 From dd0c5bbb364c8a7f6c663c7bd93d048206b2e707 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 16 Nov 2012 13:02:39 -0500 Subject: * lisp/emacs-lisp/advice.el (ad-make-advised-definition): Improve last fix. --- lisp/ChangeLog | 2 ++ lisp/emacs-lisp/advice.el | 4 +++- test/automated/advice-tests.el | 7 +++++++ 3 files changed, 12 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7674881dd7b..41252ee85a9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,7 @@ 2012-11-16 Stefan Monnier + * emacs-lisp/advice.el (ad-make-advised-definition): Improve last fix. + * emacs-lisp/cl-lib.el: Set more meaningful version number. 2012-11-16 Martin Rudalics diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 60c1a846a79..c2ebb3bbdc6 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2596,7 +2596,9 @@ in any of these classes." (ad-has-redefining-advice function)) (let* ((origdef (ad-real-orig-definition function)) ;; Construct the individual pieces that we need for assembly: - (orig-arglist (and origdef (ad-arglist origdef))) + (orig-arglist (let ((args (ad-arglist origdef))) + ;; The arglist may still be unknown. + (if (listp args) args '(&rest args)))) (advised-arglist (or (ad-advised-arglist function) orig-arglist)) (interactive-form (ad-advised-interactive-form function)) diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el index 8f9bf54114c..80321f8f3f9 100644 --- a/test/automated/advice-tests.el +++ b/test/automated/advice-tests.el @@ -80,6 +80,13 @@ (sm-test5 6) 100.1) ((advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) (sm-test5 6) 20.1) + + ;; This used to signal an error (bug#12858). + ((autoload 'sm-test6 "foo") + (defadvice sm-test6 (around test activate) + ad-do-it) + t t) + )) (ert-deftest advice-tests () -- cgit v1.2.1 From 60c4ee668296b705cb359f3915c78fddd4bfcfdf Mon Sep 17 00:00:00 2001 From: Jürgen Hötzel Date: Fri, 16 Nov 2012 13:18:07 -0500 Subject: * lisp/eshell/em-unix.el (eshell/mkdir): Handle "--parents". Fixes: debbugs:12897 --- lisp/ChangeLog | 4 ++++ lisp/eshell/em-unix.el | 3 ++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 41252ee85a9..38aebf972c0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2012-11-16 Jürgen Hötzel (tiny change) + + * eshell/em-unix.el (eshell/mkdir): Handle "--parents" (bug#12897). + 2012-11-16 Stefan Monnier * emacs-lisp/advice.el (ad-make-advised-definition): Improve last fix. diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index d3ddab8af1b..32744c702a6 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -306,12 +306,13 @@ Remove (unlink) the FILE(s).") (eshell-eval-using-options "mkdir" args '((?h "help" nil nil "show this usage screen") + (?p "parents" nil em-parents "make parent directories as needed") :external "mkdir" :show-usage :usage "[OPTION] DIRECTORY... Create the DIRECTORY(ies), if they do not already exist.") (while args - (eshell-funcalln 'make-directory (car args)) + (eshell-funcalln 'make-directory (car args) em-parents) (setq args (cdr args))) nil)) -- cgit v1.2.1 From a33da68be0fd3dd306155955210ddca6b521f28d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 16 Nov 2012 20:54:42 +0200 Subject: Fix bug #12908 with documentation of emacs_backtrace.txt on MS-Windows. doc/emacs/trouble.texi (Crashing): Add information about MS-Windows and the emacs_backtrace.txt file. etc/NEWS: Mention emacs_backtrace.txt. --- doc/emacs/ChangeLog | 5 +++++ doc/emacs/trouble.texi | 35 +++++++++++++++++++++-------------- etc/NEWS | 4 +++- 3 files changed, 29 insertions(+), 15 deletions(-) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index fbdb6363b34..9fad60d2a8c 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,8 @@ +2012-11-16 Eli Zaretskii + + * trouble.texi (Crashing): Add information about MS-Windows and + the emacs_backtrace.txt file. (Bug#12908) + 2012-11-13 Chong Yidong * building.texi (Multithreaded Debugging): gdb-stopped-hooks is diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi index 1a891a62b33..705cd5a4bbe 100644 --- a/doc/emacs/trouble.texi +++ b/doc/emacs/trouble.texi @@ -282,18 +282,23 @@ itself, and the reserve supply may not be enough. @subsection When Emacs Crashes @cindex crash report +@cindex backtrace +@cindex @file{emacs_backtrace.txt} file, MS-Windows Emacs is not supposed to crash, but if it does, it produces a @dfn{crash report} prior to exiting. The crash report is printed to the standard error stream. If Emacs was started from a graphical -desktop, the standard error stream is commonly redirected to a file -such as @file{~/.xsession-errors}, so you can look for the crash -report there. +desktop on a GNU or Unix system, the standard error stream is commonly +redirected to a file such as @file{~/.xsession-errors}, so you can +look for the crash report there. On MS-Windows, the crash report is +written to a file named @file{emacs_backtrace.txt} in the current +directory of the Emacs process, in addition to the standard error +stream. The format of the crash report depends on the platform. On some platforms, such as those using the GNU C Library, the crash report includes a @dfn{backtrace} describing the execution state prior to crashing, which can be used to help debug the crash. Here is an -example: +example for a GNU system: @example Fatal error 11: Segmentation fault @@ -320,22 +325,24 @@ backtrace with source-code line numbers: @example sed -n 's/.*\[\(.*\)]$/\1/p' @var{backtrace} | - addr2line -Cfip -e @var{bindir}/emacs + addr2line -Cfip -e @var{bindir}/@var{emacs-binary} @end example @noindent Here, @var{backtrace} is the name of a text file containing a copy of -the backtrace, and @var{bindir} is the name of the directory that -contains the Emacs executable. +the backtrace, @var{bindir} is the name of the directory that +contains the Emacs executable, and @var{emacs-binary} is the name of +the Emacs executable file, normally @file{emacs} on GNU and Unix +systems and @file{emacs.exe} on MS-Windows and MS-DOS. @cindex core dump - Optionally, Emacs can generate a @dfn{core dump} when it crashes. A -core dump is a file containing voluminous data about the state of the -program prior to the crash, usually examined by loading it into a -debugger such as GDB. On many platforms, core dumps are disabled by -default, and you must explicitly enable them by running the shell -command @samp{ulimit -c unlimited} (e.g.@: in your shell startup -script). + Optionally, Emacs can generate a @dfn{core dump} when it crashes, on +systems that support core files. A core dump is a file containing +voluminous data about the state of the program prior to the crash, +usually examined by loading it into a debugger such as GDB. On many +platforms, core dumps are disabled by default, and you must explicitly +enable them by running the shell command @samp{ulimit -c unlimited} +(e.g.@: in your shell startup script). @node After a Crash @subsection Recovery After a Crash diff --git a/etc/NEWS b/etc/NEWS index d81cf7f1bb4..a03c2e2f638 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -210,7 +210,9 @@ This minor mode replaces `toggle-read-only', which is now obsolete. ** Emacs now generates backtraces on fatal errors. On encountering a fatal error, Emacs now outputs a textual description of the fatal signal, and a short backtrace on platforms like glibc -that support backtraces. +that support backtraces, and also on MS-Windows. On Windows, the +backtrace is also written to the 'emacs_backtrace.txt' file in the +directory where Emacs was running. --- ** If your Emacs was built from a bzr checkout, the new variable -- cgit v1.2.1 From ec15e0ff0be9c3ab23d6df93953fc351fb4eb40e Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 17 Nov 2012 14:16:46 +0800 Subject: * filecache.el (file-cache-add-file): Handle relative file name in the argument. Fixes: debbugs:12694 --- lisp/ChangeLog | 5 +++++ lisp/filecache.el | 33 ++++++++++++++++----------------- 2 files changed, 21 insertions(+), 17 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 38aebf972c0..0570703b11d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-17 Chong Yidong + + * filecache.el (file-cache-add-file): Handle relative file name in + the argument (Bug#12694). + 2012-11-16 Jürgen Hötzel (tiny change) * eshell/em-unix.el (eshell/mkdir): Handle "--parents" (bug#12897). diff --git a/lisp/filecache.el b/lisp/filecache.el index 2dd7c2673bf..23246c24c45 100644 --- a/lisp/filecache.el +++ b/lisp/filecache.el @@ -310,23 +310,22 @@ files in each directory, not to the directory list itself." (defun file-cache-add-file (file) "Add FILE to the file cache." (interactive "fAdd File: ") - (if (not (file-exists-p file)) - (message "Filecache: file %s does not exist" file) - (let* ((file-name (file-name-nondirectory file)) - (dir-name (file-name-directory file)) - (the-entry (assoc-string - file-name file-cache-alist - file-cache-ignore-case))) - ;; Does the entry exist already? - (if the-entry - (if (or (and (stringp (cdr the-entry)) - (string= dir-name (cdr the-entry))) - (and (listp (cdr the-entry)) - (member dir-name (cdr the-entry)))) - nil - (setcdr the-entry (cons dir-name (cdr the-entry)))) - ;; If not, add it to the cache - (push (list file-name dir-name) file-cache-alist))))) + (setq file (file-truename file)) + (unless (file-exists-p file) + (error "Filecache: file %s does not exist" file)) + (let* ((file-name (file-name-nondirectory file)) + (dir-name (file-name-directory file)) + (the-entry (assoc-string file-name file-cache-alist + file-cache-ignore-case))) + ;; Does the entry exist already? + (if the-entry + (unless (or (and (stringp (cdr the-entry)) + (string= dir-name (cdr the-entry))) + (and (listp (cdr the-entry)) + (member dir-name (cdr the-entry)))) + (setcdr the-entry (cons dir-name (cdr the-entry)))) + ;; If not, add it to the cache + (push (list file-name dir-name) file-cache-alist)))) ;;;###autoload (defun file-cache-add-directory-using-find (directory) -- cgit v1.2.1 From 8e7696a18bbfbd9cf2b158b7a633f274fbb2b706 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 17 Nov 2012 14:48:10 +0800 Subject: * help-mode.el (help-xref-interned): End on point-min. Fixes: debbugs:12737 --- lisp/ChangeLog | 2 ++ lisp/help-mode.el | 3 ++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0570703b11d..72192bc79e5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,7 @@ 2012-11-17 Chong Yidong + * help-mode.el (help-xref-interned): End on point-min (Bug#12737). + * filecache.el (file-cache-add-file): Handle relative file name in the argument (Bug#12694). diff --git a/lisp/help-mode.el b/lisp/help-mode.el index c1ce5a521be..48c5849d301 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -677,7 +677,8 @@ help buffer." " is also a " "face." "\n\n" facedoc)) ;; Don't record the `describe-function' item in the stack. (setq help-xref-stack-item nil) - (help-setup-xref (list #'help-xref-interned symbol) nil))))))) + (help-setup-xref (list #'help-xref-interned symbol) nil)))) + (goto-char (point-min))))) ;; Navigation/hyperlinking with xrefs -- cgit v1.2.1 From e45deaefe72ab01a93d5c804fa08075c2fdac778 Mon Sep 17 00:00:00 2001 From: Stephen Berman Date: Sat, 17 Nov 2012 15:00:35 +0800 Subject: Fix for gamegrid-add-score-with-update-game-score-1. * lisp/play/gamegrid.el (gamegrid-add-score-with-update-game-score-1): Don't signal an error with a score that is too low to add to the list of top scores. Fixes: debbugs:12779 --- lisp/ChangeLog | 6 ++++++ lisp/play/gamegrid.el | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 72192bc79e5..8ac744bb980 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2012-11-17 Stephen Berman + + * play/gamegrid.el (gamegrid-add-score-with-update-game-score-1): + Don't signal an error with a score that is too low to add to the + list of top scores. (Bug#12779) + 2012-11-17 Chong Yidong * help-mode.el (help-xref-interned): End on point-min (Bug#12737). diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index f3e277e338c..a3ea4af4651 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -560,7 +560,7 @@ FILE is created there." (goto-char (point-min)) (search-forward (concat (int-to-string score) " " (user-login-name) " " - marker-string)) + marker-string) nil t) (beginning-of-line))))) (defun gamegrid-add-score-insecure (file score &optional directory) -- cgit v1.2.1 From de959d4da90f7a74fdebe3aa1d8b5ba93bca02ba Mon Sep 17 00:00:00 2001 From: Andreas Politz Date: Sat, 17 Nov 2012 15:15:23 +0800 Subject: Fix prefix arg handling in ibuffer marking commands. * ibuffer.el (ibuffer-mark-forward, ibuffer-unmark-forward) (ibuffer-unmark-backward, ibuffer-mark-interactive): Support plain prefix and negative numeric prefix args. Fixes: debbugs:12795 --- lisp/ChangeLog | 6 ++++++ lisp/ibuffer.el | 25 ++++++++++++++++--------- 2 files changed, 22 insertions(+), 9 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8ac744bb980..8da19539c9a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2012-11-17 Andreas Politz + + * ibuffer.el (ibuffer-mark-forward, ibuffer-unmark-forward) + (ibuffer-unmark-backward, ibuffer-mark-interactive): Support plain + prefix and negative numeric prefix args (Bug#12795). + 2012-11-17 Stephen Berman * play/gamegrid.el (gamegrid-add-score-with-update-game-score-1): diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 72ca189e9d5..4e0ac1a4856 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1362,24 +1362,27 @@ group." (defun ibuffer-mark-forward (arg) "Mark the buffer on this line, and move forward ARG lines. If point is on a group name, this function operates on that group." - (interactive "P") - (ibuffer-mark-interactive arg ibuffer-marked-char 1)) + (interactive "p") + (ibuffer-mark-interactive arg ibuffer-marked-char)) (defun ibuffer-unmark-forward (arg) "Unmark the buffer on this line, and move forward ARG lines. If point is on a group name, this function operates on that group." - (interactive "P") - (ibuffer-mark-interactive arg ?\s 1)) + (interactive "p") + (ibuffer-mark-interactive arg ?\s)) (defun ibuffer-unmark-backward (arg) "Unmark the buffer on this line, and move backward ARG lines. If point is on a group name, this function operates on that group." - (interactive "P") - (ibuffer-mark-interactive arg ?\s -1)) + (interactive "p") + (ibuffer-unmark-forward (- arg))) -(defun ibuffer-mark-interactive (arg mark movement) +(defun ibuffer-mark-interactive (arg mark &optional movement) (ibuffer-assert-ibuffer-mode) (or arg (setq arg 1)) + ;; deprecated movement argument + (when (and movement (< movement 0)) + (setq arg (- arg))) (ibuffer-forward-line 0) (ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name) (progn @@ -1389,8 +1392,12 @@ If point is on a group name, this function operates on that group." (let ((inhibit-read-only t)) (while (> arg 0) (ibuffer-set-mark mark) - (ibuffer-forward-line movement t) - (setq arg (1- arg)))))) + (ibuffer-forward-line 1 t) + (setq arg (1- arg))) + (while (< arg 0) + (ibuffer-forward-line -1 t) + (ibuffer-set-mark mark) + (setq arg (1+ arg)))))) (defun ibuffer-set-mark (mark) (ibuffer-assert-ibuffer-mode) -- cgit v1.2.1 From cd48a2e800819bee7a3d9189cf2478e5a8c256a2 Mon Sep 17 00:00:00 2001 From: Dani Moncayo Date: Sat, 17 Nov 2012 10:55:07 +0200 Subject: Don't produce "barebin" zip file as part of MS-Windows distributions. nt/zipdist.bat (ZIP_CHECK): Remove unused label. When invoking 7z to check if it's installed, redirect standard output and standard error to the null device. (ZIP_DIST): Don't build the "barebin" distribution. --- nt/ChangeLog | 7 +++++++ nt/zipdist.bat | 11 +++-------- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/nt/ChangeLog b/nt/ChangeLog index d5df1e10857..aa690e5d75f 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,10 @@ +2012-11-17 Dani Moncayo + + * zipdist.bat (ZIP_CHECK): Remove unused label. When invoking 7z + to check if it's installed, redirect standard output and standard + error to the null device. + (ZIP_DIST): Don't build the "barebin" distribution. + 2012-11-15 Juanma Barranquero * config.nt: Sync with autogen/config.in. diff --git a/nt/zipdist.bat b/nt/zipdist.bat index 806415054fd..e196299b6d6 100644 --- a/nt/zipdist.bat +++ b/nt/zipdist.bat @@ -25,9 +25,8 @@ set EMACS_VER=%1 set TMP_DIST_DIR=emacs-%EMACS_VER% rem Check, if 7zip is installed and available on path -:ZIP_CHECK -7z -if %ERRORLEVEL% NEQ 0 goto :ZIP_ERROR +7z 1>NUL 2>NUL +if %ERRORLEVEL% NEQ 0 goto ZIP_ERROR goto ZIP_DIST :ZIP_ERROR @@ -35,14 +34,10 @@ echo. echo ERROR: Make sure 7zip is installed and available on the Windows Path! goto EXIT -rem Build distributions +rem Build and verify the binary distribution :ZIP_DIST -rem Build and verify full distribution 7z a -bd -tZIP -mx=9 -x!.bzrignore -x!.gitignore -xr!emacs.mdp -xr!*.pdb -xr!*.opt -xr!*~ -xr!CVS -xr!.arch-inventory emacs-%EMACS_VER%-bin-i386.zip %TMP_DIST_DIR% 7z t emacs-%EMACS_VER%-bin-i386.zip -rem Build and verify binary only distribution -7z a -bd -tZIP -mx=9 -x!.bzrignore -x!.gitignore -xr!emacs.mdp -xr!*.pdb -xr!*.opt -xr!*~ -xr!CVS -xr!.arch-inventory emacs-%EMACS_VER%-barebin-i386.zip %TMP_DIST_DIR%/README.W32 %TMP_DIST_DIR%/bin %TMP_DIST_DIR%/etc/DOC-X %TMP_DIST_DIR%/COPYING -7z t emacs-%EMACS_VER%-barebin-i386.zip goto EXIT :EXIT -- cgit v1.2.1 From a455a5cee5f84cd405f368b1016792cd3ad5db2a Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sat, 17 Nov 2012 06:17:40 -0500 Subject: Auto-commit of generated files. --- autogen/config.in | 3 --- autogen/configure | 2 +- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/autogen/config.in b/autogen/config.in index 5388b8dc046..4d848657799 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -375,9 +375,6 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `fork' function. */ #undef HAVE_FORK -/* Define to 1 if you have the `fpathconf' function. */ -#undef HAVE_FPATHCONF - /* Define to 1 if you have the `freeifaddrs' function. */ #undef HAVE_FREEIFADDRS diff --git a/autogen/configure b/autogen/configure index e44b44a0a00..ae898f6f1d1 100755 --- a/autogen/configure +++ b/autogen/configure @@ -13449,7 +13449,7 @@ esac for ac_func in gethostname \ closedir getrusage get_current_dir_name \ lrand48 \ -fpathconf select getpagesize setlocale \ +select getpagesize setlocale \ utimes getrlimit setrlimit getcwd shutdown getaddrinfo \ strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ -- cgit v1.2.1 From d76afb936dc9cf6a7be48162ebb3c7114e65412a Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sat, 17 Nov 2012 06:20:58 -0500 Subject: Auto-commit of loaddefs files. --- lisp/emacs-lisp/cl-loaddefs.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 765bdf71519..69882e36f22 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'. ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "887ee7c4b9eb5766c6483d27e84aac21") +;;;;;; "cl-macs" "cl-macs.el" "a7d9b56ea588b869813de8ed7ec1fbcd") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@ -416,7 +416,7 @@ This is compatible with Common Lisp, but note that `defun' and (put 'cl-return-from 'lisp-indent-function '1) (autoload 'cl-loop "cl-macs" "\ -The Common Lisp `cl-loop' macro. +The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, @@ -432,14 +432,14 @@ Valid clauses are: \(fn CLAUSE...)" nil t) (autoload 'cl-do "cl-macs" "\ -The Common Lisp `cl-do' loop. +The Common Lisp `do' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t) (put 'cl-do 'lisp-indent-function '2) (autoload 'cl-do* "cl-macs" "\ -The Common Lisp `cl-do*' loop. +The Common Lisp `do*' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t) @@ -501,7 +501,7 @@ a `let' form, except that the list of symbols can be computed at run-time. (put 'cl-progv 'lisp-indent-function '2) (autoload 'cl-flet "cl-macs" "\ -Make temporary function definitions. +Make local function definitions. Like `cl-labels' but the definitions are not recursive. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) @@ -509,7 +509,7 @@ Like `cl-labels' but the definitions are not recursive. (put 'cl-flet 'lisp-indent-function '1) (autoload 'cl-flet* "cl-macs" "\ -Make temporary function definitions. +Make local function definitions. Like `cl-flet' but the definitions can refer to previous ones. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) -- cgit v1.2.1 From a631d0e04747884855aa460cb903d1fd2ff106f4 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 17 Nov 2012 07:15:49 -0800 Subject: Fix problems in ns port found by static checking. * nsterm.m: Include , for pthread_mutex_lock etc. (hold_event, setPosition:portion:whole:): Send SIGIO only to self, not to process group. (ns_select): Use emacs_write, not write, as that's more robust in the presence of signals. (fd_handler:): Check for read errors. --- src/ChangeLog | 10 ++++++++++ src/nsterm.m | 22 ++++++++++------------ 2 files changed, 20 insertions(+), 12 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 695fbab5813..1194fe099fa 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2012-11-17 Paul Eggert + + Fix problems in ns port found by static checking. + * nsterm.m: Include , for pthread_mutex_lock etc. + (hold_event, setPosition:portion:whole:): Send SIGIO only to self, + not to process group. + (ns_select): Use emacs_write, not write, as that's more robust + in the presence of signals. + (fd_handler:): Check for read errors. + 2012-11-16 Glenn Morris * editfns.c (Fmessage): Mention message-log-max. (Bug#12849) diff --git a/src/nsterm.m b/src/nsterm.m index 7c66708e7cb..3640ac0c5e8 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -31,6 +31,7 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) #include #include +#include #include #include #include @@ -331,7 +332,7 @@ hold_event (struct input_event *event) hold_event_q.q[hold_event_q.nr++] = *event; /* Make sure ns_read_socket is called, i.e. we have input. */ - kill (0, SIGIO); + raise (SIGIO); } static Lisp_Object @@ -3389,7 +3390,7 @@ ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) if ([NSApp modalWindow] != nil) return -1; - if (hold_event_q.nr > 0) + if (hold_event_q.nr > 0) { int i; for (i = 0; i < hold_event_q.nr; ++i) @@ -3504,7 +3505,7 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, /* Inform fd_handler that select should be called */ c = 'g'; - write (selfds[1], &c, 1); + emacs_write (selfds[1], &c, 1); } else if (nr == 0 && timeout) { @@ -3537,7 +3538,7 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, if (nr > 0 && readfds) { c = 's'; - write (selfds[1], &c, 1); + emacs_write (selfds[1], &c, 1); } unblock_input (); @@ -4576,11 +4577,8 @@ not_in_argv (NSString *arg) FD_SET (selfds[0], &fds); result = select (selfds[0]+1, &fds, NULL, NULL, NULL); - if (result > 0) - { - read (selfds[0], &c, 1); - if (c == 'g') waiting = 0; - } + if (result > 0 && read (selfds[0], &c, 1) == 1 && c == 'g') + waiting = 0; } else { @@ -4620,8 +4618,8 @@ not_in_argv (NSString *arg) { if (FD_ISSET (selfds[0], &readfds)) { - read (selfds[0], &c, 1); - if (c == 's') waiting = 1; + if (read (selfds[0], &c, 1) == 1 && c == 's') + waiting = 1; } else { @@ -6696,7 +6694,7 @@ not_in_argv (NSString *arg) /* Events may come here even if the event loop is not running. If we don't enter the event loop, the scroll bar will not update. So send SIGIO to ourselves. */ - if (apploopnr == 0) kill (0, SIGIO); + if (apploopnr == 0) raise (SIGIO); return self; } -- cgit v1.2.1 From 22bae83fa8c432780fe20202a660aa8c84f3087a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 17 Nov 2012 18:46:45 +0200 Subject: Fix bug #12829 with aborts on MS-Windows when several child processes die. nt/inc/sys/wait.h: New file, with prototype of waitpid and definitions of macros it needs. nt/inc/ms-w32.h (wait): Don't define, 'wait' is not used anymore. (sys_wait): Remove prototype. nt/config.nt (HAVE_SYS_WAIT_H): Define to 1. src/w32proc.c (create_child): Don't clip the PID of the child process to fit into an Emacs integer, as this is no longer a restriction. (waitpid): Rename from sys_wait. Emulate a Posix 'waitpid' by reaping only the process specified by PID argument, if that is positive. Use PID instead of dead_child to know which process to reap. Wait for the child to die only if WNOHANG is not in OPTIONS. (sys_select): Don't set dead_child. src/sysdep.c (wait_for_termination_1): Remove the WINDOWSNT portion, as it is no longer needed. src/process.c (waitpid, WUNTRACED) [!WNOHANG]: Remove definitions, no longer needed. (record_child_status_change): Remove the setting of record_at_most_one_child for the !WNOHANG case. --- nt/ChangeLog | 10 +++++ nt/config.nt | 2 +- nt/inc/ms-w32.h | 3 -- nt/inc/sys/wait.h | 33 ++++++++++++++ src/ChangeLog | 20 +++++++++ src/process.c | 20 --------- src/sysdep.c | 7 +-- src/w32proc.c | 127 ++++++++++++++++++++++++++++++++++++++---------------- 8 files changed, 156 insertions(+), 66 deletions(-) create mode 100644 nt/inc/sys/wait.h diff --git a/nt/ChangeLog b/nt/ChangeLog index aa690e5d75f..b24acae8be5 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,13 @@ +2012-11-17 Eli Zaretskii + + * inc/sys/wait.h: New file, with prototype of waitpid and + definitions of macros it needs. + + * inc/ms-w32.h (wait): Don't define, 'wait' is not used anymore. + (sys_wait): Remove prototype. + + * config.nt (HAVE_SYS_WAIT_H): Define to 1. + 2012-11-17 Dani Moncayo * zipdist.bat (ZIP_CHECK): Remove unused label. When invoking 7z diff --git a/nt/config.nt b/nt/config.nt index 69549fb2087..638f0a7461b 100644 --- a/nt/config.nt +++ b/nt/config.nt @@ -986,7 +986,7 @@ along with GNU Emacs. If not, see . */ #undef HAVE_SYS_VLIMIT_H /* Define to 1 if you have that is POSIX.1 compatible. */ -#undef HAVE_SYS_WAIT_H +#define HAVE_SYS_WAIT_H 1 /* Define to 1 if you have the header file. */ #undef HAVE_TERM_H diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 1b2a309e1be..7b16ccab069 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -183,15 +183,12 @@ extern char *getenv (); /* Subprocess calls that are emulated. */ #define spawnve sys_spawnve -#define wait sys_wait #define kill sys_kill #define signal sys_signal /* Internal signals. */ #define emacs_raise(sig) emacs_abort() -extern int sys_wait (int *); - /* termcap.c calls that are emulated. */ #define tputs sys_tputs #define tgetstr sys_tgetstr diff --git a/nt/inc/sys/wait.h b/nt/inc/sys/wait.h new file mode 100644 index 00000000000..8d890c9e175 --- /dev/null +++ b/nt/inc/sys/wait.h @@ -0,0 +1,33 @@ +/* A limited emulation of sys/wait.h on Posix systems. + +Copyright (C) 2012 Free Software Foundation, Inc. + +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 . */ + +#ifndef INC_SYS_WAIT_H_ +#define INC_SYS_WAIT_H_ + +#define WNOHANG 1 +#define WUNTRACED 2 +#define WSTOPPED 2 /* same as WUNTRACED */ +#define WEXITED 4 +#define WCONTINUED 8 + +/* The various WIF* macros are defined in src/syswait.h. */ + +extern pid_t waitpid (pid_t, int *, int); + +#endif /* INC_SYS_WAIT_H_ */ diff --git a/src/ChangeLog b/src/ChangeLog index 1194fe099fa..45d48ba41cc 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,23 @@ +2012-11-17 Eli Zaretskii + + * w32proc.c (create_child): Don't clip the PID of the child + process to fit into an Emacs integer, as this is no longer a + restriction. + (waitpid): Rename from sys_wait. Emulate a Posix 'waitpid' by + reaping only the process specified by PID argument, if that is + positive. Use PID instead of dead_child to know which process to + reap. Wait for the child to die only if WNOHANG is not in + OPTIONS. + (sys_select): Don't set dead_child. + + * sysdep.c (wait_for_termination_1): Remove the WINDOWSNT portion, + as it is no longer needed. + + * process.c (waitpid, WUNTRACED) [!WNOHANG]: Remove definitions, + no longer needed. + (record_child_status_change): Remove the setting of + record_at_most_one_child for the !WNOHANG case. + 2012-11-17 Paul Eggert Fix problems in ns port found by static checking. diff --git a/src/process.c b/src/process.c index 785282fba36..5fe6a6540f3 100644 --- a/src/process.c +++ b/src/process.c @@ -130,18 +130,6 @@ extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *, EMACS_TIME *, void *); #endif -/* This is for DOS_NT ports. FIXME: Remove this old portability cruft - by having DOS_NT ports implement waitpid instead of wait. Nowadays - POSIXish hosts all define waitpid, WNOHANG, and WUNTRACED, as these - have been standard since POSIX.1-1988. */ -#ifndef WNOHANG -# undef waitpid -# define waitpid(pid, status, options) wait (status) -#endif -#ifndef WUNTRACED -# define WUNTRACED 0 -#endif - /* Work around GCC 4.7.0 bug with strict overflow checking; see . These lines can be removed once the GCC bug is fixed. */ @@ -6295,17 +6283,9 @@ record_child_status_change (pid_t pid, int w) { #ifdef SIGCHLD -# ifdef WNOHANG /* On POSIXish hosts, record at most one child only if we already know one child that has exited. */ bool record_at_most_one_child = 0 <= pid; -# else - /* On DOS_NT (the only porting target that lacks WNOHANG), - record the status of at most one child process, since the SIGCHLD - handler must return right away. If any more processes want to - signal us, we will get another signal. */ - bool record_at_most_one_child = 1; -# endif Lisp_Object tail; diff --git a/src/sysdep.c b/src/sysdep.c index a7f3de2f1b1..06dc41b511e 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -289,10 +289,6 @@ wait_for_termination_1 (pid_t pid, int interruptible) { while (1) { -#ifdef WINDOWSNT - wait (0); - break; -#else /* not WINDOWSNT */ int status; int wait_result = waitpid (pid, &status, 0); if (wait_result < 0) @@ -306,7 +302,8 @@ wait_for_termination_1 (pid_t pid, int interruptible) break; } -#endif /* not WINDOWSNT */ + /* Note: the MS-Windows emulation of waitpid calls QUIT + internally. */ if (interruptible) QUIT; } diff --git a/src/w32proc.c b/src/w32proc.c index 10dd23003b8..fd6a498290a 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -789,7 +789,6 @@ alarm (int seconds) /* Child process management list. */ int child_proc_count = 0; child_process child_procs[ MAX_CHILDREN ]; -child_process *dead_child = NULL; static DWORD WINAPI reader_thread (void *arg); @@ -1042,9 +1041,6 @@ create_child (char *exe, char *cmdline, char *env, int is_gui_app, if (cp->pid < 0) cp->pid = -cp->pid; - /* pid must fit in a Lisp_Int */ - cp->pid = cp->pid & INTMASK; - *pPid = cp->pid; return TRUE; @@ -1120,55 +1116,110 @@ reap_subprocess (child_process *cp) delete_child (cp); } -/* Wait for any of our existing child processes to die - When it does, close its handle - Return the pid and fill in the status if non-NULL. */ +/* Wait for a child process specified by PID, or for any of our + existing child processes (if PID is nonpositive) to die. When it + does, close its handle. Return the pid of the process that died + and fill in STATUS if non-NULL. */ -int -sys_wait (int *status) +pid_t +waitpid (pid_t pid, int *status, int options) { DWORD active, retval; int nh; - int pid; child_process *cp, *cps[MAX_CHILDREN]; HANDLE wait_hnd[MAX_CHILDREN]; + DWORD timeout_ms; + int dont_wait = (options & WNOHANG) != 0; nh = 0; - if (dead_child != NULL) + /* According to Posix: + + PID = -1 means status is requested for any child process. + + PID > 0 means status is requested for a single child process + whose pid is PID. + + PID = 0 means status is requested for any child process whose + process group ID is equal to that of the calling process. But + since Windows has only a limited support for process groups (only + for console processes and only for the purposes of passing + Ctrl-BREAK signal to them), and since we have no documented way + of determining whether a given process belongs to our group, we + treat 0 as -1. + + PID < -1 means status is requested for any child process whose + process group ID is equal to the absolute value of PID. Again, + since we don't support process groups, we treat that as -1. */ + if (pid > 0) { - /* We want to wait for a specific child */ - wait_hnd[nh] = dead_child->procinfo.hProcess; - cps[nh] = dead_child; - if (!wait_hnd[nh]) emacs_abort (); - nh++; - active = 0; - goto get_result; + int our_child = 0; + + /* We are requested to wait for a specific child. */ + for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--) + { + /* Some child_procs might be sockets; ignore them. Also + ignore subprocesses whose output is not yet completely + read. */ + if (CHILD_ACTIVE (cp) + && cp->procinfo.hProcess + && cp->pid == pid) + { + our_child = 1; + break; + } + } + if (our_child) + { + if (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0) + { + wait_hnd[nh] = cp->procinfo.hProcess; + cps[nh] = cp; + nh++; + } + else if (dont_wait) + { + /* PID specifies our subprocess, but its status is not + yet available. */ + return 0; + } + } + if (nh == 0) + { + /* No such child process, or nothing to wait for, so fail. */ + errno = ECHILD; + return -1; + } } else { for (cp = child_procs + (child_proc_count-1); cp >= child_procs; cp--) - /* some child_procs might be sockets; ignore them */ - if (CHILD_ACTIVE (cp) && cp->procinfo.hProcess - && (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)) - { - wait_hnd[nh] = cp->procinfo.hProcess; - cps[nh] = cp; - nh++; - } + { + if (CHILD_ACTIVE (cp) + && cp->procinfo.hProcess + && (cp->fd < 0 || (fd_info[cp->fd].flags & FILE_AT_EOF) != 0)) + { + wait_hnd[nh] = cp->procinfo.hProcess; + cps[nh] = cp; + nh++; + } + } + if (nh == 0) + { + /* Nothing to wait on, so fail. */ + errno = ECHILD; + return -1; + } } - if (nh == 0) - { - /* Nothing to wait on, so fail */ - errno = ECHILD; - return -1; - } + if (dont_wait) + timeout_ms = 0; + else + timeout_ms = 1000; /* check for quit about once a second. */ do { - /* Check for quit about once a second. */ QUIT; - active = WaitForMultipleObjects (nh, wait_hnd, FALSE, 1000); + active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms); } while (active == WAIT_TIMEOUT); if (active == WAIT_FAILED) @@ -1198,8 +1249,10 @@ get_result: } if (retval == STILL_ACTIVE) { - /* Should never happen */ + /* Should never happen. */ DebPrint (("Wait.WaitForMultipleObjects returned an active process\n")); + if (pid > 0 && dont_wait) + return 0; errno = EINVAL; return -1; } @@ -1213,6 +1266,8 @@ get_result: else retval <<= 8; + if (pid > 0 && active != 0) + emacs_abort (); cp = cps[active]; pid = cp->pid; #ifdef FULL_DEBUG @@ -2001,9 +2056,7 @@ count_children: DebPrint (("select calling SIGCHLD handler for pid %d\n", cp->pid)); #endif - dead_child = cp; sig_handlers[SIGCHLD] (SIGCHLD); - dead_child = NULL; } } else if (fdindex[active] == -1) -- cgit v1.2.1 From 6ad30855c02908fdd99d9b11943719e185e65ee3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 17 Nov 2012 18:52:48 +0200 Subject: Fix MS-Windows emulation of 'faccessat' wrt directories. src/w32.c (faccessat): Pretend that directories have the execute bit set. Emacs expects that, e.g., in files.el:cd-absolute. --- src/ChangeLog | 3 +++ src/w32.c | 3 ++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index 45d48ba41cc..df8bf602afe 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,8 @@ 2012-11-17 Eli Zaretskii + * w32.c (faccessat): Pretend that directories have the execute bit + set. Emacs expects that, e.g., in files.el:cd-absolute. + * w32proc.c (create_child): Don't clip the PID of the child process to fit into an Emacs integer, as this is no longer a restriction. diff --git a/src/w32.c b/src/w32.c index eb07e13a2fb..46433626802 100644 --- a/src/w32.c +++ b/src/w32.c @@ -2762,7 +2762,8 @@ faccessat (int dirfd, const char * path, int mode, int flags) } return -1; } - if ((mode & X_OK) != 0 && !is_exec (path)) + if ((mode & X_OK) != 0 + && !(is_exec (path) || (attributes & FILE_ATTRIBUTE_DIRECTORY) != 0)) { errno = EACCES; return -1; -- cgit v1.2.1