commit 74129db63d690747c008b1b5d442fe41056584c3 (HEAD, refs/remotes/origin/master) Author: Michael Albinus Date: Sun Mar 26 09:42:40 2017 +0200 ; Format files from last commit diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 0f8c945a79..55ce94a1ca 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -42,7 +42,8 @@ could use another implementation.") (cl-defstruct (file-notify--watch (:constructor nil) - (:constructor file-notify--watch-make (directory filename callback))) + (:constructor + file-notify--watch-make (directory filename callback))) ;; Watched directory directory ;; Watched relative filename, nil if watching the directory. @@ -61,14 +62,13 @@ could use another implementation.") "Hash table for registered file notification descriptors. A key in this hash table is the descriptor as returned from `inotify', `kqueue', `gfilenotify', `w32notify' or a file name -handler. The value in the hash table is file-notify--watch +handler. The value in the hash table is `file-notify--watch' struct.") (defun file-notify--rm-descriptor (descriptor) "Remove DESCRIPTOR from `file-notify-descriptors'. -DESCRIPTOR should be an object returned by -`file-notify-add-watch'. If it is registered in -`file-notify-descriptors', a stopped event is sent." +DESCRIPTOR should be an object returned by `file-notify-add-watch'. +If it is registered in `file-notify-descriptors', a stopped event is sent." (when-let (watch (gethash descriptor file-notify-descriptors)) ;; Send `stopped' event. (unwind-protect @@ -123,8 +123,7 @@ This is available in case a file has been moved." (and (stringp (nth 3 event)) (directory-file-name (expand-file-name - (nth 3 event) - (file-notify--watch-directory watch)))))) + (nth 3 event) (file-notify--watch-directory watch)))))) ;; Cookies are offered by `inotify' only. (defun file-notify--event-cookie (event) @@ -187,11 +186,13 @@ EVENT is the cadr of the event in `file-notify-handle-event' ((memq action '(attrib link)) 'attribute-changed) ((memq action '(create added)) 'created) ((memq action '(modify modified write)) 'changed) - ((memq action '(delete delete-self move-self removed)) 'deleted) + ((memq action + '(delete delete-self move-self removed)) 'deleted) ;; Make the event pending. ((memq action '(moved-from renamed-from)) (setq file-notify--pending-event - `((,desc ,action ,file ,(file-notify--event-cookie event)) + `((,desc ,action ,file + ,(file-notify--event-cookie event)) ,(file-notify--watch-callback watch))) nil) ;; Look for pending event. @@ -222,8 +223,8 @@ EVENT is the cadr of the event in `file-notify-handle-event' ;; Apply callback. (when (and action (or - ;; If there is no relative file name for that watch, - ;; we watch the whole directory. + ;; If there is no relative file name for that + ;; watch, we watch the whole directory. (null (file-notify--watch-filename watch)) ;; File matches. (string-equal @@ -241,8 +242,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' (file-name-nondirectory file1))))) ;;(message ;;"file-notify-callback %S %S %S %S %S" - ;;desc - ;;action file file1 watch) + ;;desc action file file1 watch) (if file1 (funcall (file-notify--watch-callback watch) `(,desc ,action ,file ,file1)) @@ -382,8 +382,8 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." 'file-notify-rm-watch))) (condition-case nil (if handler - ;; A file name handler could exist even if there is no local - ;; file notification support. + ;; A file name handler could exist even if there is no + ;; local file notification support. (funcall handler 'file-notify-rm-watch descriptor) (funcall diff --git a/src/inotify.c b/src/inotify.c index a084552adc..470b60ba89 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -61,7 +61,7 @@ static int inotifyfd = -1; IN_ONLYDIR Format: (descriptor . ((id filename callback mask) ...)) - */ +*/ static Lisp_Object watch_list; static Lisp_Object @@ -204,9 +204,10 @@ inotifyevent_to_event (Lisp_Object watch, struct inotify_event const *ev) /* Add a new watch to watch-descriptor WD watching FILENAME and using CALLBACK. Returns a cons (DESCRIPTOR . ID) uniquely identifying the - new watch. */ + new watch. */ static Lisp_Object -add_watch (int wd, Lisp_Object filename, Lisp_Object aspect, Lisp_Object callback) +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); @@ -260,7 +261,7 @@ remove_descriptor (Lisp_Object descriptor, bool invalid_p) } } -/* Remove watch associated with (descriptor, id). */ +/* Remove watch associated with (descriptor, id). */ static void remove_watch (Lisp_Object descriptor, Lisp_Object id) { @@ -273,7 +274,7 @@ remove_watch (Lisp_Object descriptor, Lisp_Object id) if (! NILP (watch)) XSETCDR (elt, Fdelete (watch, XCDR (elt))); - /* Remove the descriptor if noone is watching it. */ + /* Remove the descriptor if noone is watching it. */ if (NILP (XCDR (elt))) remove_descriptor (descriptor, false); } @@ -378,13 +379,12 @@ unmount If a directory is watched then NAME is the name of file that caused the event. -COOKIE is an object that can be compared using `equal' to identify two matchingt +COOKIE is an object that can be compared using `equal' to identify two matching renames (moved-from and moved-to). See inotify(7) and inotify_add_watch(2) for further information. The inotify fd is managed internally and there is no corresponding inotify_init. Use -`inotify-rm-watch' to remove a watch. - */) +`inotify-rm-watch' to remove a watch. */) (Lisp_Object filename, Lisp_Object aspect, Lisp_Object callback) { Lisp_Object encoded_file_name; @@ -417,8 +417,7 @@ DEFUN ("inotify-rm-watch", Finotify_rm_watch, Sinotify_rm_watch, 1, 1, 0, WATCH-DESCRIPTOR should be an object returned by `inotify-add-watch'. -See inotify_rm_watch(2) for more information. - */) +See inotify_rm_watch(2) for more information. */) (Lisp_Object watch_descriptor) { @@ -462,13 +461,13 @@ it invalid. */) #ifdef INOTIFY_DEBUG DEFUN ("inotify-watch-list", Finotify_watch_list, Sinotify_watch_list, 0, 0, 0, - doc: /* Return a copy of the internal watch_list. */) + doc: /* Return a copy of the internal watch_list. */) { return Fcopy_sequence (watch_list); } DEFUN ("inotify-allocated-p", Finotify_allocated_p, Sinotify_allocated_p, 0, 0, 0, - doc: /* Return non-nil, if a inotify instance is allocated. */) + doc: /* Return non-nil, if a inotify instance is allocated. */) { return inotifyfd < 0 ? Qnil : Qt; } commit 158bb8555dfefa50f6118be6794d0424cc52d291 Author: Andreas Politz Date: Sun Mar 26 09:21:56 2017 +0200 Fix issues regarding inotify file-notification Remove special code handling the inotify back-end. * lisp/filenotify.el (file-notify--watch): New struct representing a file-watch. (file-notify-descriptors): Use the new struct as hash-value. (file-notify-handle-event): Check that event is a cons. (file-notify--rm-descriptor, file-notify--event-watched-file) (file-notify--event-file-name, file-notify--event-file1-name) (file-notify-callback, file-notify-add-watch) (file-notify-rm-watch, file-notify-valid-p): Use new struct. Remove special code handling inotify descriptors. Remove code handling multiple clients per descriptor. (file-notify--descriptor): Remove unused function. Let inotify-add-watch return a unique descriptor on every call, like every other back-end does (Bug#26126). Prevent multiple clients from interfering with each other, when watching a shared descriptor. * src/inotify.c (watch_list): Extend the format by including a id and the provided mask. (INOTIFY_DEFAULT_MASK): Default mask used for all clients. (make_watch_descriptor): Removed. (make_lispy_mask, lispy_mask_match_p): New functions. (inotifyevent_to_event): Match event against the mask provided by the client. (add_watch, remove_descriptor, remove_watch): New functions for managing the watch_list. (inotify_callback): Use the new functions. (Finotify_add_watch, Finotify_rm_watch): Remove deprecated flags from documentation. Add check for validity of provided descriptor. Use the new functions. Use the default mask. (INOTIFY_DEBUG): Add new debug conditional. (inotify-watch-list, inotify-allocated-p): New debug functions. (symbol_to_inotifymask, syms_of_inotify): Remove deprecated symbols. * test/lisp/filenotify-tests.el: (file-notify-test02-rm-watch): Remove expected failure for inotify. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 80e9f898b2..0f8c945a79 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -40,41 +40,42 @@ The value is the name of the low-level file notification package to be used for local file systems. Remote file notifications could use another implementation.") +(cl-defstruct (file-notify--watch + (:constructor nil) + (:constructor file-notify--watch-make (directory filename callback))) + ;; Watched directory + directory + ;; Watched relative filename, nil if watching the directory. + filename + ;; Function to propagate events to + callback) + +(defun file-notify--watch-absolute-filename (watch) + (if (file-notify--watch-filename watch) + (expand-file-name + (file-notify--watch-filename watch) + (file-notify--watch-directory watch)) + (file-notify--watch-directory watch))) + (defvar file-notify-descriptors (make-hash-table :test 'equal) "Hash table for registered file notification descriptors. A key in this hash table is the descriptor as returned from `inotify', `kqueue', `gfilenotify', `w32notify' or a file name -handler. The value in the hash table is a list - - (DIR (FILE . CALLBACK) (FILE . CALLBACK) ...) - -Several values for a given DIR happen only for `inotify', when -different files from the same directory are watched.") +handler. The value in the hash table is file-notify--watch +struct.") (defun file-notify--rm-descriptor (descriptor) "Remove DESCRIPTOR from `file-notify-descriptors'. -DESCRIPTOR should be an object returned by `file-notify-add-watch'. -If it is registered in `file-notify-descriptors', a stopped event is sent." - (let* ((desc (if (consp descriptor) (car descriptor) descriptor)) - (registered (gethash desc file-notify-descriptors)) - (file (if (consp descriptor) (cdr descriptor) (cl-caadr registered))) - (dir (car registered))) - - (when (consp registered) - ;; Send `stopped' event. - (when (consp (assoc file (cdr registered))) +DESCRIPTOR should be an object returned by +`file-notify-add-watch'. If it is registered in +`file-notify-descriptors', a stopped event is sent." + (when-let (watch (gethash descriptor file-notify-descriptors)) + ;; Send `stopped' event. + (unwind-protect (funcall - (cdr (assoc file (cdr registered))) - `(,descriptor stopped ,(if file (expand-file-name file dir) dir)))) - - ;; Modify `file-notify-descriptors'. - (if (not file) - (remhash desc file-notify-descriptors) - (setcdr registered - (delete (assoc file (cdr registered)) (cdr registered))) - (if (null (cdr registered)) - (remhash desc file-notify-descriptors) - (puthash desc registered file-notify-descriptors)))))) + (file-notify--watch-callback watch) + `(,descriptor stopped ,(file-notify--watch-absolute-filename watch))) + (remhash descriptor file-notify-descriptors)))) ;; This function is used by `inotify', `kqueue', `gfilenotify' and ;; `w32notify' events. @@ -88,7 +89,8 @@ If EVENT is a filewatch event, call its callback. It has the format Otherwise, signal a `file-notify-error'." (interactive "e") ;;(message "file-notify-handle-event %S" event) - (if (and (eq (car event) 'file-notify) + (if (and (consp event) + (eq (car event) 'file-notify) (>= (length event) 3)) (funcall (nth 2 event) (nth 1 event)) (signal 'file-notify-error @@ -96,33 +98,33 @@ Otherwise, signal a `file-notify-error'." ;; Needed for `inotify' and `w32notify'. In the latter case, COOKIE is nil. (defvar file-notify--pending-event nil - "A pending file notification events for a future `renamed' action. + "A pending file notification event for a future `renamed' action. It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).") (defun file-notify--event-watched-file (event) "Return file or directory being watched. Could be different from the directory watched by the backend library." - (let* ((desc (if (consp (car event)) (caar event) (car event))) - (registered (gethash desc file-notify-descriptors)) - (file (if (consp (car event)) (cdar event) (cl-caadr registered))) - (dir (car registered))) - (if file (expand-file-name file dir) dir))) + (when-let (watch (gethash (car event) file-notify-descriptors)) + (file-notify--watch-absolute-filename watch))) (defun file-notify--event-file-name (event) "Return file name of file notification event, or nil." - (directory-file-name - (expand-file-name - (or (and (stringp (nth 2 event)) (nth 2 event)) "") - (car (gethash (car event) file-notify-descriptors))))) + (when-let (watch (gethash (car event) file-notify-descriptors)) + (directory-file-name + (expand-file-name + (or (and (stringp (nth 2 event)) (nth 2 event)) "") + (file-notify--watch-directory watch))))) ;; Only `gfilenotify' could return two file names. (defun file-notify--event-file1-name (event) "Return second file name of file notification event, or nil. This is available in case a file has been moved." - (and (stringp (nth 3 event)) - (directory-file-name - (expand-file-name - (nth 3 event) (car (gethash (car event) file-notify-descriptors)))))) + (when-let (watch (gethash (car event) file-notify-descriptors)) + (and (stringp (nth 3 event)) + (directory-file-name + (expand-file-name + (nth 3 event) + (file-notify--watch-directory watch)))))) ;; Cookies are offered by `inotify' only. (defun file-notify--event-cookie (event) @@ -130,21 +132,6 @@ This is available in case a file has been moved." This is available in case a file has been moved." (nth 3 event)) -;; `inotify' returns the same descriptor when the file (directory) -;; uses the same inode. We want to distinguish, and apply a virtual -;; descriptor which make the difference. -(defun file-notify--descriptor (desc file) - "Return the descriptor to be used in `file-notify-*-watch'. -For `gfilenotify' and `w32notify' it is the same descriptor as -used in the low-level file notification package." - (if (and (natnump desc) (eq file-notify--library 'inotify)) - (cons desc - (and (stringp file) - (car (assoc - (file-name-nondirectory file) - (gethash desc file-notify-descriptors))))) - desc)) - ;; The callback function used to map between specific flags of the ;; respective file notifications, and the ones we return. (defun file-notify-callback (event) @@ -152,138 +139,125 @@ used in the low-level file notification package." EVENT is the cadr of the event in `file-notify-handle-event' \(DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE])." (let* ((desc (car event)) - (registered (gethash desc file-notify-descriptors)) + (watch (gethash desc file-notify-descriptors)) (actions (nth 1 event)) (file (file-notify--event-file-name event)) - file1 callback pending-event stopped) + file1 pending-event stopped) ;; Make actions a list. (unless (consp actions) (setq actions (cons actions nil))) - ;; Loop over registered entries. In fact, more than one entry - ;; happens only for `inotify'. - (dolist (entry (cdr registered)) - - ;; Check, that event is meant for us. - (unless (setq callback (cdr entry)) - (setq actions nil)) - + (when watch ;; Loop over actions. In fact, more than one action happens only ;; for `inotify' and `kqueue'. - (dolist (action actions) - - ;; 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))) - (or - ;; inotify. - (and (eq (nth 1 (car file-notify--pending-event)) - 'moved-from) - (not (eq action 'moved-to))) - ;; w32notify. - (and (eq (nth 1 (car file-notify--pending-event)) - 'renamed-from) - (not (eq action 'renamed-to))))) - (setq pending-event file-notify--pending-event - file-notify--pending-event nil) - (setcar (cdar pending-event) 'deleted)) - - ;; Map action. We ignore all events which cannot be mapped. - (setq action - (cond - ((memq action - '(attribute-changed changed created deleted renamed)) - action) - ((memq action '(moved rename)) - ;; The kqueue rename event does not return file1 in - ;; case a file monitor is established. - (if (setq file1 (file-notify--event-file1-name event)) - 'renamed 'deleted)) - ((eq action 'ignored) - (setq stopped t actions nil)) - ((memq action '(attrib link)) 'attribute-changed) - ((memq action '(create added)) 'created) - ((memq action '(modify modified write)) 'changed) - ((memq action '(delete delete-self move-self removed)) 'deleted) - ;; Make the event pending. - ((memq action '(moved-from renamed-from)) - (setq file-notify--pending-event - `((,desc ,action ,file ,(file-notify--event-cookie event)) - ,callback)) - nil) - ;; Look for pending event. - ((memq action '(moved-to renamed-to)) - (if (null file-notify--pending-event) - 'created - (setq file1 file - file (file-notify--event-file-name - (car file-notify--pending-event))) - ;; If the source is handled by another watch, we - ;; must fire the rename event there as well. - (when (not (equal (file-notify--descriptor desc file1) - (file-notify--descriptor - (caar file-notify--pending-event) - (file-notify--event-file-name - file-notify--pending-event)))) - (setq pending-event - `((,(caar file-notify--pending-event) - renamed ,file ,file1) - ,(cadr file-notify--pending-event)))) - (setq file-notify--pending-event nil) - 'renamed)))) - - ;; Apply pending callback. - (when pending-event - (setcar - (car pending-event) - (file-notify--descriptor - (caar pending-event) - (file-notify--event-file-name file-notify--pending-event))) - (funcall (cadr pending-event) (car pending-event)) - (setq pending-event nil)) - - ;; Apply callback. - (when (and action - (or - ;; If there is no relative file name for that watch, - ;; we watch the whole directory. - (null (nth 0 entry)) - ;; File matches. - (string-equal - (nth 0 entry) (file-name-nondirectory file)) - ;; Directory matches. - (string-equal - (file-name-nondirectory file) - (file-name-nondirectory (car registered))) - ;; File1 matches. - (and (stringp file1) - (string-equal - (nth 0 entry) (file-name-nondirectory file1))))) - ;;(message - ;;"file-notify-callback %S %S %S %S %S" - ;;(file-notify--descriptor desc (car entry)) - ;;action file file1 registered) - (if file1 - (funcall - callback - `(,(file-notify--descriptor desc (car entry)) - ,action ,file ,file1)) - (funcall - callback - `(,(file-notify--descriptor desc (car entry)) ,action ,file)))) - - ;; Send `stopped' event. - (when (or stopped - (and (memq action '(deleted renamed)) - ;; Not, when a file is backed up. - (not (and (stringp file1) (backup-file-name-p file1))) - ;; Watched file or directory is concerned. - (string-equal - file (file-notify--event-watched-file event)))) - (file-notify-rm-watch (file-notify--descriptor desc (car entry)))))))) + (while actions + (let ((action (pop actions))) + ;; 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))) + (or + ;; inotify. + (and (eq (nth 1 (car file-notify--pending-event)) + 'moved-from) + (not (eq action 'moved-to))) + ;; w32notify. + (and (eq (nth 1 (car file-notify--pending-event)) + 'renamed-from) + (not (eq action 'renamed-to))))) + (setq pending-event file-notify--pending-event + file-notify--pending-event nil) + (setcar (cdar pending-event) 'deleted)) + + ;; Map action. We ignore all events which cannot be mapped. + (setq action + (cond + ((memq action + '(attribute-changed changed created deleted renamed)) + action) + ((memq action '(moved rename)) + ;; The kqueue rename event does not return file1 in + ;; case a file monitor is established. + (if (setq file1 (file-notify--event-file1-name event)) + 'renamed 'deleted)) + ((eq action 'ignored) + (setq stopped t actions nil)) + ((memq action '(attrib link)) 'attribute-changed) + ((memq action '(create added)) 'created) + ((memq action '(modify modified write)) 'changed) + ((memq action '(delete delete-self move-self removed)) 'deleted) + ;; Make the event pending. + ((memq action '(moved-from renamed-from)) + (setq file-notify--pending-event + `((,desc ,action ,file ,(file-notify--event-cookie event)) + ,(file-notify--watch-callback watch))) + nil) + ;; Look for pending event. + ((memq action '(moved-to renamed-to)) + (if (null file-notify--pending-event) + 'created + (setq file1 file + file (file-notify--event-file-name + (car file-notify--pending-event))) + ;; If the source is handled by another watch, we + ;; must fire the rename event there as well. + (when (not (equal desc (caar file-notify--pending-event))) + (setq pending-event + `((,(caar file-notify--pending-event) + renamed ,file ,file1) + ,(cadr file-notify--pending-event)))) + (setq file-notify--pending-event nil) + 'renamed)))) + + ;; Apply pending callback. + (when pending-event + (setcar + (car pending-event) + (caar pending-event)) + (funcall (cadr pending-event) (car pending-event)) + (setq pending-event nil)) + + ;; Apply callback. + (when (and action + (or + ;; If there is no relative file name for that watch, + ;; we watch the whole directory. + (null (file-notify--watch-filename watch)) + ;; File matches. + (string-equal + (file-notify--watch-filename watch) + (file-name-nondirectory file)) + ;; Directory matches. + (string-equal + (file-name-nondirectory file) + (file-name-nondirectory + (file-notify--watch-directory watch))) + ;; File1 matches. + (and (stringp file1) + (string-equal + (file-notify--watch-filename watch) + (file-name-nondirectory file1))))) + ;;(message + ;;"file-notify-callback %S %S %S %S %S" + ;;desc + ;;action file file1 watch) + (if file1 + (funcall (file-notify--watch-callback watch) + `(,desc ,action ,file ,file1)) + (funcall (file-notify--watch-callback watch) + `(,desc ,action ,file)))) + + ;; Send `stopped' event. + (when (or stopped + (and (memq action '(deleted renamed)) + ;; Not, when a file is backed up. + (not (and (stringp file1) (backup-file-name-p file1))) + ;; Watched file or directory is concerned. + (string-equal + file (file-notify--event-watched-file event)))) + (file-notify-rm-watch desc))))))) ;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor ;; for every `file-notify-add-watch', while `inotify' returns a unique @@ -339,7 +313,7 @@ FILE is the name of the file whose event is being reported." (if (file-directory-p file) file (file-name-directory file)))) - desc func l-flags registered entry) + desc func l-flags) (unless (file-directory-p dir) (signal 'file-notify-error `("Directory does not exist" ,dir))) @@ -391,66 +365,46 @@ FILE is the name of the file whose event is being reported." l-flags 'file-notify-callback))) ;; Modify `file-notify-descriptors'. - (setq file (unless (file-directory-p file) (file-name-nondirectory file)) - desc (if (consp desc) (car desc) desc) - registered (gethash desc file-notify-descriptors) - entry `(,file . ,callback)) - (unless (member entry (cdr registered)) - (puthash desc `(,dir ,entry . ,(cdr registered)) file-notify-descriptors)) - + (let ((watch (file-notify--watch-make + dir + (unless (file-directory-p file) (file-name-nondirectory file)) + callback))) + (puthash desc watch file-notify-descriptors)) ;; Return descriptor. - (file-notify--descriptor desc file))) + desc)) (defun file-notify-rm-watch (descriptor) "Remove an existing watch specified by its DESCRIPTOR. DESCRIPTOR should be an object returned by `file-notify-add-watch'." - (let* ((desc (if (consp descriptor) (car descriptor) descriptor)) - (file (if (consp descriptor) (cdr descriptor))) - (registered (gethash desc file-notify-descriptors)) - (dir (car registered)) - (handler (and (stringp dir) - (find-file-name-handler dir 'file-notify-rm-watch)))) - - (when (stringp dir) - ;; Call low-level function. - (when (or (not file) - (and (= (length (cdr registered)) 1) - (assoc file (cdr registered)))) - (condition-case nil - (if handler - ;; A file name handler could exist even if there is no local - ;; file notification support. - (funcall handler 'file-notify-rm-watch descriptor) - - (funcall - (cond - ((eq file-notify--library 'inotify) 'inotify-rm-watch) - ((eq file-notify--library 'kqueue) 'kqueue-rm-watch) - ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch) - ((eq file-notify--library 'w32notify) 'w32notify-rm-watch)) - desc)) - (file-notify-error nil))) - - ;; Modify `file-notify-descriptors'. - (file-notify--rm-descriptor descriptor)))) + (when-let (watch (gethash descriptor file-notify-descriptors)) + (let ((handler (find-file-name-handler + (file-notify--watch-directory watch) + 'file-notify-rm-watch))) + (condition-case nil + (if handler + ;; A file name handler could exist even if there is no local + ;; file notification support. + (funcall handler 'file-notify-rm-watch descriptor) + + (funcall + (cond + ((eq file-notify--library 'inotify) 'inotify-rm-watch) + ((eq file-notify--library 'kqueue) 'kqueue-rm-watch) + ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch) + ((eq file-notify--library 'w32notify) 'w32notify-rm-watch)) + descriptor)) + (file-notify-error nil))) + ;; Modify `file-notify-descriptors'. + (file-notify--rm-descriptor descriptor))) (defun file-notify-valid-p (descriptor) "Check a watch specified by its DESCRIPTOR. DESCRIPTOR should be an object returned by `file-notify-add-watch'." - (let* ((desc (if (consp descriptor) (car descriptor) descriptor)) - (file (if (consp descriptor) (cdr descriptor))) - (registered (gethash desc file-notify-descriptors)) - (dir (car registered)) - handler) - - (when (stringp dir) - (setq handler (find-file-name-handler dir 'file-notify-valid-p)) - - (and (or ;; It is a directory. - (not file) - ;; The file is registered. - (assoc file (cdr registered))) - (if handler + (when-let (watch (gethash descriptor file-notify-descriptors)) + (let ((handler (find-file-name-handler + (file-notify--watch-directory watch) + 'file-notify-valid-p))) + (and (if handler ;; A file name handler could exist even if there is no ;; local file notification support. (funcall handler 'file-notify-valid-p descriptor) @@ -460,9 +414,19 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." ((eq file-notify--library 'kqueue) 'kqueue-valid-p) ((eq file-notify--library 'gfilenotify) 'gfile-valid-p) ((eq file-notify--library 'w32notify) 'w32notify-valid-p)) - desc)) + descriptor)) t)))) + +;; TODO: +;; * Watching a /dir/file may receive events for dir. +;; (This may be the desired behaviour.) +;; * Watching a file in a already watched directory +;; If the file is created and *then* a watch is added to that file, the +;; watch might receive events which occured prior to it being created, +;; due to the way events are propagated during idle time. Note: This +;; may be perfectly acceptable. + ;; The end: (provide 'filenotify) diff --git a/src/inotify.c b/src/inotify.c index 61ef615328..a084552adc 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -41,23 +41,30 @@ 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) /* File handle for inotify. */ static int inotifyfd = -1; -/* Assoc list of files being watched. - Format: (watch-descriptor name callback) +/* 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. + + For the same reason, we also need to store the watch's mask and we + can't allow the following flags to be used. + + IN_EXCL_UNLINK + IN_MASK_ADD + IN_ONESHOT + IN_ONLYDIR + + Format: (descriptor . ((id filename callback mask) ...)) */ static Lisp_Object watch_list; static Lisp_Object -make_watch_descriptor (int wd) -{ - /* TODO replace this with a Misc Object! */ - return make_number (wd); -} - -static Lisp_Object mask_to_aspects (uint32_t mask) { Lisp_Object aspects = Qnil; if (mask & IN_ACCESS) @@ -95,77 +102,6 @@ mask_to_aspects (uint32_t mask) { return aspects; } -static Lisp_Object -inotifyevent_to_event (Lisp_Object watch_object, struct inotify_event const *ev) -{ - Lisp_Object name = Qnil; - if (ev->len > 0) - { - size_t const len = strlen (ev->name); - name = make_unibyte_string (ev->name, min (len, ev->len)); - name = DECODE_FILE (name); - } - else - name = XCAR (XCDR (watch_object)); - - return list2 (list4 (make_watch_descriptor (ev->wd), - mask_to_aspects (ev->mask), - name, - make_number (ev->cookie)), - Fnth (make_number (2), watch_object)); -} - -/* This callback is called when the FD is available for read. The inotify - events are read from FD and converted into input_events. */ -static void -inotify_callback (int fd, void *_) -{ - struct input_event event; - Lisp_Object watch_object; - int to_read; - char *buffer; - ssize_t n; - size_t i; - - to_read = 0; - if (ioctl (fd, FIONREAD, &to_read) == -1) - report_file_notify_error ("Error while retrieving file system events", - Qnil); - buffer = xmalloc (to_read); - n = read (fd, buffer, to_read); - if (n < 0) - { - xfree (buffer); - report_file_notify_error ("Error while reading file system events", Qnil); - } - - EVENT_INIT (event); - event.kind = FILE_NOTIFY_EVENT; - - i = 0; - while (i < (size_t)n) - { - struct inotify_event *ev = (struct inotify_event *) &buffer[i]; - - watch_object = Fassoc (make_watch_descriptor (ev->wd), watch_list); - if (!NILP (watch_object)) - { - event.arg = inotifyevent_to_event (watch_object, ev); - - /* If event was removed automatically: Drop it from watch list. */ - if (ev->mask & IN_IGNORED) - watch_list = Fdelete (watch_object, watch_list); - - if (!NILP (event.arg)) - kbd_buffer_store_event (&event); - } - - i += sizeof (*ev) + ev->len; - } - - xfree (buffer); -} - static uint32_t symbol_to_inotifymask (Lisp_Object symb) { @@ -200,14 +136,6 @@ symbol_to_inotifymask (Lisp_Object symb) else if (EQ (symb, Qdont_follow)) return IN_DONT_FOLLOW; - else if (EQ (symb, Qexcl_unlink)) - return IN_EXCL_UNLINK; - else if (EQ (symb, Qmask_add)) - return IN_MASK_ADD; - else if (EQ (symb, Qoneshot)) - return IN_ONESHOT; - else if (EQ (symb, Qonlydir)) - return IN_ONLYDIR; else if (EQ (symb, Qt) || EQ (symb, Qall_events)) return IN_ALL_EVENTS; @@ -236,6 +164,174 @@ aspect_to_inotifymask (Lisp_Object aspect) return symbol_to_inotifymask (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; + + if (! lispy_mask_match_p (Fnth (make_number (3), watch), ev->mask)) + return Qnil; + + if (ev->len > 0) + { + size_t const len = strlen (ev->name); + name = make_unibyte_string (ev->name, min (len, ev->len)); + name = DECODE_FILE (name); + } + else + name = XCAR (XCDR (watch)); + + return list2 (list4 (Fcons (make_number (ev->wd), XCAR (watch)), + mask_to_aspects (ev->mask), + name, + make_number (ev->cookie)), + Fnth (make_number (2), watch)); +} + +/* Add a new watch to watch-descriptor WD watching FILENAME and using + CALLBACK. Returns a cons (DESCRIPTOR . ID) uniquely identifying the + new watch. */ +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 watch, watch_id; + Lisp_Object mask = make_lispy_mask (aspect_to_inotifymask (aspect)); + + int id = 0; + + while (! NILP (watches)) + { + id = max (id, 1 + XINT (XCAR (XCAR (watches)))); + watches = XCDR (watches); + } + + 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))); + + 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. */ +static void +remove_descriptor (Lisp_Object descriptor, bool invalid_p) +{ + Lisp_Object elt = Fassoc (descriptor, watch_list); + + if (! NILP (elt)) + { + int wd = XINT (descriptor); + + 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); + } + /* Cleanup if no more files are watched. */ + if (NILP (watch_list)) + { + emacs_close (inotifyfd); + delete_read_fd (inotifyfd); + inotifyfd = -1; + } +} + +/* Remove watch associated with (descriptor, id). */ +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); + } +} + +/* This callback is called when the FD is available for read. The inotify + events are read from FD and converted into input_events. */ +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) + report_file_notify_error ("Error while retrieving file system events", + Qnil); + buffer = xmalloc (to_read); + n = read (fd, buffer, to_read); + if (n < 0) + { + xfree (buffer); + report_file_notify_error ("Error while reading file system events", Qnil); + } + + EVENT_INIT (event); + event.kind = FILE_NOTIFY_EVENT; + + i = 0; + while (i < (size_t)n) + { + struct inotify_event *ev = (struct inotify_event *) &buffer[i]; + Lisp_Object descriptor = make_number (ev->wd); + Lisp_Object elt = Fassoc (descriptor, watch_list); + + if (! NILP (elt)) + { + Lisp_Object watches = XCDR (elt); + while (! NILP (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); + } + i += sizeof (*ev) + ev->len; + } + + xfree (buffer); +} + DEFUN ("inotify-add-watch", Finotify_add_watch, Sinotify_add_watch, 3, 3, 0, doc: /* Add a watch for FILE-NAME to inotify. @@ -264,10 +360,6 @@ close The following symbols can also be added to a list of aspects: dont-follow -excl-unlink -mask-add -oneshot -onlydir Watching a directory is not recursive. CALLBACK is passed a single argument EVENT which contains an event structure of the format @@ -286,22 +378,22 @@ unmount If a directory is watched then NAME is the name of file that caused the event. -COOKIE is an object that can be compared using `equal' to identify two matching +COOKIE is an object that can be compared using `equal' to identify two matchingt renames (moved-from and moved-to). See inotify(7) and inotify_add_watch(2) for further information. The inotify fd is managed internally and there is no corresponding inotify_init. Use `inotify-rm-watch' to remove a watch. - */) - (Lisp_Object file_name, Lisp_Object aspect, Lisp_Object callback) + */) + (Lisp_Object filename, Lisp_Object aspect, Lisp_Object callback) { - uint32_t mask; - Lisp_Object watch_object; Lisp_Object encoded_file_name; - Lisp_Object watch_descriptor; - int watchdesc = -1; + bool dont_follow = ! NILP (Fmemq (Qdont_follow, aspect)); + int wd = -1; + uint32_t mask = (INOTIFY_DEFAULT_MASK + | (dont_follow ? IN_DONT_FOLLOW : 0)); - CHECK_STRING (file_name); + CHECK_STRING (filename); if (inotifyfd < 0) { @@ -312,24 +404,12 @@ is managed internally and there is no corresponding inotify_init. Use add_read_fd (inotifyfd, &inotify_callback, NULL); } - mask = aspect_to_inotifymask (aspect); - encoded_file_name = ENCODE_FILE (file_name); - watchdesc = inotify_add_watch (inotifyfd, SSDATA (encoded_file_name), mask); - if (watchdesc == -1) - report_file_notify_error ("Could not add watch for file", file_name); - - watch_descriptor = make_watch_descriptor (watchdesc); + encoded_file_name = ENCODE_FILE (filename); + wd = inotify_add_watch (inotifyfd, SSDATA (encoded_file_name), mask); + if (wd == -1) + report_file_notify_error ("Could not add watch for file", filename); - /* Delete existing watch object. */ - watch_object = Fassoc (watch_descriptor, watch_list); - if (!NILP (watch_object)) - watch_list = Fdelete (watch_object, watch_list); - - /* Store watch object in watch list. */ - watch_object = list3 (watch_descriptor, encoded_file_name, callback); - watch_list = Fcons (watch_object, watch_list); - - return watch_descriptor; + return add_watch (wd, filename, aspect, callback); } DEFUN ("inotify-rm-watch", Finotify_rm_watch, Sinotify_rm_watch, 1, 1, 0, @@ -338,27 +418,20 @@ DEFUN ("inotify-rm-watch", Finotify_rm_watch, Sinotify_rm_watch, 1, 1, 0, WATCH-DESCRIPTOR should be an object returned by `inotify-add-watch'. See inotify_rm_watch(2) for more information. - */) + */) (Lisp_Object watch_descriptor) { - Lisp_Object watch_object; - int wd = XINT (watch_descriptor); - if (inotify_rm_watch (inotifyfd, wd) == -1) - report_file_notify_error ("Could not rm watch", watch_descriptor); + Lisp_Object descriptor, id; - /* Remove watch descriptor from watch list. */ - watch_object = Fassoc (watch_descriptor, watch_list); - if (!NILP (watch_object)) - watch_list = Fdelete (watch_object, watch_list); + if (! (CONSP (watch_descriptor) + && INTEGERP (XCAR (watch_descriptor)) + && INTEGERP (XCDR (watch_descriptor)))) + report_file_notify_error ("Invalid descriptor ", watch_descriptor); - /* Cleanup if no more files are watched. */ - if (NILP (watch_list)) - { - emacs_close (inotifyfd); - delete_read_fd (inotifyfd); - inotifyfd = -1; - } + descriptor = XCAR (watch_descriptor); + id = XCDR (watch_descriptor); + remove_watch (descriptor, id); return Qt; } @@ -374,10 +447,33 @@ reason. Removing the watch by calling `inotify-rm-watch' also makes it invalid. */) (Lisp_Object watch_descriptor) { - Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list); - return NILP (watch_object) ? Qnil : Qt; + Lisp_Object elt, watch; + + if (! (CONSP (watch_descriptor) + && INTEGERP (XCAR (watch_descriptor)) + && INTEGERP (XCDR (watch_descriptor)))) + return Qnil; + + elt = Fassoc (XCAR (watch_descriptor), watch_list); + watch = Fassoc (XCDR (watch_descriptor), XCDR (elt)); + + return ! NILP (watch) ? Qt : Qnil; +} + +#ifdef INOTIFY_DEBUG +DEFUN ("inotify-watch-list", Finotify_watch_list, Sinotify_watch_list, 0, 0, 0, + doc: /* Return a copy of the internal watch_list. */) +{ + return Fcopy_sequence (watch_list); } +DEFUN ("inotify-allocated-p", Finotify_allocated_p, Sinotify_allocated_p, 0, 0, 0, + doc: /* Return non-nil, if a inotify instance is allocated. */) +{ + return inotifyfd < 0 ? Qnil : Qt; +} +#endif + void syms_of_inotify (void) { @@ -400,10 +496,6 @@ syms_of_inotify (void) DEFSYM (Qclose, "close"); /* IN_CLOSE */ DEFSYM (Qdont_follow, "dont-follow"); /* IN_DONT_FOLLOW */ - DEFSYM (Qexcl_unlink, "excl-unlink"); /* IN_EXCL_UNLINK */ - DEFSYM (Qmask_add, "mask-add"); /* IN_MASK_ADD */ - DEFSYM (Qoneshot, "oneshot"); /* IN_ONESHOT */ - DEFSYM (Qonlydir, "onlydir"); /* IN_ONLYDIR */ DEFSYM (Qignored, "ignored"); /* IN_IGNORED */ DEFSYM (Qisdir, "isdir"); /* IN_ISDIR */ @@ -414,6 +506,10 @@ syms_of_inotify (void) defsubr (&Sinotify_rm_watch); defsubr (&Sinotify_valid_p); +#ifdef INOTIFY_DEBUG + defsubr (&Sinotify_watch_list); + defsubr (&Sinotify_allocated_p); +#endif staticpro (&watch_list); Fprovide (intern_c_string ("inotify"), Qnil); diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 329ea58d3b..54e7ebfc0e 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -350,11 +350,6 @@ This returns only for the local case and gfilenotify; otherwise it is nil. ;; This test is inspired by Bug#26126 and Bug#26127. (ert-deftest file-notify-test02-rm-watch () "Check `file-notify-rm-watch'." - ;; There is a problem with inotify removing watch descriptors out of - ;; order. Temporarily, we expect to fail this test until it is - ;; fixed. - :expected-result - (if (string-equal (file-notify--test-library) "inotify") :failed :passed) (skip-unless (file-notify--test-local-enabled)) (unwind-protect commit 9278d904af13c3c083defdcbf5fa21260d4457c3 Author: Paul Pogonyshev Date: Sun Mar 19 22:54:43 2017 +0100 * lisp/emacs-lisp/pcase.el (pcase): Comment debug message (Bug#26177). diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 289265abf2..fc5474ecc4 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -175,8 +175,8 @@ Emacs Lisp manual for more information and examples." ;; (when (gethash (car cases) pcase--memoize-2) ;; (message "pcase-memoize failed because of eq test on %S" ;; (car cases))) - (when data - (message "pcase-memoize: equal first branch, yet different")) + ;; (when data + ;; (message "pcase-memoize: equal first branch, yet different")) (let ((expansion (pcase--expand exp cases))) (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize) ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-1) commit 5f6ef7cba8200d19198e42a9a76fef1618b5f233 Author: Jens Uwe Schmidt Date: Sun May 29 20:09:41 2016 +0200 Stop edebug getting stuck on backquote (Bug#23651) * lisp/emacs-lisp/edebug.el (edebug-read-sexp): Move forward after reading backquote or comma. Copyright-paperwork-exempt: yes diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 6013305562..4116e31d0a 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -733,9 +733,9 @@ Maybe clear the markers and delete the symbol's edebug property?" ((eq class 'string) (read (current-buffer))) ((eq class 'quote) (forward-char 1) (list 'quote (edebug-read-sexp))) - ((eq class 'backquote) + ((eq class 'backquote) (forward-char 1) (list '\` (edebug-read-sexp))) - ((eq class 'comma) + ((eq class 'comma) (forward-char 1) (list '\, (edebug-read-sexp))) (t ; anything else, just read it. (read (current-buffer)))))) commit 0a911b68eae3e295139609b1ad94b70a4d421f9b Author: Eric Abrahamsen Date: Fri Mar 24 12:10:06 2017 -0700 Expand manual section on quitting windows * doc/lispref/windows.texi (Quitting Windows): Provide more information about the elements of the quit-restore window parameter, and how they affect the behavior of quit-restore-window. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index a4f8400170..6aa9591e09 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2803,12 +2803,13 @@ put it in the selected window. @section Window History @cindex window history -Each window remembers in a list the buffers it has previously displayed, -and the order in which these buffers were removed from it. This history -is used, for example, by @code{replace-buffer-in-windows} -(@pxref{Buffers and Windows}). The list is automatically maintained by -Emacs, but you can use the following functions to explicitly inspect or -alter it: +Each window remembers in a list the buffers it has previously +displayed, and the order in which these buffers were removed from it. +This history is used, for example, by @code{replace-buffer-in-windows} +(@pxref{Buffers and Windows}), and when quitting windows +(@pxref{Quitting Windows}). The list is automatically maintained by +Emacs, but you can use the following functions to explicitly inspect +or alter it: @defun window-prev-buffers &optional window This function returns a list specifying the previous contents of @@ -2994,33 +2995,35 @@ described next to deal with the window and its buffer. @end deffn @defun quit-restore-window &optional window bury-or-kill -This function tries to restore the state of @var{window} that existed -before its buffer was displayed in it. The optional argument -@var{window} must be a live window and defaults to the selected one. +This function handles @var{window} and its buffer after quitting. The +optional argument @var{window} must be a live window and defaults to +the selected one. The function's behavior is determined by the four +elements of the @code{quit-restore} window parameter (@pxref{Window +Parameters}), which is set to nil afterwards. + +The window is deleted entirely if: 1) the first element of the +@code{quit-restore} parameter is one of 'window or 'frame, 2) the +window has no history of previously-displayed buffers, and 3) the +displayed buffer matches the one in the fourth element of the +@code{quit-restore} parameter. If @var{window} is the +only window on its frame and there are other frames on the frame's +terminal, the value of the optional argument @var{bury-or-kill} +determines how to proceed with the window. If @var{bury-or-kill} +equals @code{kill}, the frame is deleted unconditionally. Otherwise, +the fate of the frame is determined by calling +@code{frame-auto-hide-function} (see below) with that frame as sole +argument. -If @var{window} was created specially for displaying its buffer, this -function deletes @var{window} provided its frame contains at least one -other live window. If @var{window} is the only window on its frame and -there are other frames on the frame's terminal, the value of the -optional argument @var{bury-or-kill} determines how to proceed with the -window. If @var{bury-or-kill} equals @code{kill}, the frame is deleted -unconditionally. Otherwise, the fate of the frame is determined by -calling @code{frame-auto-hide-function} (see below) with that frame as -sole argument. - -Otherwise, this function tries to redisplay the buffer previously shown -in @var{window}. It also tries to restore the window start -(@pxref{Window Start and End}) and point (@pxref{Window Point}) -positions of the previously shown buffer. If, in addition, +If the third element of the @code{quit-restore} parameter is a list of +buffer, window start (@pxref{Window Start and End}), and point +(@pxref{Window Point}), and that buffer is still live, the buffer will +be displayed, and start and point set accordingly. If, in addition, @var{window}'s buffer was temporarily resized, this function will also try to restore the original height of @var{window}. -The cases described so far require that the buffer shown in @var{window} -is still the buffer displayed by the last buffer display function for -this window. If another buffer has been shown in the meantime, or the -buffer previously shown no longer exists, this function calls -@code{switch-to-prev-buffer} (@pxref{Window History}) to show some other -buffer instead. +Otherwise, if @var{window} was previously used for displaying other +buffers (@pxref{Window History}), the most recent buffer in that +history will be displayed. The optional argument @var{bury-or-kill} specifies how to deal with @var{window}'s buffer. The following values are handled: @@ -3048,9 +3051,24 @@ buffer again without killing the buffer. This means to kill @var{window}'s buffer. @end table -@code{quit-restore-window} bases its decisions on information stored in -@var{window}'s @code{quit-restore} window parameter (@pxref{Window -Parameters}), and resets that parameter to @code{nil} after it's done. +Typically, the display routines run by @code{display-buffer} will set +the @code{quit-restore} window parameter correctly. It's also +possible to set it manually, using the following code for displaying +@var{buffer} in @var{window}: + +@example +@group +(display-buffer-record-window type window buffer) + +(set-window-buffer window buffer) + +(set-window-prev-buffers window nil) +@end group +@end example + +Setting the window history to nil ensures that a future call to +@code{quit-window} can delete the window altogether. + @end defun The following option specifies how to deal with a frame containing just @@ -4845,25 +4863,32 @@ This parameter is installed by the buffer display functions (@pxref{Choosing Window}) and consulted by @code{quit-restore-window} (@pxref{Quitting Windows}). It contains four elements: -The first element is one of the symbols @code{window}, meaning that the -window has been specially created by @code{display-buffer}; @code{frame}, -a separate frame has been created; @code{same}, the window has -displayed the same buffer before; or @code{other}, the window showed -another buffer before. +The first element is one of the symbols @code{window}, meaning that +the window has been specially created by @code{display-buffer}; +@code{frame}, a separate frame has been created; @code{same}, the +window has only ever displayed this buffer; or @code{other}, the +window showed another buffer before. @code{frame} and @code{window} +affect how the window is quit, while @code{same} and @code{other} +affect the redisplay of buffers previously shown in this window. The second element is either one of the symbols @code{window} or @code{frame}, or a list whose elements are the buffer shown in the window before, that buffer's window start and window point positions, -and the window's height at that time. +and the window's height at that time. If that buffer is still live +when the window is quit, then the function @code{quit-restore-window} +reuses the window to display the buffer. The third element is the window selected at the time the parameter was -created. The function @code{quit-restore-window} tries to reselect that -window when it deletes the window passed to it as argument. +created. If @code{quit-restore-window} deletes the window passed to +it as argument, it then tries to reselect this window. The fourth element is the buffer whose display caused the creation of this parameter. @code{quit-restore-window} deletes the specified window only if it still shows that buffer. +See the description of @code{quit-restore-window} in @ref{Quitting +Windows} for details. + @item @code{window-side} @code{window-slot} These parameters are used for implementing side windows (@pxref{Side Windows}). @@ -4894,9 +4919,6 @@ applications. It might be replaced by an improved solution in future versions of Emacs. @end table -The @code{window-atom} parameter is used for implementing atomic windows. - - @node Window Hooks @section Hooks for Window Scrolling and Changes @cindex hooks for window operations commit 501d07981ed1840ae72fe7dd599ab0b9f85b4a7f Author: Eli Zaretskii Date: Sat Mar 25 19:12:07 2017 +0300 Support in ispell.el multiple dictionaries loaded by Hunspell * lisp/textmodes/ispell.el (ispell-find-hunspell-dictionaries): Support Hunspell configurations that load more than one dictionary by default. Doc fix. (Bug#25830) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 9747bd6cc1..db733fe661 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1094,10 +1094,10 @@ in the list must have an affix file where Hunspell affix files are kept." (defun ispell-find-hunspell-dictionaries () "Look for installed Hunspell dictionaries. -Will initialize `ispell-hunspell-dictionary-alist' and -`ispell-hunspell-dictionary-alist' after values found -and remove `ispell-dicts-name2locale-equivs-alist' -entries if a specific dictionary was found." +Will initialize `ispell-hunspell-dictionary-alist' according +to dictionaries found, and will remove aliases from the list +in `ispell-dicts-name2locale-equivs-alist' if an explicit +dictionary from that list was found." (let ((hunspell-found-dicts (split-string (with-temp-buffer @@ -1110,18 +1110,27 @@ entries if a specific dictionary was found." "[\n\r]+" t)) hunspell-default-dict - hunspell-default-dict-entry) + hunspell-default-dict-entry + hunspell-multi-dict) (dolist (dict hunspell-found-dicts) (let* ((full-name (file-name-nondirectory dict)) (basename (file-name-sans-extension full-name)) (affix-file (concat dict ".aff"))) (if (string-match "\\.aff$" dict) ;; Found default dictionary - (if hunspell-default-dict - (error "ispell-fhd: Default dict already defined as %s. Not using %s.\n" - hunspell-default-dict dict) - (setq affix-file dict) - (setq hunspell-default-dict (list basename affix-file))) + (progn + (if hunspell-default-dict + (setq hunspell-multi-dict + (concat (or hunspell-multi-dict + (car hunspell-default-dict)) + "," basename)) + (setq affix-file dict) + ;; FIXME: The cdr of the list we cons below is never + ;; used. Why do we need a list? + (setq hunspell-default-dict (list basename affix-file))) + (ispell-print-if-debug + "++ ispell-fhd: default dict-entry:%s name:%s basename:%s\n" + dict full-name basename)) (if (and (not (assoc basename ispell-hunspell-dict-paths-alist)) (file-exists-p affix-file)) ;; Entry has an associated .aff file and no previous value. @@ -1161,7 +1170,8 @@ entries if a specific dictionary was found." (cl-pushnew (list dict-equiv-key affix-file) ispell-hunspell-dict-paths-alist :test #'equal))))) ;; Parse and set values for default dictionary. - (setq hunspell-default-dict (car hunspell-default-dict)) + (setq hunspell-default-dict (or hunspell-multi-dict + (car hunspell-default-dict))) (setq hunspell-default-dict-entry (ispell-parse-hunspell-affix-file hunspell-default-dict)) ;; Create an alist of found dicts with only names, except for default dict. commit 541e950bdb495ea63420dcf80727cd0075d62e04 Author: Michael Albinus Date: Sat Mar 25 15:42:39 2017 +0100 Simplify Tramp autoloading. * lisp/net/tramp.el (tramp-completion-file-name-handler): Simplify autoloading. Give it the `operations' property. (tramp-completion-handle-expand-file-name): Remove. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index a9254693ad..a7c36c09e0 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1055,8 +1055,7 @@ means to use always cached values for the directory contents." ;;;###autoload (defconst tramp-completion-file-name-handler-alist - '(;(expand-file-name . tramp-completion-handle-expand-file-name) - (file-name-all-completions + '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) (file-name-completion . tramp-completion-handle-file-name-completion)) "Alist of completion handler functions. @@ -2113,20 +2112,7 @@ preventing reentrant calls of Tramp.") Together with `tramp-locked', this implements a locking mechanism preventing reentrant calls of Tramp.") -;; Avoid recursive loading of tramp.el. -;; FIXME: This must go better. Checking for `operation' is wrong. -;;;###autoload(defun tramp-completion-file-name-handler (operation &rest args) -;;;###autoload (let ((fn -;;;###autoload (assoc -;;;###autoload operation tramp-completion-file-name-handler-alist))) -;;;###autoload (if (and -;;;###autoload tramp-mode fn (null load-in-progress) -;;;###autoload (member -;;;###autoload operation -;;;###autoload '(file-name-all-completions file-name-completion))) -;;;###autoload (apply 'tramp-autoload-file-name-handler operation args) -;;;###autoload (tramp-run-real-handler operation args)))) - +;;;###autoload (defun tramp-completion-file-name-handler (operation &rest args) "Invoke Tramp file name completion handler. Falls back to normal file name handler if no Tramp file name handler exists." @@ -2135,6 +2121,11 @@ Falls back to normal file name handler if no Tramp file name handler exists." (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args)))) +;; Mark `operations' the handler is responsible for. +;;;###autoload +(put 'tramp-completion-file-name-handler 'operations + (mapcar 'car tramp-completion-file-name-handler-alist)) + ;;;###autoload (progn (defun tramp-autoload-file-name-handler (operation &rest args) "Load Tramp file name handler, and perform OPERATION." @@ -2258,15 +2249,6 @@ not in completion mode." (tramp-get-connection-process (tramp-dissect-file-name filename))))))) -(defun tramp-completion-handle-expand-file-name (name &optional dir) - "Like `expand-file-name' for Tramp files." - ;; If DIR is not given, use `default-directory' or "/". - (setq dir (or dir default-directory "/")) - (cond - ((file-name-absolute-p name) name) - ((zerop (length name)) dir) - (t (concat (file-name-as-directory dir) name)))) - ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of ;; tramp-file-name structures. For all of them we return possible completions. commit 8275687bb908174b84021ee15ecd959733cecb9d Author: Eli Zaretskii Date: Sat Mar 25 16:59:17 2017 +0300 Fix a segfault due to failure to realize some faces * src/xdisp.c (redisplay_internal): If the frame becomes garbaged while redisplaying its windows, redisplay all of its windows again. (Bug#26097) (init_iterator): When freeing all realized faces on all frames, reset the 'face_change' flag of the frame whose window we are about to iterate. diff --git a/src/xdisp.c b/src/xdisp.c index 8266849492..32550523bc 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2716,6 +2716,7 @@ init_iterator (struct it *it, struct window *w, if (face_change) { face_change = false; + XFRAME (w->frame)->face_change = 0; free_all_realized_faces (Qnil); } else if (XFRAME (w->frame)->face_change) @@ -14072,6 +14073,7 @@ redisplay_internal (void) /* Only GC scrollbars when we redisplay the whole frame. */ = f->redisplay || !REDISPLAY_SOME_P (); bool f_redisplay_flag = f->redisplay; + bool f_garbaged_flag = FRAME_GARBAGED_P (f); /* Mark all the scroll bars to be removed; we'll redeem the ones we want when we redisplay their windows. */ if (gcscrollbars && FRAME_TERMINAL (f)->condemn_scroll_bars_hook) @@ -14132,6 +14134,15 @@ redisplay_internal (void) Therefore, we must redisplay this frame. */ if (!f_redisplay_flag && f->redisplay) goto retry_frame; + /* Likewise with the frame's garbaged flag: it can + get set inside redisplay_windows if some hook + winds up calling adjust_frame_glyphs, for example. */ + if (!f_garbaged_flag && FRAME_GARBAGED_P (f)) + { + f->garbaged = false; + fset_redisplay (f); + goto retry_frame; + } /* In some case (e.g., window resize), we notice only during window updating that the window commit 1531c3c9f2844ba992f02ec62cc57f782d073c65 Author: Philipp Stephani Date: Sat Mar 25 13:04:13 2017 +0100 Use a named function for 'safe-local-variable This improves the help screen for `version-control' (Bug#25431). * lisp/files.el (version-control-safe-local-p): New function. (version-control): Use it. diff --git a/lisp/files.el b/lisp/files.el index 0a023a88b1..b4872e46b0 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -279,8 +279,13 @@ The value `never' means do not make them." (const :tag "If existing" nil) (other :tag "Always" t)) :group 'backup) + +(defun version-control-safe-local-p (x) + "Return whether X is safe as local value for `version-control'." + (or (booleanp x) (equal x 'never))) + (put 'version-control 'safe-local-variable - (lambda (x) (or (booleanp x) (equal x 'never)))) + #'version-control-safe-local-p) (defcustom dired-kept-versions 2 "When cleaning directory, number of versions to keep."