mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-22 07:09:54 +00:00
Code Issues Releases Activity
c26261c027
emacs/lisp/filenotify.el
Po Lu ecf08f0621 Merge from savannah/emacs-29 
dc4e6b1329 ; Update copyright years in more files
64b3777631 ; Run set-copyright from admin.el
8e1c56ae46 ; Add 2024 to copyright years

# Conflicts:
#	doc/misc/modus-themes.org
#	doc/misc/texinfo.tex
#	etc/NEWS
#	etc/refcards/ru-refcard.tex
#	etc/themes/modus-operandi-theme.el
#	etc/themes/modus-themes.el
#	etc/themes/modus-vivendi-theme.el
#	lib/alloca.in.h
#	lib/binary-io.h
#	lib/c-ctype.h
#	lib/c-strcasecmp.c
#	lib/c-strncasecmp.c
#	lib/careadlinkat.c
#	lib/cloexec.c
#	lib/close-stream.c
#	lib/diffseq.h
#	lib/dup2.c
#	lib/filemode.h
#	lib/fpending.c
#	lib/fpending.h
#	lib/fsusage.c
#	lib/getgroups.c
#	lib/getloadavg.c
#	lib/gettext.h
#	lib/gettime.c
#	lib/gettimeofday.c
#	lib/group-member.c
#	lib/malloc.c
#	lib/md5-stream.c
#	lib/md5.c
#	lib/md5.h
#	lib/memmem.c
#	lib/memrchr.c
#	lib/nanosleep.c
#	lib/save-cwd.h
#	lib/sha1.c
#	lib/sig2str.c
#	lib/stdlib.in.h
#	lib/strtoimax.c
#	lib/strtol.c
#	lib/strtoll.c
#	lib/time_r.c
#	lib/xalloc-oversized.h
#	lisp/auth-source-pass.el
#	lisp/emacs-lisp/lisp-mnt.el
#	lisp/emacs-lisp/timer.el
#	lisp/info-look.el
#	lisp/jit-lock.el
#	lisp/loadhist.el
#	lisp/mail/rmail.el
#	lisp/net/ntlm.el
#	lisp/net/webjump.el
#	lisp/progmodes/asm-mode.el
#	lisp/progmodes/project.el
#	lisp/progmodes/sh-script.el
#	lisp/textmodes/flyspell.el
#	lisp/textmodes/reftex-toc.el
#	lisp/textmodes/reftex.el
#	lisp/textmodes/tex-mode.el
#	lisp/url/url-gw.el
#	m4/alloca.m4
#	m4/clock_time.m4
#	m4/d-type.m4
#	m4/dirent_h.m4
#	m4/dup2.m4
#	m4/euidaccess.m4
#	m4/fchmodat.m4
#	m4/filemode.m4
#	m4/fsusage.m4
#	m4/getgroups.m4
#	m4/getloadavg.m4
#	m4/getrandom.m4
#	m4/gettime.m4
#	m4/gettimeofday.m4
#	m4/gnulib-common.m4
#	m4/group-member.m4
#	m4/inttypes.m4
#	m4/malloc.m4
#	m4/manywarnings.m4
#	m4/mempcpy.m4
#	m4/memrchr.m4
#	m4/mkostemp.m4
#	m4/mktime.m4
#	m4/nproc.m4
#	m4/nstrftime.m4
#	m4/pathmax.m4
#	m4/pipe2.m4
#	m4/pselect.m4
#	m4/pthread_sigmask.m4
#	m4/readlink.m4
#	m4/realloc.m4
#	m4/sig2str.m4
#	m4/ssize_t.m4
#	m4/stat-time.m4
#	m4/stddef_h.m4
#	m4/stdint.m4
#	m4/stdio_h.m4
#	m4/stdlib_h.m4
#	m4/stpcpy.m4
#	m4/strnlen.m4
#	m4/strtoimax.m4
#	m4/strtoll.m4
#	m4/time_h.m4
#	m4/timegm.m4
#	m4/timer_time.m4
#	m4/timespec.m4
#	m4/unistd_h.m4
#	m4/warnings.m4
#	nt/configure.bat
#	nt/preprep.c
#	test/lisp/register-tests.el
2024-01-02 10:28:14 +08:00

527 lines
22 KiB
EmacsLisp
Raw Blame History

;;; filenotify.el --- watch files for changes on disk -*- lexical-binding:t -*-
;; Copyright (C) 2013-2024 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package is an abstraction layer from the different low-level
;; file notification packages `inotify', `kqueue', `gfilenotify' and
;; `w32notify'.
;;; Code:
(require 'cl-lib)
(eval-when-compile (require 'subr-x))
(defvar file-notify-debug nil
"Use for debug messages.")
(defconst file-notify--library
(cond
((featurep 'inotify) 'inotify)
((featurep 'kqueue) 'kqueue)
((featurep 'gfilenotify) 'gfilenotify)
((featurep 'w32notify) 'w32notify))
"Non-nil when Emacs has been compiled with file notification support.
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)))
"The internal struct for bookkeeping watched files or directories.
Used in `file-notify-descriptors'."
;; Watched directory.
directory
;; Watched relative filename, nil if watching the directory.
filename
;; Function to propagate events to, or nil if watch is being removed.
callback)
(defun file-notify--watch-absolute-filename (watch)
"Return the absolute filename observed by 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 `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."
(when-let ((watch (gethash descriptor file-notify-descriptors)))
(unwind-protect
;; Send `stopped' event.
(file-notify-handle-event
(make-file-notify
:-event `(,descriptor stopped
,(file-notify--watch-absolute-filename watch))
:-callback (file-notify--watch-callback watch)))
;; Make sure this is the last time the callback was invoked.
(setf (file-notify--watch-callback watch) nil)
(remhash descriptor file-notify-descriptors))))
(cl-defstruct (file-notify (:type list) :named)
"A file system monitoring event, coming from the backends."
-event -callback)
;; This function is used by `inotify', `kqueue', `gfilenotify',
;; `w32notify' and remote file system handlers. Usually, we call the
;; argument `event' for such handlers. But in the following, `event'
;; means a part of the argument only, so we call the argument `object'.
;;;###autoload
(defun file-notify-handle-event (object)
"Handle a file system monitoring event, coming from backends.
If OBJECT is a filewatch event, call its callback.
Otherwise, signal a `file-notify-error'."
(declare (completion ignore))
(interactive "e")
(when file-notify-debug
(message "file-notify-handle-event %S" object))
(if (file-notify-p object)
(funcall (file-notify--callback object) (file-notify--event object))
(signal 'file-notify-error
(cons "Not a valid file-notify-event" object))))
(cl-defstruct (file-notify--rename
(:constructor nil)
(:constructor
file-notify--rename-make (watch desc from-file cookie)))
watch desc from-file cookie)
(defvar file-notify--pending-rename nil
"A pending rename event awaiting the destination file name.
It is nil or a `file-notify--rename' defstruct where the cookie can be nil.")
(defun file-notify--expand-file-name (watch file)
"Full file name of FILE reported for WATCH."
(directory-file-name
(expand-file-name file (file-notify--watch-directory watch))))
(cl-defun file-notify--callback-inotify ((desc actions file
&optional file1-or-cookie))
"Notification callback for inotify."
(file-notify--handle-event
desc
(delq nil (mapcar (lambda (action)
(cond
((eq action 'create) 'created)
((eq action 'modify) 'changed)
((eq action 'attrib) 'attribute-changed)
((memq action '(delete delete-self move-self)) 'deleted)
((eq action 'moved-from) 'renamed-from)
((eq action 'moved-to) 'renamed-to)
((memq action '(ignored unmount)) 'stopped)))
actions))
file file1-or-cookie))
(cl-defun file-notify--callback-kqueue ((desc actions file
&optional file1-or-cookie))
"Notification callback for kqueue."
(file-notify--handle-event
desc
(delq nil (mapcar (lambda (action)
(cond
((eq action 'create) 'created)
((eq action 'write) 'changed)
((memq action '(attrib link)) 'attribute-changed)
((eq action 'delete) 'deleted)
((eq action 'rename) 'renamed)
((eq action 'revoke) 'stopped)))
actions))
file file1-or-cookie))
(cl-defun file-notify--callback-w32notify ((desc actions file
&optional file1-or-cookie))
"Notification callback for w32notify."
(let ((action (pcase actions
('added 'created)
('modified 'changed)
('removed 'deleted)
('renamed-from 'renamed-from)
('renamed-to 'renamed-to))))
(when action
(file-notify--handle-event desc (list action) file file1-or-cookie))))
(cl-defun file-notify--callback-gfilenotify ((desc actions file
&optional file1-or-cookie))
"Notification callback for gfilenotify."
(file-notify--handle-event
desc
(delq nil (mapcar (lambda (action)
(cond
((memq action
'(created changed attribute-changed deleted))
action)
((eq action 'moved) 'renamed)
((eq action 'unmounted) 'stopped)))
(if (consp actions) actions (list actions))))
file file1-or-cookie))
(cl-defun file-notify-callback ((desc actions file &optional file1-or-cookie))
"Notification callback for file name handlers."
(file-notify--handle-event
desc
;; File name handlers use gfilenotify or inotify actions.
(delq nil (mapcar
(lambda (action)
(cond
;; gfilenotify actions:
((memq action '(created changed attribute-changed deleted))
action)
((eq action 'moved) 'renamed)
((eq action 'unmounted) 'stopped)
;; inotify actions:
((eq action 'create) 'created)
((eq action 'modify) 'changed)
((eq action 'attrib) 'attribute-changed)
((memq action '(delete delete-self move-self)) 'deleted)
((eq action 'moved-from) 'renamed-from)
((eq action 'moved-to) 'renamed-to)
((memq action '(ignored unmount)) 'stopped)))
(if (consp actions) actions (list actions))))
file file1-or-cookie))
(defun file-notify--call-handler (watch desc action file file1)
"Call the handler of WATCH with the arguments DESC, ACTION, FILE and FILE1."
(when (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.
;; FIXME: What purpose would this condition serve?
;; Doesn't it just slip through events for files
;; having the same name as the last component of the
;; directory of the file that we are really watching?
;;(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))))
(when file-notify-debug
(message
"file-notify-callback %S %S %S %S %S %S %S"
desc action file file1 watch
(file-notify--watch-absolute-filename watch)
(file-notify--watch-directory watch)))
(funcall (file-notify--watch-callback watch)
(if file1
(list desc action file file1)
(list desc action file)))))
(defun file-notify--handle-event (desc actions file file1-or-cookie)
"Handle an event returned from file notification.
DESC is the back-end descriptor. ACTIONS is a list of:
`created'
`changed'
`attribute-changed'
`deleted'
`renamed' -- FILE is old name, FILE1-OR-COOKIE is new name or nil
`renamed-from' -- FILE is old name, FILE1-OR-COOKIE is cookie or nil
`renamed-to' -- FILE is new name, FILE1-OR-COOKIE is cookie or nil
`stopped' -- no more events after this should be sent"
(let* ((watch (gethash desc file-notify-descriptors))
(file (and watch (file-notify--expand-file-name watch file))))
(when watch
(while actions
(let ((action (pop actions)))
;; We only handle {renamed,moved}-{from,to} pairs when these
;; arrive in order without anything else in-between.
;; If there is a pending rename that does not match this event,
;; then send the former as a deletion (since we don't know the
;; rename destination).
(when file-notify--pending-rename
(unless (and (equal (file-notify--rename-cookie
file-notify--pending-rename)
file1-or-cookie)
(eq action 'renamed-to))
(let ((callback (file-notify--watch-callback
(file-notify--rename-watch
file-notify--pending-rename))))
(when callback
(funcall callback (list (file-notify--rename-desc
file-notify--pending-rename)
'deleted
(file-notify--rename-from-file
file-notify--pending-rename))))
(setq file-notify--pending-rename nil))))
(let ((file1 nil))
(cond
((eq action 'renamed)
;; A `renamed' event may not have a destination name;
;; if none, treat it as a deletion.
(if file1-or-cookie
(setq file1
(file-notify--expand-file-name watch file1-or-cookie))
(setq action 'deleted)))
((eq action 'stopped)
(file-notify-rm-watch desc)
(setq actions nil
action nil))
;; Make the event pending.
((eq action 'renamed-from)
(setq file-notify--pending-rename
(file-notify--rename-make watch desc file file1-or-cookie)
action nil))
;; Look for pending event.
((eq action 'renamed-to)
(if file-notify--pending-rename
(let ((callback (file-notify--watch-callback
(file-notify--rename-watch
file-notify--pending-rename)))
(pending-desc (file-notify--rename-desc
file-notify--pending-rename))
(from-file (file-notify--rename-from-file
file-notify--pending-rename)))
(setq file1 file
file from-file)
;; If the source is handled by another watch, we
;; must fire the rename event there as well.
(when (and (not (equal desc pending-desc))
callback)
(funcall callback
(list pending-desc 'renamed file file1)))
(setq file-notify--pending-rename nil
action 'renamed))
(setq action 'created))))
(when action
(file-notify--call-handler watch desc action file file1))
;; Send `stopped' event.
(when (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--watch-absolute-filename watch)))
(file-notify-rm-watch desc))))))))
(declare-function inotify-add-watch "inotify.c" (file flags callback))
(declare-function kqueue-add-watch "kqueue.c" (file flags callback))
(declare-function w32notify-add-watch "w32notify.c" (file flags callback))
(declare-function gfile-add-watch "gfilenotify.c" (file flags callback))
(defun file-notify--add-watch-inotify (_file dir flags)
"Add a watch for FILE in DIR with FLAGS, using inotify."
(inotify-add-watch dir
(append
'(dont-follow ignored unmount)
(and (memq 'change flags)
'(create delete delete-self modify move-self move))
(and (memq 'attribute-change flags)
'(attrib)))
#'file-notify--callback-inotify))
(defun file-notify--add-watch-kqueue (file _dir flags)
"Add a watch for FILE in DIR with FLAGS, using kqueue."
;; kqueue does not report changes to file contents when watching
;; directories, so we watch each file directly.
(kqueue-add-watch file
(append
'(revoke)
(and (memq 'change flags)
'(create delete write extend rename))
(and (memq 'attribute-change flags)
'(attrib)))
#'file-notify--callback-kqueue))
(defun file-notify--add-watch-w32notify (_file dir flags)
"Add a watch for FILE in DIR with FLAGS, using w32notify."
(w32notify-add-watch dir
(append
(and (memq 'change flags)
'(file-name directory-name size last-write-time))
(and (memq 'attribute-change flags)
'(attributes)))
#'file-notify--callback-w32notify))
(defun file-notify--add-watch-gfilenotify (_file dir flags)
"Add a watch for FILE in DIR with FLAGS, using gfilenotify."
(gfile-add-watch dir
(append '(watch-mounts send-moved) flags)
#'file-notify--callback-gfilenotify))
(defun file-notify-add-watch (file flags callback)
"Add a watch for filesystem events pertaining to FILE.
This arranges for filesystem events pertaining to FILE to be reported
to Emacs. Use `file-notify-rm-watch' to cancel the watch.
The returned value is a descriptor for the added watch. If the
file cannot be watched for some reason, this function signals a
`file-notify-error' error.
FLAGS is a list of conditions to set what will be watched for. It can
include the following symbols:
`change' -- watch for file changes
`attribute-change' -- watch for file attributes changes, like
permissions or modification time
If FILE is a directory, `change' watches for file creation or
deletion in that directory. Some of the file notification
backends report also file changes. This does not work
recursively.
When any event happens, Emacs will call the CALLBACK function passing
it a single argument EVENT, which is of the form
(DESCRIPTOR ACTION FILE [FILE1])
DESCRIPTOR is the same object as the one returned by this function.
ACTION is the description of the event. It could be any one of the
following:
`created' -- FILE was created
`deleted' -- FILE was deleted
`changed' -- FILE has changed
`renamed' -- FILE has been renamed to FILE1
`attribute-changed' -- a FILE attribute was changed
`stopped' -- watching FILE has been stopped
FILE is the name of the file whose event is being reported."
;; Check arguments.
(unless (stringp file)
(signal 'wrong-type-argument `(,file)))
(setq file (expand-file-name file))
(unless (and (consp flags)
(null (delq 'change (delq 'attribute-change (copy-tree flags)))))
(signal 'wrong-type-argument `(,flags)))
(unless (functionp callback)
(signal 'wrong-type-argument `(,callback)))
(let ((handler (find-file-name-handler file 'file-notify-add-watch))
(dir (directory-file-name
(if (file-directory-p file)
file
(file-name-directory file)))))
(unless (file-directory-p dir)
(signal 'file-notify-error `("Directory does not exist" ,dir)))
(let ((desc
(if handler
(funcall handler 'file-notify-add-watch dir flags callback)
(funcall
(pcase file-notify--library
('inotify #'file-notify--add-watch-inotify)
('kqueue #'file-notify--add-watch-kqueue)
('w32notify #'file-notify--add-watch-w32notify)
('gfilenotify #'file-notify--add-watch-gfilenotify)
(_ (signal 'file-notify-error
'("No file notification package available"))))
file dir flags))))
;; Modify `file-notify-descriptors'.
(let ((watch (file-notify--watch-make
;; We do not want to enter quoted file names into the hash.
(file-name-unquote dir)
(unless (file-directory-p file)
(file-name-nondirectory file))
callback)))
(puthash desc watch file-notify-descriptors))
;; Return descriptor.
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'."
(when-let* ((watch (gethash descriptor file-notify-descriptors)))
;; If we are called from a `stopped' event, do nothing.
(when (file-notify--watch-callback watch)
(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' and send a `stopped' event.
(file-notify--rm-descriptor descriptor))))
(defun file-notify-rm-all-watches ()
"Remove all existing file notification watches from Emacs."
(interactive)
(maphash
(lambda (key _value)
(file-notify-rm-watch key))
file-notify-descriptors))
(defun file-notify-valid-p (descriptor)
"Check a watch specified by its DESCRIPTOR.
DESCRIPTOR should be an object returned by `file-notify-add-watch'."
(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)
(funcall
(cond
((eq file-notify--library 'inotify) 'inotify-valid-p)
((eq file-notify--library 'kqueue) 'kqueue-valid-p)
((eq file-notify--library 'gfilenotify) 'gfile-valid-p)
((eq file-notify--library 'w32notify) 'w32notify-valid-p))
descriptor))
t))))
;; TODO:
;; * Watching a file in an already watched directory.
;; If the file is created and *then* a watch is added to that file, the
;; watch might receive events which occurred prior to it being created,
;; due to the way events are propagated during idle time. Note: This
;; may be perfectly acceptable.
(provide 'filenotify)
;;; filenotify.el ends here
Reference in New Issue View Git Blame Copy Permalink