diff options
| author | Mattias EngdegÄrd | 2019-05-19 11:45:38 +0200 |
|---|---|---|
| committer | Mattias EngdegÄrd | 2019-07-24 11:53:47 +0200 |
| commit | 5a80a9ded16b835ce42c5f4d2e3a5e711f7726cf (patch) | |
| tree | 041d68075d5dd15906593dc98898de7704a8f3c1 | |
| parent | 3a764848650365a9794839c5e98fa74bceb76c47 (diff) | |
| download | emacs-5a80a9ded16b835ce42c5f4d2e3a5e711f7726cf.tar.gz emacs-5a80a9ded16b835ce42c5f4d2e3a5e711f7726cf.zip | |
Refactor the callback half of filenotify.el
Split callback code into backend-specific and general parts. Refactor
pending event, which is always a rename, to include relevant
information only. General clean-up.
* lisp/filenotify.el (file-notify--pending-event): Rename.
(file-notify--event-watched-file, file-notify--event-file-name)
(file-notify--event-file1-name, file-notify--event-cookie): Remove.
(file-notify--rename, file-notify--expand-file-name)
(file-notify--callback-inotify, file-notify--callback-kqueue)
(file-notify--callback-w32notify, file-notify--callback-gfilenotify)
(file-notify--call-handler, file-notify--handle-event): New.
(file-notify-callback): Split general parts into
file-notify--call-handler and file-notify--handle-event.
(file-notify--add-watch-inotify, file-notify--add-watch-kqueue)
(file-notify--add-watch-w32notify)
(file-notify--add-watch-gfilenotify): Use new callbacks.
| -rw-r--r-- | lisp/filenotify.el | 372 |
1 files changed, 210 insertions, 162 deletions
diff --git a/lisp/filenotify.el b/lisp/filenotify.el index d77046d2871..ba8a9a34802 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el | |||
| @@ -105,175 +105,223 @@ Otherwise, signal a `file-notify-error'." | |||
| 105 | (signal 'file-notify-error | 105 | (signal 'file-notify-error |
| 106 | (cons "Not a valid file-notify event" event)))) | 106 | (cons "Not a valid file-notify event" event)))) |
| 107 | 107 | ||
| 108 | ;; Needed for `inotify' and `w32notify'. In the latter case, COOKIE is nil. | 108 | (defvar file-notify--pending-rename nil |
| 109 | (defvar file-notify--pending-event nil | 109 | "A pending rename event awaiting the destination file name. |
| 110 | "A pending file notification event for a future `renamed' action. | 110 | It is a list on the form (WATCH DESCRIPTOR FROM-FILE COOKIE) or nil, |
| 111 | It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).") | 111 | where COOKIE is a cookie (if used by the back-end) or nil.") |
| 112 | 112 | ||
| 113 | (defun file-notify--event-watched-file (event) | 113 | (defun file-notify--expand-file-name (watch file) |
| 114 | "Return file or directory being watched. | 114 | "Full file name of FILE reported for WATCH." |
| 115 | Could be different from the directory watched by the backend library." | 115 | (directory-file-name |
| 116 | (when-let* ((watch (gethash (car event) file-notify-descriptors))) | 116 | (expand-file-name file (file-notify--watch-directory watch)))) |
| 117 | (file-notify--watch-absolute-filename watch))) | 117 | |
| 118 | 118 | (defun file-notify--callback-inotify (event) | |
| 119 | (defun file-notify--event-file-name (event) | 119 | "Notification callback for inotify." |
| 120 | "Return file name of file notification event, or nil." | 120 | (file-notify--handle-event |
| 121 | (when-let* ((watch (gethash (car event) file-notify-descriptors))) | 121 | (car event) |
| 122 | (directory-file-name | 122 | (delq nil (mapcar (lambda (action) |
| 123 | (expand-file-name | 123 | (cond |
| 124 | (or (and (stringp (nth 2 event)) (nth 2 event)) "") | 124 | ((eq action 'create) 'created) |
| 125 | (file-notify--watch-directory watch))))) | 125 | ((eq action 'modify) 'changed) |
| 126 | 126 | ((eq action 'attrib) 'attribute-changed) | |
| 127 | ;; Only `gfilenotify' could return two file names. | 127 | ((memq action '(delete delete-self move-self)) 'deleted) |
| 128 | (defun file-notify--event-file1-name (event) | 128 | ((eq action 'moved-from) 'renamed-from) |
| 129 | "Return second file name of file notification event, or nil. | 129 | ((eq action 'moved-to) 'renamed-to) |
| 130 | This is available in case a file has been moved." | 130 | ((eq action 'ignored) 'stopped))) |
| 131 | (when-let* ((watch (gethash (car event) file-notify-descriptors))) | 131 | (nth 1 event))) |
| 132 | (and (stringp (nth 3 event)) | 132 | (nth 2 event) |
| 133 | (directory-file-name | 133 | (nth 3 event))) |
| 134 | (expand-file-name | 134 | |
| 135 | (nth 3 event) (file-notify--watch-directory watch)))))) | 135 | (defun file-notify--callback-kqueue (event) |
| 136 | 136 | "Notification callback for kqueue." | |
| 137 | ;; Cookies are offered by `inotify' only. | 137 | (file-notify--handle-event |
| 138 | (defun file-notify--event-cookie (event) | 138 | (car event) |
| 139 | "Return cookie of file notification event, or nil. | 139 | (delq nil (mapcar (lambda (action) |
| 140 | This is available in case a file has been moved." | 140 | (cond |
| 141 | (nth 3 event)) | 141 | ((eq action 'create) 'created) |
| 142 | 142 | ((eq action 'write) 'changed) | |
| 143 | ;; The callback function used to map between specific flags of the | 143 | ((memq action '(attrib link)) 'attribute-changed) |
| 144 | ;; respective file notifications, and the ones we return. | 144 | ((eq action 'delete) 'deleted) |
| 145 | ((eq action 'rename) 'renamed))) | ||
| 146 | (nth 1 event))) | ||
| 147 | (nth 2 event) | ||
| 148 | (nth 3 event))) | ||
| 149 | |||
| 150 | (defun file-notify--callback-w32notify (event) | ||
| 151 | "Notification callback for w32notify." | ||
| 152 | (let ((action (pcase (nth 1 event) | ||
| 153 | ('added 'created) | ||
| 154 | ('modified 'changed) | ||
| 155 | ('removed 'deleted) | ||
| 156 | ('renamed-from 'renamed-from) | ||
| 157 | ('renamed-to 'renamed-to)))) | ||
| 158 | (when action | ||
| 159 | (file-notify--handle-event | ||
| 160 | (car event) | ||
| 161 | (list action) | ||
| 162 | (nth 2 event) | ||
| 163 | (nth 3 event))))) | ||
| 164 | |||
| 165 | (defun file-notify--callback-gfilenotify (event) | ||
| 166 | "Notification callback for gfilenotify." | ||
| 167 | (let ((actions (nth 1 event))) | ||
| 168 | (file-notify--handle-event | ||
| 169 | (car event) | ||
| 170 | (delq nil (mapcar (lambda (action) | ||
| 171 | (cond | ||
| 172 | ((memq action | ||
| 173 | '(created changed attribute-changed deleted)) | ||
| 174 | action) | ||
| 175 | ((eq action 'moved) 'renamed))) | ||
| 176 | (if (consp actions) actions (list actions)))) | ||
| 177 | (nth 2 event) | ||
| 178 | (nth 3 event)))) | ||
| 179 | |||
| 180 | ;; Called by file name handlers to deliver a notification. | ||
| 145 | (defun file-notify-callback (event) | 181 | (defun file-notify-callback (event) |
| 146 | "Handle an EVENT returned from file notification. | 182 | "Handle an EVENT returned from file notification. |
| 147 | EVENT is the cadr of the event in `file-notify-handle-event' | 183 | EVENT is the cadr of the event in `file-notify-handle-event' |
| 148 | \(DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE])." | 184 | \(DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE])." |
| 149 | (let* ((desc (car event)) | 185 | (let ((actions (nth 1 event))) |
| 150 | (watch (gethash desc file-notify-descriptors)) | 186 | (file-notify--handle-event |
| 151 | (actions (nth 1 event)) | 187 | (car event) |
| 152 | (file (file-notify--event-file-name event)) | 188 | ;; File name handlers use gfilenotify or inotify actions. |
| 153 | file1 pending-event stopped) | 189 | (delq nil (mapcar |
| 154 | 190 | (lambda (action) | |
| 155 | ;; Make actions a list. | 191 | (cond |
| 156 | (unless (consp actions) (setq actions (cons actions nil))) | 192 | ;; gfilenotify actions: |
| 157 | 193 | ((memq action '(created changed attribute-changed deleted)) | |
| 194 | action) | ||
| 195 | ((eq action 'moved) 'renamed) | ||
| 196 | ;; inotify actions: | ||
| 197 | ((eq action 'create) 'created) | ||
| 198 | ((eq action 'modify) 'changed) | ||
| 199 | ((eq action 'attrib) 'attribute-changed) | ||
| 200 | ((memq action '(delete delete-self move-self)) 'deleted) | ||
| 201 | ((eq action 'moved-from) 'renamed-from) | ||
| 202 | ((eq action 'moved-to) 'renamed-to) | ||
| 203 | ((eq action 'ignored) 'stopped))) | ||
| 204 | (if (consp actions) actions (list actions)))) | ||
| 205 | (nth 2 event) | ||
| 206 | (nth 3 event)))) | ||
| 207 | |||
| 208 | (defun file-notify--call-handler (watch desc action file file1) | ||
| 209 | "Call the handler of WATCH with the arguments DESC, ACTION, FILE and FILE1." | ||
| 210 | (when (or | ||
| 211 | ;; If there is no relative file name for that | ||
| 212 | ;; watch, we watch the whole directory. | ||
| 213 | (null (file-notify--watch-filename watch)) | ||
| 214 | ;; File matches. | ||
| 215 | (string-equal | ||
| 216 | (file-notify--watch-filename watch) | ||
| 217 | (file-name-nondirectory file)) | ||
| 218 | |||
| 219 | ;; Directory matches. | ||
| 220 | ;; FIXME: What purpose would this condition serve? | ||
| 221 | ;; Doesn't it just slip through events for files | ||
| 222 | ;; having the same name as the last component of the | ||
| 223 | ;; directory of the file that we are really watching? | ||
| 224 | ;;(string-equal | ||
| 225 | ;; (file-name-nondirectory file) | ||
| 226 | ;; (file-name-nondirectory (file-notify--watch-directory watch))) | ||
| 227 | |||
| 228 | ;; File1 matches. | ||
| 229 | (and (stringp file1) | ||
| 230 | (string-equal (file-notify--watch-filename watch) | ||
| 231 | (file-name-nondirectory file1)))) | ||
| 232 | (when file-notify-debug | ||
| 233 | (message | ||
| 234 | "file-notify-callback %S %S %S %S %S %S %S" | ||
| 235 | desc action file file1 watch | ||
| 236 | (file-notify--watch-absolute-filename watch) | ||
| 237 | (file-notify--watch-directory watch))) | ||
| 238 | (funcall (file-notify--watch-callback watch) | ||
| 239 | (if file1 | ||
| 240 | (list desc action file file1) | ||
| 241 | (list desc action file))))) | ||
| 242 | |||
| 243 | (defun file-notify--handle-event (desc actions file file1-or-cookie) | ||
| 244 | "Handle an event returned from file notification. | ||
| 245 | DESC is the back-end descriptor. ACTIONS is a list of: | ||
| 246 | `created' | ||
| 247 | `changed' | ||
| 248 | `attribute-changed' | ||
| 249 | `deleted' | ||
| 250 | `renamed' -- FILE is old name, FILE1-OR-COOKIE is new name or nil | ||
| 251 | `renamed-from' -- FILE is old name, FILE1-OR-COOKIE is cookie or nil | ||
| 252 | `renamed-to' -- FILE is new name, FILE1-OR-COOKIE is cookie or nil | ||
| 253 | `stopped' -- no more events after this should be sent" | ||
| 254 | (let* ((watch (gethash desc file-notify-descriptors)) | ||
| 255 | (file (and watch (file-notify--expand-file-name watch file)))) | ||
| 158 | (when watch | 256 | (when watch |
| 159 | ;; Loop over actions. In fact, more than one action happens only | ||
| 160 | ;; for `inotify' and `kqueue'. | ||
| 161 | (while actions | 257 | (while actions |
| 162 | (let ((action (pop actions))) | 258 | (let ((action (pop actions))) |
| 163 | ;; Send pending event, if it doesn't match. | ||
| 164 | ;; We only handle {renamed,moved}-{from,to} pairs when these | 259 | ;; We only handle {renamed,moved}-{from,to} pairs when these |
| 165 | ;; arrive in order without anything else in-between. | 260 | ;; arrive in order without anything else in-between. |
| 166 | (when (and file-notify--pending-event | 261 | ;; If there is a pending rename that does not match this event, |
| 167 | (or | 262 | ;; then send the former as a deletion (since we don't know the |
| 168 | ;; The cookie doesn't match. | 263 | ;; rename destination). |
| 169 | (not (equal (file-notify--event-cookie | 264 | (when file-notify--pending-rename |
| 170 | (car file-notify--pending-event)) | 265 | (let ((pending-cookie (nth 3 file-notify--pending-rename))) |
| 171 | (file-notify--event-cookie event))) | 266 | (unless (and (equal pending-cookie file1-or-cookie) |
| 172 | ;; inotify. | 267 | (eq action 'renamed-to)) |
| 173 | (and (eq (nth 1 (car file-notify--pending-event)) | 268 | (let* ((pending-watch (car file-notify--pending-rename)) |
| 174 | 'moved-from) | 269 | (callback (file-notify--watch-callback pending-watch)) |
| 175 | (not (eq action 'moved-to))) | 270 | (pending-desc (nth 1 file-notify--pending-rename)) |
| 176 | ;; w32notify. | 271 | (from-file (nth 2 file-notify--pending-rename))) |
| 177 | (and (eq (nth 1 (car file-notify--pending-event)) | 272 | (when callback |
| 178 | 'renamed-from) | 273 | (funcall callback (list pending-desc 'deleted from-file))) |
| 179 | (not (eq action 'renamed-to))))) | 274 | (setq file-notify--pending-rename nil))))) |
| 180 | (setq pending-event file-notify--pending-event | 275 | |
| 181 | file-notify--pending-event nil) | 276 | (let ((file1 nil)) |
| 182 | (setcar (cdar pending-event) 'deleted)) | 277 | (cond |
| 183 | 278 | ((eq action 'renamed) | |
| 184 | ;; Map action. We ignore all events which cannot be mapped. | 279 | ;; A `renamed' event may not have a destination name; |
| 185 | (setq action | 280 | ;; if none, treat it as a deletion. |
| 186 | (cond | 281 | (if file1-or-cookie |
| 187 | ((memq action | 282 | (setq file1 |
| 188 | '(attribute-changed changed created deleted renamed)) | 283 | (file-notify--expand-file-name watch file1-or-cookie)) |
| 189 | action) | 284 | (setq action 'deleted))) |
| 190 | ((memq action '(moved rename)) | 285 | ((eq action 'stopped) |
| 191 | ;; The kqueue rename event does not return file1 in | 286 | (file-notify-rm-watch desc) |
| 192 | ;; case a file monitor is established. | 287 | (setq actions nil) |
| 193 | (if (setq file1 (file-notify--event-file1-name event)) | 288 | (setq action nil)) |
| 194 | 'renamed 'deleted)) | 289 | ;; Make the event pending. |
| 195 | ((eq action 'ignored) | 290 | ((eq action 'renamed-from) |
| 196 | (setq stopped t actions nil)) | 291 | (setq file-notify--pending-rename |
| 197 | ((memq action '(attrib link)) 'attribute-changed) | 292 | (list watch desc file file1-or-cookie)) |
| 198 | ((memq action '(create added)) 'created) | 293 | (setq action nil)) |
| 199 | ((memq action '(modify modified write)) 'changed) | 294 | ;; Look for pending event. |
| 200 | ((memq action '(delete delete-self move-self removed)) | 295 | ((eq action 'renamed-to) |
| 201 | 'deleted) | 296 | (if file-notify--pending-rename |
| 202 | ;; Make the event pending. | 297 | (let ((pending-watch (car file-notify--pending-rename)) |
| 203 | ((memq action '(moved-from renamed-from)) | 298 | (pending-desc (nth 1 file-notify--pending-rename)) |
| 204 | (setq file-notify--pending-event | 299 | (from-file (nth 2 file-notify--pending-rename))) |
| 205 | `((,desc ,action ,file | 300 | (setq file1 file) |
| 206 | ,(file-notify--event-cookie event)) | 301 | (setq file from-file) |
| 207 | ,(file-notify--watch-callback watch))) | ||
| 208 | nil) | ||
| 209 | ;; Look for pending event. | ||
| 210 | ((memq action '(moved-to renamed-to)) | ||
| 211 | (if (null file-notify--pending-event) | ||
| 212 | 'created | ||
| 213 | (setq file1 file | ||
| 214 | file (file-notify--event-file-name | ||
| 215 | (car file-notify--pending-event))) | ||
| 216 | ;; If the source is handled by another watch, we | 302 | ;; If the source is handled by another watch, we |
| 217 | ;; must fire the rename event there as well. | 303 | ;; must fire the rename event there as well. |
| 218 | (unless (equal desc (caar file-notify--pending-event)) | 304 | (let ((callback |
| 219 | (setq pending-event | 305 | (file-notify--watch-callback pending-watch))) |
| 220 | `((,(caar file-notify--pending-event) | 306 | (when (and (not (equal desc pending-desc)) |
| 221 | renamed ,file ,file1) | 307 | callback) |
| 222 | ,(cadr file-notify--pending-event)))) | 308 | (funcall callback |
| 223 | (setq file-notify--pending-event nil) | 309 | (list pending-desc 'renamed file file1)))) |
| 224 | 'renamed)))) | 310 | (setq file-notify--pending-rename nil) |
| 225 | 311 | (setq action 'renamed)) | |
| 226 | ;; Apply pending callback. | 312 | (setq action 'created)))) |
| 227 | (when pending-event | 313 | |
| 228 | (funcall (cadr pending-event) (car pending-event)) | 314 | (when action |
| 229 | (setq pending-event nil)) | 315 | (file-notify--call-handler watch desc action file file1)) |
| 230 | 316 | ||
| 231 | ;; Apply callback. | 317 | ;; Send `stopped' event. |
| 232 | (when (and action | 318 | (when (and (memq action '(deleted renamed)) |
| 233 | (or | 319 | ;; Not when a file is backed up. |
| 234 | ;; If there is no relative file name for that | 320 | (not (and (stringp file1) (backup-file-name-p file1))) |
| 235 | ;; watch, we watch the whole directory. | 321 | ;; Watched file or directory is concerned. |
| 236 | (null (file-notify--watch-filename watch)) | 322 | (string-equal |
| 237 | ;; File matches. | 323 | file (file-notify--watch-absolute-filename watch))) |
| 238 | (string-equal | 324 | (file-notify-rm-watch desc)))))))) |
| 239 | (file-notify--watch-filename watch) | ||
| 240 | (file-name-nondirectory file)) | ||
| 241 | |||
| 242 | ;; Directory matches. | ||
| 243 | ;; FIXME: What purpose would this condition serve? | ||
| 244 | ;; Doesn't it just slip through events for files | ||
| 245 | ;; having the same name as the last component of the | ||
| 246 | ;; directory of the file that we are really watching? | ||
| 247 | ;;(string-equal | ||
| 248 | ;; (file-name-nondirectory file) | ||
| 249 | ;; (file-name-nondirectory | ||
| 250 | ;; (file-notify--watch-directory watch))) | ||
| 251 | |||
| 252 | ;; File1 matches. | ||
| 253 | (and (stringp file1) | ||
| 254 | (string-equal | ||
| 255 | (file-notify--watch-filename watch) | ||
| 256 | (file-name-nondirectory file1))))) | ||
| 257 | (when file-notify-debug | ||
| 258 | (message | ||
| 259 | "file-notify-callback %S %S %S %S %S %S %S" | ||
| 260 | desc action file file1 watch | ||
| 261 | (file-notify--event-watched-file event) | ||
| 262 | (file-notify--watch-directory watch))) | ||
| 263 | (funcall (file-notify--watch-callback watch) | ||
| 264 | (if file1 | ||
| 265 | `(,desc ,action ,file ,file1) | ||
| 266 | `(,desc ,action ,file)))) | ||
| 267 | |||
| 268 | ;; Send `stopped' event. | ||
| 269 | (when (or stopped | ||
| 270 | (and (memq action '(deleted renamed)) | ||
| 271 | ;; Not, when a file is backed up. | ||
| 272 | (not (and (stringp file1) (backup-file-name-p file1))) | ||
| 273 | ;; Watched file or directory is concerned. | ||
| 274 | (string-equal | ||
| 275 | file (file-notify--event-watched-file event)))) | ||
| 276 | (file-notify-rm-watch desc))))))) | ||
| 277 | 325 | ||
| 278 | (declare-function inotify-add-watch "inotify.c" (file flags callback)) | 326 | (declare-function inotify-add-watch "inotify.c" (file flags callback)) |
| 279 | (declare-function kqueue-add-watch "kqueue.c" (file flags callback)) | 327 | (declare-function kqueue-add-watch "kqueue.c" (file flags callback)) |
| @@ -288,7 +336,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' | |||
| 288 | '(create delete delete-self modify move-self move)) | 336 | '(create delete delete-self modify move-self move)) |
| 289 | (and (memq 'attribute-change flags) | 337 | (and (memq 'attribute-change flags) |
| 290 | '(attrib))) | 338 | '(attrib))) |
| 291 | #'file-notify-callback)) | 339 | #'file-notify--callback-inotify)) |
| 292 | 340 | ||
| 293 | (defun file-notify--add-watch-kqueue (file _dir flags) | 341 | (defun file-notify--add-watch-kqueue (file _dir flags) |
| 294 | "Add a watch for FILE in DIR with FLAGS, using kqueue." | 342 | "Add a watch for FILE in DIR with FLAGS, using kqueue." |
| @@ -300,7 +348,7 @@ EVENT is the cadr of the event in `file-notify-handle-event' | |||
| 300 | '(create delete write extend rename)) | 348 | '(create delete write extend rename)) |
| 301 | (and (memq 'attribute-change flags) | 349 | (and (memq 'attribute-change flags) |
| 302 | '(attrib))) | 350 | '(attrib))) |
| 303 | #'file-notify-callback)) | 351 | #'file-notify--callback-kqueue)) |
| 304 | 352 | ||
| 305 | (defun file-notify--add-watch-w32notify (_file dir flags) | 353 | (defun file-notify--add-watch-w32notify (_file dir flags) |
| 306 | "Add a watch for FILE in DIR with FLAGS, using w32notify." | 354 | "Add a watch for FILE in DIR with FLAGS, using w32notify." |
| @@ -310,13 +358,13 @@ EVENT is the cadr of the event in `file-notify-handle-event' | |||
| 310 | '(file-name directory-name size last-write-time)) | 358 | '(file-name directory-name size last-write-time)) |
| 311 | (and (memq 'attribute-change flags) | 359 | (and (memq 'attribute-change flags) |
| 312 | '(attributes))) | 360 | '(attributes))) |
| 313 | #'file-notify-callback)) | 361 | #'file-notify--callback-w32notify)) |
| 314 | 362 | ||
| 315 | (defun file-notify--add-watch-gfilenotify (_file dir flags) | 363 | (defun file-notify--add-watch-gfilenotify (_file dir flags) |
| 316 | "Add a watch for FILE in DIR with FLAGS, using gfilenotify." | 364 | "Add a watch for FILE in DIR with FLAGS, using gfilenotify." |
| 317 | (gfile-add-watch dir | 365 | (gfile-add-watch dir |
| 318 | (append '(watch-mounts send-moved) flags) | 366 | (append '(watch-mounts send-moved) flags) |
| 319 | #'file-notify-callback)) | 367 | #'file-notify--callback-gfilenotify)) |
| 320 | 368 | ||
| 321 | (defun file-notify-add-watch (file flags callback) | 369 | (defun file-notify-add-watch (file flags callback) |
| 322 | "Add a watch for filesystem events pertaining to FILE. | 370 | "Add a watch for filesystem events pertaining to FILE. |