commit 1da9a207669a3cf5d27ac1dd61543c1492e05360 (HEAD, refs/remotes/origin/master) Author: Tino Calancha Date: Fri Mar 31 17:27:08 2017 +0900 dired-mark-suffix: New command Now dired-mark-extension prepends '.' to extension when not present. Add command dired-mark-suffix to preserve the previous behaviour (Bug#25942). * lisp/dired-x.el (dired-mark-suffix): New command; mark files ending in a given suffix. (dired--mark-suffix-interactive-spec): New defun. (dired-mark-extension, dired-mark-suffix): Use it. * doc/misc/dired-x.texi (Advanced Mark Commands): Update manual. * test/lisp/dired-x-tests.el: New test suite; add test for these features. ; * etc/NEWS (Incompatible Lisp Changes in Emacs 26.1): ; Mention these changes. diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 1e6f4b03bb..bf103256f2 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -721,15 +721,27 @@ variable @code{window-min-height}. @item dired-mark-extension @findex dired-mark-extension Mark all files with a certain extension for use in later commands. A @samp{.} -is not automatically prepended to the string entered, you must type it -explicitly. -If invoked with prefix argument @kbd{C-u}, this command unmark files instead. +is automatically prepended to the string entered when not present. +If invoked with prefix argument @kbd{C-u}, this command unmarks files instead. If called with the @kbd{C-u C-u} prefix, asks for a character to use as the marker, and marks files with it. When called from Lisp, @var{extension} may also be a list of extensions and an optional argument @var{marker-char} specifies the marker used. +@item dired-mark-suffix +@findex dired-mark-suffix +Mark all files with a certain suffix for use in later commands. A @samp{.} +is not automatically prepended to the string entered, you must type it +explicitly. This is different from @var{dired-mark-extension} which prepends +a @samp{.} if not present. +If invoked with prefix argument @kbd{C-u}, this command unmarks files instead. +If called with the @kbd{C-u C-u} prefix, asks for a character to use +as the marker, and marks files with it. + +When called from Lisp, @var{suffix} may also be a list of suffixes +and an optional argument @var{marker-char} specifies the marker used. + @item dired-flag-extension @findex dired-flag-extension Flag all files with a certain extension for deletion. A @samp{.} is diff --git a/etc/NEWS b/etc/NEWS index cd98f53399..bfd7d2bd32 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -471,8 +471,6 @@ where to place point after C-c M-r and C-c M-s. --- *** Messages from CMake are now recognized. -** Dired - +++ *** A new option 'dired-always-read-filesystem' default to nil. If non-nil, buffers visiting files are reverted before search them; @@ -759,6 +757,11 @@ processes on exit. * Incompatible Lisp Changes in Emacs 26.1 +++ +*** Command 'dired-mark-extension' now automatically prepends a '.' to the +extension when not present. The new command 'dired-mark-suffix' behaves +similarly but it doesn't prepend a '.'. + ++++ ** Certain cond/pcase/cl-case forms are now compiled using a faster jump table implementation. This uses a new bytecode op `switch', which isn't compatible with previous Emacs versions. This functionality can be disabled diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 6c8fb0e7da..527685acf3 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -332,46 +332,73 @@ See also the functions: ;;; EXTENSION MARKING FUNCTIONS. +(defun dired--mark-suffix-interactive-spec () + (let* ((default + (let ((file (dired-get-filename nil t))) + (when file + (file-name-extension file)))) + (suffix + (read-string (format "%s extension%s: " + (if (equal current-prefix-arg '(4)) + "UNmarking" + "Marking") + (if default + (format " (default %s)" default) + "")) nil nil default)) + (marker + (pcase current-prefix-arg + ('(4) ?\s) + ('(16) + (let* ((dflt (char-to-string dired-marker-char)) + (input (read-string + (format + "Marker character to use (default %s): " dflt) + nil nil dflt))) + (aref input 0))) + (_ dired-marker-char)))) + (list suffix marker))) + ;; Mark files with some extension. (defun dired-mark-extension (extension &optional marker-char) "Mark all files with a certain EXTENSION for use in later commands. -A `.' is *not* automatically prepended to the string entered. +A `.' is automatically prepended to EXTENSION when not present. EXTENSION may also be a list of extensions instead of a single one. Optional MARKER-CHAR is marker to use. Interactively, ask for EXTENSION. Prefixed with one C-u, unmark files instead. Prefixed with two C-u's, prompt for MARKER-CHAR and mark files with it." - (interactive - (let* ((default - (let ((file (dired-get-filename nil t))) - (when file - (file-name-extension file)))) - (suffix - (read-string (format "%s extension%s: " - (if (equal current-prefix-arg '(4)) - "UNmarking" - "Marking") - (if default - (format " (default %s)" default) - "")) nil nil default)) - (marker - (pcase current-prefix-arg - ('(4) ?\s) - ('(16) - (let* ((dflt (char-to-string dired-marker-char)) - (input (read-string - (format - "Marker character to use (default %s): " dflt) - nil nil dflt))) - (aref input 0))) - (_ dired-marker-char)))) - (list suffix marker))) - (or (listp extension) - (setq extension (list extension))) + (interactive (dired--mark-suffix-interactive-spec)) + (unless (listp extension) + (setq extension (list extension))) + (dired-mark-files-regexp + (concat ".";; don't match names with nothing but an extension + "\\(" + (mapconcat + (lambda (x) + (regexp-quote + (if (string-prefix-p "." x) x (concat "." x)))) + extension "\\|") + "\\)$") + marker-char)) + +;; Mark files ending with some suffix. +(defun dired-mark-suffix (suffix &optional marker-char) + "Mark all files with a certain SUFFIX for use in later commands. +A `.' is *not* automatically prepended to the string entered; see +also `dired-mark-extension', which is similar but automatically +prepends `.' when not present. +SUFFIX may also be a list of suffixes instead of a single one. +Optional MARKER-CHAR is marker to use. +Interactively, ask for SUFFIX. +Prefixed with one C-u, unmark files instead. +Prefixed with two C-u's, prompt for MARKER-CHAR and mark files with it." + (interactive (dired--mark-suffix-interactive-spec)) + (unless (listp suffix) + (setq suffix (list suffix))) (dired-mark-files-regexp (concat ".";; don't match names with nothing but an extension "\\(" - (mapconcat 'regexp-quote extension "\\|") + (mapconcat 'regexp-quote suffix "\\|") "\\)$") marker-char)) diff --git a/test/lisp/dired-x-tests.el b/test/lisp/dired-x-tests.el new file mode 100644 index 0000000000..e8352a4eca --- /dev/null +++ b/test/lisp/dired-x-tests.el @@ -0,0 +1,53 @@ +;;; dired-x-tests.el --- Test suite for dired-x. -*- lexical-binding: t -*- + +;; Copyright (C) 2017 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 . + +;;; Code: +(require 'ert) +(require 'dired-x) + + +(ert-deftest dired-test-bug25942 () + "Test for http://debbugs.gnu.org/25942 ." + (let* ((dirs (list "Public" "Music")) + (files (list ".bashrc" "bar.c" "foo.c" "c" ".c")) + (all-but-c + (sort + (append (copy-sequence dirs) + (delete "c" (copy-sequence files))) + #'string<)) + (dir (make-temp-file "Bug25942" 'dir)) + (extension "c")) + (unwind-protect + (progn + (dolist (d dirs) + (make-directory (expand-file-name d dir))) + (dolist (f files) + (write-region nil nil (expand-file-name f dir))) + (dired dir) + (dired-mark-extension extension) + (should (equal '("bar.c" "foo.c") + (sort (dired-get-marked-files 'local) #'string<))) + (dired-unmark-all-marks) + (dired-mark-suffix extension) + (should (equal all-but-c + (sort (dired-get-marked-files 'local) #'string<)))) + (delete-directory dir 'recursive)))) + +(provide 'dired-x-tests) +;; dired-x-tests.el ends here commit 3a11b3e330e88a42386ac3a635330ebd9c610827 Author: Paul Eggert Date: Thu Mar 30 19:26:58 2017 -0700 Use find -delete if available This shortens the ‘make’ output and should avoid some repetitive scanning of directories during a build. * configure.ac (FIND_DELETE): New var. * lisp/Makefile.in (compile-always, bootstrap-clean): * test/Makefile.in (clean, bootstrap-clean): Use it. * test/Makefile.in (ELCFILES, LOGSAVEFILES): Remove; no longer needed. diff --git a/configure.ac b/configure.ac index 9937a6cce9..bd8f7650cc 100644 --- a/configure.ac +++ b/configure.ac @@ -1178,6 +1178,16 @@ AC_PATH_PROG(GZIP_PROG, gzip) test $with_compress_install != yes && test -n "$GZIP_PROG" && \ GZIP_PROG=" # $GZIP_PROG # (disabled by configure --without-compress-install)" +AC_CACHE_CHECK([for 'find' args to delete a file], + [emacs_cv_find_delete], + [if touch conftest.tmp && find conftest.tmp -delete 2>/dev/null && + test ! -f conftest.tmp + then emacs_cv_find_delete="-delete" + else emacs_cv_find_delete="-exec rm -f {} ';'" + fi]) +FIND_DELETE=$emacs_cv_find_delete +AC_SUBST([FIND_DELETE]) + PAXCTL_dumped= PAXCTL_notdumped= if test $opsys = gnu-linux; then diff --git a/lisp/Makefile.in b/lisp/Makefile.in index cbe7718981..185554ca63 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -47,6 +47,9 @@ am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) am__v_at_0 = @ am__v_at_1 = + +FIND_DELETE = @FIND_DELETE@ + # You can specify a different executable on the make command line, # e.g. "make EMACS=../src/emacs ...". @@ -343,7 +346,7 @@ compile: $(LOADDEFS) autoloads compile-first # unconditionally. Some files don't actually get compiled because they # set the local variable no-byte-compile. compile-always: - cd $(lisp) && rm -f *.elc */*.elc */*/*.elc */*/*/*.elc + find $(lisp) -name '*.elc' $(FIND_DELETE) $(MAKE) compile .PHONY: backup-compiled-files compile-after-backup @@ -433,7 +436,8 @@ $(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/diary-loaddefs.el .PHONY: bootstrap-clean distclean maintainer-clean bootstrap-clean: - -cd $(lisp) && rm -f *.elc */*.elc */*/*.elc */*/*/*.elc $(AUTOGENEL) + find $(lisp) -name '*.elc' $(FIND_DELETE) + -cd $(lisp) && rm -f $(AUTOGENEL) distclean: -rm -f ./Makefile $(lisp)/loaddefs.el~ diff --git a/test/Makefile.in b/test/Makefile.in index 5849e9c3ac..c0056b6f44 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -33,6 +33,7 @@ SHELL = @SHELL@ srcdir = @srcdir@ VPATH = $(srcdir) +FIND_DELETE = @FIND_DELETE@ MKDIR_P = @MKDIR_P@ SEPCHAR = @SEPCHAR@ @@ -125,11 +126,9 @@ endif ELFILES = $(shell find ${srcdir} -path "${srcdir}/manual" -prune -o \ -path "*resources" -prune -o -name "*el" -print) -## .elc files may be in a different directory for out of source builds -ELCFILES = $(patsubst %.el,%.elc, \ +## .log files may be in a different directory for out of source builds +LOGFILES = $(patsubst %.el,%.log, \ $(patsubst $(srcdir)%,.%,$(ELFILES))) -LOGFILES = $(patsubst %.elc,%.log,${ELCFILES}) -LOGSAVEFILES = $(patsubst %.elc,%.log~,${ELCFILES}) TESTS = $(subst ${srcdir}/,,$(LOGFILES:.log=)) ## If we have to interrupt a hanging test, preserve the log so we can @@ -193,11 +192,11 @@ mostlyclean: rm -f *.tmp clean: - -rm -f ${LOGFILES} ${LOGSAVEFILES} - -rm make-test-deps.mk + find . '(' -name '*.log' -o -name '*.log~' ')' $(FIND_DELETE) + rm -f make-test-deps.mk bootstrap-clean: clean - -rm -f ${ELCFILES} + find $(srcdir) -name '*.elc' $(FIND_DELETE) distclean: clean rm -f Makefile commit e22d740c30ff5b3f7749c542b7dc0c454eb69f98 Author: Mark Oteiza Date: Thu Mar 30 22:22:47 2017 -0400 Remove gnus-boundp * lisp/gnus/gnus-start.el (gnus-display-time-event-handler): Use bound-and-true-p. * lisp/gnus/gnus-util (gnus-boundp): Remove. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index be46339cd3..90f3cb48c2 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -3196,7 +3196,7 @@ If this variable is nil, don't do anything." (defun gnus-display-time-event-handler () (if (and (fboundp 'display-time-event-handler) - (gnus-boundp 'display-time-timer)) + (bound-and-true-p display-time-timer)) (display-time-event-handler))) (defun gnus-check-reasonable-setup () diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 20eceb58ed..b509d8ad44 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -84,11 +84,6 @@ This is a compatibility function for different Emacsen." (declare (obsolete replace-regexp-in-string "26.1")) (replace-regexp-in-string regexp newtext string nil literal)) -(defun gnus-boundp (variable) - "Return non-nil if VARIABLE is bound and non-nil." - (and (boundp variable) - (symbol-value variable))) - (defmacro gnus-eval-in-buffer-window (buffer &rest forms) "Pop to BUFFER, evaluate FORMS, and then return to the original window." (let ((tempvar (make-symbol "GnusStartBufferWindow")) commit d1e113ee60a0750acbbc0da569f7cc1bab88f11c Author: Niels Möller Date: Tue Oct 21 11:59:11 2014 +0200 Stop `fixup-whitespace' adding trailing whitespace (Bug#18783) * lisp/simple.el (fixup-whitespace): Insert no spaces if point is at end of line after deleting horizontal whitespace. Copyright-paperwork-exempt: yes diff --git a/lisp/simple.el b/lisp/simple.el index 369fbf7192..48c1a9b15d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -833,7 +833,7 @@ Leave one space or none, according to the context." (interactive "*") (save-excursion (delete-horizontal-space) - (if (or (looking-at "^\\|\\s)") + (if (or (looking-at "^\\|$\\|\\s)") (save-excursion (forward-char -1) (looking-at "$\\|\\s(\\|\\s'"))) nil commit 7a8ae233d1bdf538a99233e52f0d7dd0975df2d1 Author: Paul Eggert Date: Thu Mar 30 17:47:58 2017 -0700 * src/inotify.c (add_watch): Add comment. diff --git a/src/inotify.c b/src/inotify.c index a0a89aa0f4..290701349e 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -227,6 +227,9 @@ add_watch (int wd, Lisp_Object filename, emacs_abort (); } + /* Insert the newly-assigned ID into the previously-discovered gap, + which is possibly at the end of the list. Inserting it there + keeps the list sorted. */ watch_id = make_number (id); watch = list4 (watch_id, filename, callback, mask); XSETCDR (tail, Fcons (watch, XCDR (tail))); commit 43203708d41e54b860f9bd987f1af3c4ca38a46a Author: Andreas Politz Date: Thu Mar 30 17:44:37 2017 -0700 Minor filenotify.el fixes * lisp/filenotify.el: Require subr-x. (file-notify-callback): Use equal, not eq. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index c3d7d7223a..dbf19cf2f2 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -28,6 +28,7 @@ ;;; Code: (require 'cl-lib) +(require 'subr-x) (defconst file-notify--library (cond @@ -155,9 +156,9 @@ EVENT is the cadr of the event in `file-notify-handle-event' ;; Send pending event, if it doesn't match. (when (and file-notify--pending-event ;; The cookie doesn't match. - (not (eq (file-notify--event-cookie - (car file-notify--pending-event)) - (file-notify--event-cookie event))) + (not (equal (file-notify--event-cookie + (car file-notify--pending-event)) + (file-notify--event-cookie event))) (or ;; inotify. (and (eq (nth 1 (car file-notify--pending-event)) commit eeaa707eb6c437b4a23d353eca5de1dc21bf7b24 Author: John Mastro Date: Thu Mar 30 16:01:41 2017 -0700 Fix a small incompatibility in ibuffer Translate nil values from column functions to the empty string, so that subsequent calls to string-width don't signal an error (Bug#26317). * lisp/ibuffer.el (ibuffer-compile-format): If a column function returns nil, treat it like the empty string. diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 66916b2bca..c83c21315a 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1689,7 +1689,7 @@ If point is on a group name, this function operates on that group." ;; generate a call to the column function. (ibuffer-aif (assq sym ibuffer-inline-columns) (nth 1 it) - `(,sym buffer mark))) + `(or (,sym buffer mark) ""))) ;; You're not expected to understand this. Hell, I ;; don't even understand it, and I wrote it five ;; minutes ago. commit ef7df187eb0b631a6909bdc02f82b3dfef0ad689 Author: Alan Mackenzie Date: Thu Mar 30 20:24:39 2017 +0000 Fix C++ fontification problems 500 bytes after typing a space, and other bugs Also implement the "asymmetric space" rule for fontifying otherwise ambiguous declarations/expressions. * lisp/progmodes/cc-engine.el (c-before-change-check-<>-operators): Don't set c-new-BEG or c-new-END when there is no need. (c-forward-decl-or-cast-1): Add "CASE 17.5" to implement the "asymmetric space" rule. * lisp/progmodes/cc-fonts.el (c-get-fontification-context): New function, extracted from c-font-lock-declarations. Add to this function processing to make `context' 'decl for lines contained within parens when these are also declarations. (c-font-lock-declarations): Call the newly extracted function above in place of inline code. * lisp/progmodes/cc-mode.el (c-fl-decl-start): Set point before calling c-literal-start. * lisp/progmodes/cc-vars.el (c-asymmetry-fontification-flag): New user option. * doc/misc/cc-mode.texi (Misc Font Locking): New node documenting the new "asymmetric fontification" rule, including the variable c-asymmetric-fontification-flag. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index a29873b03b..91e20fa724 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -274,6 +274,7 @@ Font Locking * Font Locking Preliminaries:: * Faces:: * Doc Comments:: +* Misc Font Locking:: * AWK Mode Font Locking:: Configuration Basics @@ -1821,6 +1822,7 @@ sections apply to the other languages. * Font Locking Preliminaries:: * Faces:: * Doc Comments:: +* Misc Font Locking:: * AWK Mode Font Locking:: @end menu @@ -2023,7 +2025,7 @@ since those aren't syntactic errors in themselves. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@node Doc Comments, AWK Mode Font Locking, Faces, Font Locking +@node Doc Comments, Misc Font Locking, Faces, Font Locking @comment node-name, next, previous, up @section Documentation Comments @cindex documentation comments @@ -2099,9 +2101,63 @@ initialization and the result is prepended. For an example, see If you add support for another doc comment style, please consider contributing it: send a note to @email{bug-cc-mode@@gnu.org}. +@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +@node Misc Font Locking, AWK Mode Font Locking, Doc Comments, Font Locking +@comment node-name, next, previous, up +@section Miscellaneous Font Locking +@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +In some languages, particularly in C++, there are constructs which are +syntactically ambiguous---they could be either declarations or +expressions, and @ccmode{} cannot tell for sure which. Often such a +construct is one of the operators @samp{*} or @samp{&} surrounded by +two identifiers. + +Experience shows that very often when such a construct is a +declaration it will be written with the operator touching exactly one +of the identifiers, like: + +@example +foo *bar +@end example +or +@example +foo& bar +@end example + +. Whether such code is fontified depends on the setting of +@code{c-asymmetry-fontification-flag}. + +@defvar c-asymmetry-fontification-flag +@vindex asymmetry-fontification-flag (c-) +When @code{c-asymmetry-fontification-flag} is non-nil (which it is by +default), code like the above, with white space either before or after +the operator, but not both, is fontified as a declaration. When the +variable is nil, such a construct gets the default face. +@end defvar + +When the construct is an expression there will often be white space +both before and after the operator or there will be no white space +around it at all, like: + +@example +foo * bar +@end example +or +@example +foo&bar +@end example +. + +Such code is not fontified as a declaration. (Typically, the +identifiers don't get a non-default face.) + +For clarity's sake, we emphasize that the ``asymmetry'' rule in this +section only applies when CC Mode cannot disambiguate a construct in +any other way. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@node AWK Mode Font Locking, , Doc Comments, Font Locking +@node AWK Mode Font Locking, , Misc Font Locking, Font Locking @comment node-name, next, previous, up @section AWK Mode Font Locking @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index bdc77dc502..de15d1d82f 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6243,9 +6243,9 @@ comment at the start of cc-engine.el for more info." (eq (char-before) ?<)) (c-backward-token-2) (when (eq (char-after) ?<) - (c-clear-<-pair-props-if-match-after beg))) + (c-clear-<-pair-props-if-match-after beg) + (setq new-beg (point)))) (c-forward-syntactic-ws) - (setq new-beg (point)) ;; ...Then the ones with < before end and > after end. (goto-char (if end-lit-limits (cdr end-lit-limits) end)) @@ -6254,9 +6254,9 @@ comment at the start of cc-engine.el for more info." (eq (char-before) ?>)) (c-end-of-current-token) (when (eq (char-before) ?>) - (c-clear->-pair-props-if-match-before end (1- (point))))) + (c-clear->-pair-props-if-match-before end (1- (point))) + (setq new-end (point)))) (c-backward-syntactic-ws) - (setq new-end (point)) ;; Extend the fontification region, if needed. (and new-beg @@ -8863,7 +8863,29 @@ comment at the start of cc-engine.el for more info." ;; it as a declaration if "a" has been used as a type ;; somewhere else (if it's a known type we won't get here). (setq maybe-expression t) - (throw 'at-decl-or-cast t))) + (throw 'at-decl-or-cast t)) + + ;; CASE 17.5 + (when (and c-asymmetry-fontification-flag + got-prefix-before-parens + at-type + (or (not got-suffix) + at-decl-start)) + (let ((space-before-id + (save-excursion + (goto-char name-start) + (or (bolp) (memq (char-before) '(?\ ?\t))))) + (space-after-type + (save-excursion + (goto-char type-start) + (and (c-forward-type) + (progn (c-backward-syntactic-ws) t) + (or (eolp) + (memq (char-after) '(?\ ?\t))))))) + (when (not (eq (not space-before-id) + (not space-after-type))) + (setq maybe-expression t) + (throw 'at-decl-or-cast t))))) ;; CASE 18 (when (and (not (memq context '(nil top))) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index f623b9f333..923f077b41 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1117,6 +1117,124 @@ casts and declarations are fontified. Used on level 2 and higher." (setq pos (point)))))) ; acts to make the `while' form continue. nil) +(defun c-get-fontification-context (match-pos not-front-decl &optional toplev) + ;; Return a cons (CONTEXT . RESTRICTED-<>-ARGLISTS) for MATCH-POS. + ;; NOT-FRONT-DECL is non-nil when a declaration later in the buffer than + ;; MATCH-POS has already been parsed. TOPLEV is non-nil when MATCH-POS is + ;; known to be at "top level", i.e. outside any braces, or directly inside a + ;; namespace, class, etc. + ;; + ;; CONTEXT is the fontification context of MATCH-POS, and is one of the + ;; following: + ;; 'decl In a comma-separated declaration context (typically + ;; inside a function declaration arglist). + ;; '<> In an angle bracket arglist. + ;; 'arglist Some other type of arglist. + ;; 'top Some other context and point is at the top-level (either + ;; outside any braces or directly inside a class or namespace, + ;; etc.) + ;; nil Some other context or unknown context. Includes + ;; within the parens of an if, for, ... construct. + ;; 'not-decl Definitely not in a declaration. + ;; + ;; RESTRICTED-<>-ARGLISTS is non-nil when a scan of template/generic + ;; arguments lists (i.e. lists enclosed by <...>) is more strict about what + ;; characters it allows within the list. + (let ((type (and (> match-pos (point-min)) + (c-get-char-property (1- match-pos) 'c-type)))) + (cond ((not (memq (char-before match-pos) '(?\( ?, ?\[ ?< ?{))) + (cons (and toplev 'top) nil)) + ;; A control flow expression or a decltype + ((and (eq (char-before match-pos) ?\() + (save-excursion + (goto-char match-pos) + (backward-char) + (c-backward-token-2) + (or (looking-at c-block-stmt-2-key) + (looking-at c-block-stmt-1-2-key) + (looking-at c-typeof-key)))) + (cons nil t)) + ;; Near BOB. + ((<= match-pos (point-min)) + (cons 'arglist t)) + ;; Got a cached hit in a declaration arglist. + ((eq type 'c-decl-arg-start) + (cons 'decl nil)) + ;; We're inside (probably) a brace list. + ((eq type 'c-not-decl) + (cons 'not-decl nil)) + ;; Inside a C++11 lambda function arglist. + ((and (c-major-mode-is 'c++-mode) + (eq (char-before match-pos) ?\() + (save-excursion + (goto-char match-pos) + (c-backward-token-2) + (and + (c-safe (goto-char (scan-sexps (point) -1))) + (c-looking-at-c++-lambda-capture-list)))) + (c-put-char-property (1- match-pos) 'c-type + 'c-decl-arg-start) + (cons 'decl nil)) + ;; We're inside a brace list. + ((and (eq (char-before match-pos) ?{) + (save-excursion + (goto-char (1- match-pos)) + (consp + (c-looking-at-or-maybe-in-bracelist)))) + (c-put-char-property (1- match-pos) 'c-type + 'c-not-decl) + (cons 'not-decl nil)) + ;; We're inside an "ordinary" open brace. + ((eq (char-before match-pos) ?{) + (cons (and toplev 'top) nil)) + ;; Inside an angle bracket arglist. + ((or (eq type 'c-<>-arg-sep) + (eq (char-before match-pos) ?<)) + (cons '<> nil)) + ;; Got a cached hit in some other type of arglist. + (type + (cons 'arglist t)) + (not-front-decl + ;; The point is within the range of a previously + ;; encountered type decl expression, so the arglist + ;; is probably one that contains declarations. + ;; However, if `c-recognize-paren-inits' is set it + ;; might also be an initializer arglist. + ;; + ;; The result of this check is cached with a char + ;; property on the match token, so that we can look + ;; it up again when refontifying single lines in a + ;; multiline declaration. + (c-put-char-property (1- match-pos) + 'c-type 'c-decl-arg-start) + (cons 'decl nil)) + ;; Got an open paren preceded by an arith operator. + ((and (eq (char-before match-pos) ?\() + (save-excursion + (and (zerop (c-backward-token-2 2)) + (looking-at c-arithmetic-op-regexp)))) + (cons nil nil)) + ;; At start of a declaration inside a declaration paren. + ((save-excursion + (and (memq (char-before match-pos) '(?\( ?\,)) + (c-go-up-list-backward match-pos) + (eq (char-after) ?\() + (let ((type (c-get-char-property (point) 'c-type))) + (or (memq type '(c-decl-arg-start c-decl-type-start)) + (and + (progn (c-backward-syntactic-ws) t) + (c-back-over-compound-identifier) + (progn + (c-backward-syntactic-ws) + (or (bobp) + (progn + (setq type (c-get-char-property (1- (point)) + 'c-type)) + (memq type '(c-decl-arg-start + c-decl-type-start)))))))))) + (cons 'decl nil)) + (t (cons 'arglist t))))) + (defun c-font-lock-declarations (limit) ;; Fontify all the declarations, casts and labels from the point to LIMIT. ;; Assumes that strings and comments have been fontified already. @@ -1231,95 +1349,15 @@ casts and declarations are fontified. Used on level 2 and higher." ;; "<" for the sake of C++-style template arglists. ;; Ignore "(" when it's part of a control flow construct ;; (e.g. "for ("). - (let ((type (and (> match-pos (point-min)) - (c-get-char-property (1- match-pos) 'c-type)))) - (cond ((not (memq (char-before match-pos) '(?\( ?, ?\[ ?< ?{))) - (setq context (and toplev 'top) - c-restricted-<>-arglists nil)) - ;; A control flow expression or a decltype - ((and (eq (char-before match-pos) ?\() - (save-excursion - (goto-char match-pos) - (backward-char) - (c-backward-token-2) - (or (looking-at c-block-stmt-2-key) - (looking-at c-block-stmt-1-2-key) - (looking-at c-typeof-key)))) - (setq context nil - c-restricted-<>-arglists t)) - ;; Near BOB. - ((<= match-pos (point-min)) - (setq context 'arglist - c-restricted-<>-arglists t)) - ;; Got a cached hit in a declaration arglist. - ((eq type 'c-decl-arg-start) - (setq context 'decl - c-restricted-<>-arglists nil)) - ;; We're inside (probably) a brace list. - ((eq type 'c-not-decl) - (setq context 'not-decl - c-restricted-<>-arglists nil)) - ;; Inside a C++11 lambda function arglist. - ((and (c-major-mode-is 'c++-mode) - (eq (char-before match-pos) ?\() - (save-excursion - (goto-char match-pos) - (c-backward-token-2) - (and - (c-safe (goto-char (scan-sexps (point) -1))) - (c-looking-at-c++-lambda-capture-list)))) - (setq context 'decl - c-restricted-<>-arglists nil) - (c-put-char-property (1- match-pos) 'c-type - 'c-decl-arg-start)) - ;; We're inside a brace list. - ((and (eq (char-before match-pos) ?{) - (save-excursion - (goto-char (1- match-pos)) - (consp - (c-looking-at-or-maybe-in-bracelist)))) - (setq context 'not-decl - c-restricted-<>-arglists nil) - (c-put-char-property (1- match-pos) 'c-type - 'c-not-decl)) - ;; We're inside an "ordinary" open brace. - ((eq (char-before match-pos) ?{) - (setq context (and toplev 'top) - c-restricted-<>-arglists nil)) - ;; Inside an angle bracket arglist. - ((or (eq type 'c-<>-arg-sep) - (eq (char-before match-pos) ?<)) - (setq context '<> - c-restricted-<>-arglists nil)) - ;; Got a cached hit in some other type of arglist. - (type - (setq context 'arglist - c-restricted-<>-arglists t)) - ((if inside-macro - (< match-pos max-type-decl-end-before-token) - (< match-pos max-type-decl-end)) - ;; The point is within the range of a previously - ;; encountered type decl expression, so the arglist - ;; is probably one that contains declarations. - ;; However, if `c-recognize-paren-inits' is set it - ;; might also be an initializer arglist. - (setq context 'decl - c-restricted-<>-arglists nil) - ;; The result of this check is cached with a char - ;; property on the match token, so that we can look - ;; it up again when refontifying single lines in a - ;; multiline declaration. - (c-put-char-property (1- match-pos) - 'c-type 'c-decl-arg-start)) - ;; Got an open paren preceded by an arith operator. - ((and (eq (char-before match-pos) ?\() - (save-excursion - (and (zerop (c-backward-token-2 2)) - (looking-at c-arithmetic-op-regexp)))) - (setq context nil - c-restricted-<>-arglists nil)) - (t (setq context 'arglist - c-restricted-<>-arglists t)))) + (let ((got-context + (c-get-fontification-context + match-pos + (< match-pos (if inside-macro + max-type-decl-end-before-token + max-type-decl-end)) + toplev))) + (setq context (car got-context) + c-restricted-<>-arglists (cdr got-context))) ;; Check we haven't missed a preceding "typedef". (when (not (looking-at c-typedef-key)) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 8326e6a6f2..20c63d4dbe 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1363,6 +1363,7 @@ Note that the style variables are always made local to the buffer." ;; This function is called indirectly from font locking stuff - either from ;; c-after-change (to prepare for after-change font-locking) or from font ;; lock context (etc.) fontification. + (goto-char pos) (let ((lit-start (c-literal-start)) (new-pos pos) capture-opener diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 1114b21381..ccd4fd2994 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1634,6 +1634,18 @@ names).")) :type 'c-extra-types-widget :group 'c) +(defcustom c-asymmetry-fontification-flag t + "Whether to fontify certain ambiguous constructs by white space asymmetry. + +In the fontification engine, it is sometimes impossible to determine +whether a construct is a declaration or an expression. This happens +particularly in C++, due to ambiguities in the language. When such a +construct is like \"foo * bar\" or \"foo &bar\", and this variable is non-nil +(the default), the construct will be fontified as a declaration if there is +white space either before or after the operator, but not both." + :type 'boolean + :group 'c) + (defvar c-noise-macro-with-parens-name-re "\\<\\>") (defvar c-noise-macro-name-re "\\<\\>") commit 6ff870218dd4bc015cc4115ceb2febd8d807e57c Author: Paul Eggert Date: Thu Mar 30 11:08:23 2017 -0700 Some inotify cleanup This catches some problems with integer overflow and races that I noticed in inotify.c after reviewing the changes installed to fix Bug#26126. * src/fns.c, src/lisp.h (equal_no_quit): Now extern. * src/inotify.c (aspect_to_inotifymask): Check for cycles and for improper lists. (make_lispy_mask, lispy_mask_match_p): Remove. All callers changed to use INTEGER_TO_CONS and CONS_TO_INTEGER. (inotifyevent_to_event, add_watch): Don’t assume watch descriptors and cookies fit in fixnums. (add_watch): Use assoc_no_quit, not Fassoc. Avoid integer overflow in (very!) long-running processes where the Emacs watch ID could overflow. Avoid some duplicate code. (find_descriptor): New function. (remove_descriptor): First arg is now the returned value from find_descriptor, rather than the descriptor. This way, the value can be removed without calling Fdelete, which might quit. Wait until the end (when watch_list is consistent) before signaling any errors. (remove_watch, inotify_callback): Use find_descriptor to avoid the need for Fdelete. (inotify_callback): Use simpler tests for ioctl failure. Free temporary buffer if signaled, and put it on the stack if small. Use ssize_t to index through read results, to avoid a cast. (valid_watch_descriptor): New function, with a tighter check. (Finotify_rm_watch, Finotify_valid_p): Use it. (Finotify_valid_p): Use assoc_no_quit and ass_no_quit instead of Fassoc. Do not assume the first assoc succeeds. * test/src/inotify-tests.el (inotify-valid-p-simple): Add inotify-valid-p tests, some of which dump core without the fixes noted above. diff --git a/src/fns.c b/src/fns.c index 42e2eecf33..de7fc1b47f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -38,7 +38,6 @@ along with GNU Emacs. If not, see . */ static void sort_vector_copy (Lisp_Object, ptrdiff_t, Lisp_Object *restrict, Lisp_Object *restrict); -static bool equal_no_quit (Lisp_Object, Lisp_Object); enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; static bool internal_equal (Lisp_Object, Lisp_Object, enum equal_kind, int, Lisp_Object); @@ -2121,7 +2120,7 @@ of strings. (`equal' ignores text properties.) */) Use this only on arguments that are cycle-free and not too large and are not window configurations. */ -static bool +bool equal_no_quit (Lisp_Object o1, Lisp_Object o2) { return internal_equal (o1, o2, EQUAL_NO_QUIT, 0, Qnil); diff --git a/src/inotify.c b/src/inotify.c index 004689bd4b..a0a89aa0f4 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -41,16 +41,16 @@ along with GNU Emacs. If not, see . */ #ifndef IN_ONLYDIR # define IN_ONLYDIR 0 #endif -#define INOTIFY_DEFAULT_MASK (IN_ALL_EVENTS|IN_EXCL_UNLINK) +#define INOTIFY_DEFAULT_MASK (IN_ALL_EVENTS | IN_EXCL_UNLINK) /* File handle for inotify. */ static int inotifyfd = -1; /* Alist of files being watched. We want the returned descriptor to be unique for every watch, but inotify returns the same descriptor - for multiple calls to inotify_add_watch with the same file. In - order to solve this problem, we add a ID, uniquely identifying a - watch/file combination. + WD for multiple calls to inotify_add_watch with the same file. + Supply a nonnegative integer ID, so that WD and ID together + uniquely identify a watch/file combination. For the same reason, we also need to store the watch's mask and we can't allow the following flags to be used. @@ -60,12 +60,21 @@ static int inotifyfd = -1; IN_ONESHOT IN_ONLYDIR - Format: (descriptor . ((id filename callback mask) ...)) -*/ + Each element of this list is of the form (DESCRIPTOR . WATCHES) + where no two DESCRIPTOR values are the same. DESCRIPTOR represents + the inotify watch descriptor and WATCHES is a list with elements of + the form (ID FILENAME CALLBACK MASK), where ID is the integer + described above, FILENAME names the file being watched, CALLBACK is + invoked when the event occurs, and MASK represents the aspects + being watched. The WATCHES list is sorted by ID. Although + DESCRIPTOR and MASK are ordinarily integers, they are conses when + representing integers outside of fixnum range. */ + static Lisp_Object watch_list; static Lisp_Object -mask_to_aspects (uint32_t mask) { +mask_to_aspects (uint32_t mask) +{ Lisp_Object aspects = Qnil; if (mask & IN_ACCESS) aspects = Fcons (Qaccess, aspects); @@ -149,15 +158,13 @@ symbol_to_inotifymask (Lisp_Object symb) static uint32_t aspect_to_inotifymask (Lisp_Object aspect) { - if (CONSP (aspect)) + if (CONSP (aspect) || NILP (aspect)) { Lisp_Object x = aspect; uint32_t mask = 0; - while (CONSP (x)) - { - mask |= symbol_to_inotifymask (XCAR (x)); - x = XCDR (x); - } + FOR_EACH_TAIL (x) + mask |= symbol_to_inotifymask (XCAR (x)); + CHECK_LIST_END (x, aspect); return mask; } else @@ -165,25 +172,13 @@ aspect_to_inotifymask (Lisp_Object aspect) } static Lisp_Object -make_lispy_mask (uint32_t mask) -{ - return Fcons (make_number (mask & 0xffff), - make_number (mask >> 16)); -} - -static bool -lispy_mask_match_p (Lisp_Object mask, uint32_t other) -{ - return (XINT (XCAR (mask)) & other) - || ((XINT (XCDR (mask)) << 16) & other); -} - -static Lisp_Object inotifyevent_to_event (Lisp_Object watch, struct inotify_event const *ev) { - Lisp_Object name = Qnil; + Lisp_Object name; + uint32_t mask; + CONS_TO_INTEGER (Fnth (make_number (3), watch), uint32_t, mask); - if (! lispy_mask_match_p (Fnth (make_number (3), watch), ev->mask)) + if (! (mask & ev->mask)) return Qnil; if (ev->len > 0) @@ -195,10 +190,10 @@ inotifyevent_to_event (Lisp_Object watch, struct inotify_event const *ev) else name = XCAR (XCDR (watch)); - return list2 (list4 (Fcons (make_number (ev->wd), XCAR (watch)), + return list2 (list4 (Fcons (INTEGER_TO_CONS (ev->wd), XCAR (watch)), mask_to_aspects (ev->mask), name, - make_number (ev->cookie)), + INTEGER_TO_CONS (ev->cookie)), Fnth (make_number (2), watch)); } @@ -209,55 +204,88 @@ static Lisp_Object add_watch (int wd, Lisp_Object filename, Lisp_Object aspect, Lisp_Object callback) { - Lisp_Object descriptor = make_number (wd); - Lisp_Object elt = Fassoc (descriptor, watch_list); - Lisp_Object watches = Fcdr (elt); + Lisp_Object descriptor = INTEGER_TO_CONS (wd); + Lisp_Object tail = assoc_no_quit (descriptor, watch_list); Lisp_Object watch, watch_id; - Lisp_Object mask = make_lispy_mask (aspect_to_inotifymask (aspect)); + uint32_t imask = aspect_to_inotifymask (aspect); + Lisp_Object mask = INTEGER_TO_CONS (imask); - int id = 0; - - while (! NILP (watches)) + EMACS_INT id = 0; + if (NILP (tail)) + { + tail = list1 (descriptor); + watch_list = Fcons (tail, watch_list); + } + else { - id = max (id, 1 + XINT (XCAR (XCAR (watches)))); - watches = XCDR (watches); + /* Assign a watch ID that is not already in use, by looking + for a gap in the existing sorted list. */ + for (; ! NILP (XCDR (tail)); tail = XCDR (tail), id++) + if (!EQ (XCAR (XCAR (XCDR (tail))), make_number (id))) + break; + if (MOST_POSITIVE_FIXNUM < id) + emacs_abort (); } watch_id = make_number (id); watch = list4 (watch_id, filename, callback, mask); - - if (NILP (elt)) - watch_list = Fcons (Fcons (descriptor, Fcons (watch, Qnil)), - watch_list); - else - XSETCDR (elt, Fcons (watch, XCDR (elt))); + XSETCDR (tail, Fcons (watch, XCDR (tail))); return Fcons (descriptor, watch_id); } -/* Remove all watches associated with descriptor. If INVALID_P is - true, the descriptor is already invalid, i.e. it received a - IN_IGNORED event. In this case skip calling inotify_rm_watch. */ +/* Find the watch list element (if any) matching DESCRIPTOR. Return + nil if not found. If found, return t if the first element matches + DESCRIPTOR; otherwise, return the cons whose cdr matches + DESCRIPTOR. This lets the caller easily remove the element + matching DESCRIPTOR without having to search for it again, and + without calling Fdelete (which might quit). */ + +static Lisp_Object +find_descriptor (Lisp_Object descriptor) +{ + Lisp_Object tail, prevtail = Qt; + for (tail = watch_list; !NILP (tail); prevtail = tail, tail = XCDR (tail)) + if (equal_no_quit (XCAR (XCAR (tail)), descriptor)) + return prevtail; + return Qnil; +} + +/* Remove all watches associated with the watch list element after + PREVTAIL, or after the first element if PREVTAIL is t. If INVALID_P + is true, the descriptor is already invalid, i.e., it received a + IN_IGNORED event. In this case skip calling inotify_rm_watch. */ static void -remove_descriptor (Lisp_Object descriptor, bool invalid_p) +remove_descriptor (Lisp_Object prevtail, bool invalid_p) { - Lisp_Object elt = Fassoc (descriptor, watch_list); + Lisp_Object tail = CONSP (prevtail) ? XCDR (prevtail) : watch_list; - if (! NILP (elt)) + int inotify_errno = 0; + if (! invalid_p) { - int wd = XINT (descriptor); + int wd; + CONS_TO_INTEGER (XCAR (XCAR (tail)), int, wd); + if (inotify_rm_watch (inotifyfd, wd) != 0) + inotify_errno = errno; + } - watch_list = Fdelete (elt, watch_list); - if (! invalid_p) - if (inotify_rm_watch (inotifyfd, wd) == -1) - report_file_notify_error ("Could not rm watch", descriptor); + if (CONSP (prevtail)) + XSETCDR (prevtail, XCDR (tail)); + else + { + watch_list = XCDR (tail); + if (NILP (watch_list)) + { + delete_read_fd (inotifyfd); + emacs_close (inotifyfd); + inotifyfd = -1; + } } - /* Cleanup if no more files are watched. */ - if (NILP (watch_list)) + + if (inotify_errno != 0) { - emacs_close (inotifyfd); - delete_read_fd (inotifyfd); - inotifyfd = -1; + errno = inotify_errno; + report_file_notify_error ("Could not rm watch", XCAR (tail)); } } @@ -265,19 +293,19 @@ remove_descriptor (Lisp_Object descriptor, bool invalid_p) static void remove_watch (Lisp_Object descriptor, Lisp_Object id) { - Lisp_Object elt = Fassoc (descriptor, watch_list); - - if (! NILP (elt)) - { - Lisp_Object watch = Fassoc (id, XCDR (elt)); - - if (! NILP (watch)) - XSETCDR (elt, Fdelete (watch, XCDR (elt))); - - /* Remove the descriptor if noone is watching it. */ - if (NILP (XCDR (elt))) - remove_descriptor (descriptor, false); - } + Lisp_Object prevtail = find_descriptor (descriptor); + if (NILP (prevtail)) + return; + + Lisp_Object elt = XCAR (CONSP (prevtail) ? XCDR (prevtail) : watch_list); + for (Lisp_Object prev = elt; !NILP (XCDR (prev)); prev = XCDR (prev)) + if (EQ (id, XCAR (XCAR (XCDR (prev))))) + { + XSETCDR (prev, XCDR (XCDR (prev))); + if (NILP (XCDR (elt))) + remove_descriptor (prevtail, false); + break; + } } /* This callback is called when the FD is available for read. The inotify @@ -285,52 +313,44 @@ remove_watch (Lisp_Object descriptor, Lisp_Object id) static void inotify_callback (int fd, void *_) { - struct input_event event; int to_read; - char *buffer; - ssize_t n; - size_t i; - - to_read = 0; - if (ioctl (fd, FIONREAD, &to_read) == -1) + if (ioctl (fd, FIONREAD, &to_read) < 0) report_file_notify_error ("Error while retrieving file system events", Qnil); - buffer = xmalloc (to_read); - n = read (fd, buffer, to_read); + USE_SAFE_ALLOCA; + char *buffer = SAFE_ALLOCA (to_read); + ssize_t n = read (fd, buffer, to_read); if (n < 0) - { - xfree (buffer); - report_file_notify_error ("Error while reading file system events", Qnil); - } + report_file_notify_error ("Error while reading file system events", Qnil); + struct input_event event; EVENT_INIT (event); event.kind = FILE_NOTIFY_EVENT; - i = 0; - while (i < (size_t)n) + for (ssize_t i = 0; i < n; ) { struct inotify_event *ev = (struct inotify_event *) &buffer[i]; - Lisp_Object descriptor = make_number (ev->wd); - Lisp_Object elt = Fassoc (descriptor, watch_list); + Lisp_Object descriptor = INTEGER_TO_CONS (ev->wd); + Lisp_Object prevtail = find_descriptor (descriptor); - if (! NILP (elt)) + if (! NILP (prevtail)) { - Lisp_Object watches = XCDR (elt); - while (! NILP (watches)) + Lisp_Object tail = CONSP (prevtail) ? XCDR (prevtail) : watch_list; + for (Lisp_Object watches = XCDR (XCAR (tail)); ! NILP (watches); + watches = XCDR (watches)) { event.arg = inotifyevent_to_event (XCAR (watches), ev); if (!NILP (event.arg)) kbd_buffer_store_event (&event); - watches = XCDR (watches); } /* If event was removed automatically: Drop it from watch list. */ if (ev->mask & IN_IGNORED) - remove_descriptor (descriptor, true); + remove_descriptor (prevtail, true); } i += sizeof (*ev) + ev->len; } - xfree (buffer); + SAFE_FREE (); } DEFUN ("inotify-add-watch", Finotify_add_watch, Sinotify_add_watch, 3, 3, 0, @@ -407,7 +427,7 @@ IN_ONLYDIR */) if (inotifyfd < 0) { - inotifyfd = inotify_init1 (IN_NONBLOCK|IN_CLOEXEC); + inotifyfd = inotify_init1 (IN_NONBLOCK | IN_CLOEXEC); if (inotifyfd < 0) report_file_notify_error ("File watching is not available", Qnil); watch_list = Qnil; @@ -416,12 +436,24 @@ IN_ONLYDIR */) encoded_file_name = ENCODE_FILE (filename); wd = inotify_add_watch (inotifyfd, SSDATA (encoded_file_name), mask); - if (wd == -1) + if (wd < 0) report_file_notify_error ("Could not add watch for file", filename); return add_watch (wd, filename, aspect, callback); } +static bool +valid_watch_descriptor (Lisp_Object wd) +{ + return (CONSP (wd) + && (RANGED_INTEGERP (0, XCAR (wd), INT_MAX) + || (CONSP (XCAR (wd)) + && RANGED_INTEGERP ((MOST_POSITIVE_FIXNUM >> 16) + 1, + XCAR (XCAR (wd)), INT_MAX >> 16) + && RANGED_INTEGERP (0, XCDR (XCAR (wd)), (1 << 16) - 1))) + && NATNUMP (XCDR (wd))); +} + DEFUN ("inotify-rm-watch", Finotify_rm_watch, Sinotify_rm_watch, 1, 1, 0, doc: /* Remove an existing WATCH-DESCRIPTOR. @@ -433,9 +465,7 @@ See inotify_rm_watch(2) for more information. */) Lisp_Object descriptor, id; - if (! (CONSP (watch_descriptor) - && INTEGERP (XCAR (watch_descriptor)) - && INTEGERP (XCDR (watch_descriptor)))) + if (! valid_watch_descriptor (watch_descriptor)) report_file_notify_error ("Invalid descriptor ", watch_descriptor); descriptor = XCAR (watch_descriptor); @@ -456,16 +486,12 @@ reason. Removing the watch by calling `inotify-rm-watch' also makes it invalid. */) (Lisp_Object watch_descriptor) { - Lisp_Object elt, watch; - - if (! (CONSP (watch_descriptor) - && INTEGERP (XCAR (watch_descriptor)) - && INTEGERP (XCDR (watch_descriptor)))) + if (! valid_watch_descriptor (watch_descriptor)) return Qnil; - - elt = Fassoc (XCAR (watch_descriptor), watch_list); - watch = Fassoc (XCDR (watch_descriptor), XCDR (elt)); - + Lisp_Object tail = assoc_no_quit (XCAR (watch_descriptor), watch_list); + if (NILP (tail)) + return Qnil; + Lisp_Object watch = assq_no_quit (XCDR (watch_descriptor), XCDR (tail)); return ! NILP (watch) ? Qt : Qnil; } diff --git a/src/lisp.h b/src/lisp.h index 4b9cd3c470..3125bd2a5d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3376,6 +3376,7 @@ extern Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object do_yes_or_no_p (Lisp_Object); extern Lisp_Object concat2 (Lisp_Object, Lisp_Object); extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object); +extern bool equal_no_quit (Lisp_Object, Lisp_Object); extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object); extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object); extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object); diff --git a/test/src/inotify-tests.el b/test/src/inotify-tests.el index f30aecc9c4..987e1fc077 100644 --- a/test/src/inotify-tests.el +++ b/test/src/inotify-tests.el @@ -28,6 +28,13 @@ (declare-function inotify-add-watch "inotify.c" (file-name aspect callback)) (declare-function inotify-rm-watch "inotify.c" (watch-descriptor)) +(ert-deftest inotify-valid-p-simple () + "Simple tests for `inotify-valid-p'." + (skip-unless (featurep 'inotify)) + (should-not (inotify-valid-p 0)) + (should-not (inotify-valid-p nil)) + (should-not (inotify-valid-p '(0 . 0)))) + ;; (ert-deftest filewatch-file-watch-aspects-check () ;; "Test whether `file-watch' properly checks the aspects." ;; (let ((temp-file (make-temp-file "filewatch-aspects"))) @@ -56,7 +63,9 @@ (insert "Foo\n")) (read-event nil nil 5) (should (> events 0))) + (should (inotify-valid-p wd)) (inotify-rm-watch wd) + (should-not (inotify-valid-p wd)) (delete-file temp-file))))) (provide 'inotify-tests) commit 1be3330b31f9c0d0d0f7d25641e8b81c807ca616 Author: Michael Albinus Date: Thu Mar 30 17:18:17 2017 +0200 * lisp/net/tramp-sh.el (tramp-get-remote-locale): Add "C.UTF-8" as candidate. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e0f8d714e1..e4a48b7f8e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5222,7 +5222,7 @@ Nonexistent directories are removed from spec." "Determine remote locale, supporting UTF8 if possible." (with-tramp-connection-property vec "locale" (tramp-send-command vec "locale -a") - (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8")) + (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8" "C.UTF-8")) locale) (with-current-buffer (tramp-get-connection-buffer vec) (while candidates commit 2c69236b3c1daa8fcadc4b798bc8422e59245690 Author: Stefan Monnier Date: Thu Mar 30 10:44:35 2017 -0400 * lisp/cedet/semantic/wisent/wisent.el (wisent-automaton-p): Use obarrayp. diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el index 36dff01979..08cad524ae 100644 --- a/lisp/cedet/semantic/wisent/wisent.el +++ b/lisp/cedet/semantic/wisent/wisent.el @@ -114,7 +114,7 @@ If OBJ is a symbol check its value." (and (vectorp obj) (= 4 (length obj)) (vectorp (aref obj 0)) (vectorp (aref obj 1)) (= (length (aref obj 0)) (length (aref obj 1))) - (listp (aref obj 2)) (vectorp (aref obj 3)))) + (listp (aref obj 2)) (obarrayp (aref obj 3)))) (defsubst wisent-region (&rest positions) "Return the start/end positions of the region including POSITIONS.