[bpt/emacs.git] / lisp / filenotify.el

;;; filenotify.el --- watch files for changes on disk

;; Copyright (C) 2013-2014 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 <http://www.gnu.org/licenses/>.

;;; Commentary

;; This package is an abstraction layer from the different low-level
;; file notification packages `gfilenotify', `inotify' and
;; `w32notify'.

;;; Code:

(defconst file-notify--library
  (cond
   ((featurep 'gfilenotify) 'gfilenotify)
   ((featurep 'inotify) 'inotify)
   ((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.")

(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
`gfilenotify', `inotify', `w32notify' or a file name handler.
The value in the hash table is the cons cell (DIR FILE CALLBACK).")

;; This function is used by `gfilenotify', `inotify' and `w32notify' events.
;;;###autoload
(defun file-notify-handle-event (event)
  "Handle file system monitoring event.
If EVENT is a filewatch event, call its callback.
Otherwise, signal a `file-notify-error'."
  (interactive "e")
  (if (and (eq (car event) 'file-notify)
	   (>= (length event) 3))
      (funcall (nth 2 event) (nth 1 event))
    (signal 'file-notify-error
	    (cons "Not a valid file-notify event" event))))

(defvar file-notify--pending-events nil
  "List of pending file notification events for a future `renamed' action.
The entries are a list (DESCRIPTOR ACTION FILE COOKIE).  ACTION
is either `moved-from' or `renamed-from'.")

(defun file-notify--event-file-name (event)
  "Return file name of file notification event, or nil."
  (expand-file-name
   (or  (and (stringp (nth 2 event)) (nth 2 event)) "")
   (car (gethash (car event) file-notify-descriptors))))

;; 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))
       (expand-file-name
	(nth 3 event) (car (gethash (car event) file-notify-descriptors)))))

;; Cookies are offered by `inotify' only.
(defun file-notify--event-cookie (event)
  "Return cookie of file notification event, or nil.
This is available in case a file has been moved."
  (nth 3 event))

;; The callback function used to map between specific flags of the
;; respective file notifications, and the ones we return.
(defun file-notify-callback (event)
  "Handle an EVENT returned from file notification.
EVENT is the same one as in `file-notify-handle-event' except the
car of that event, which is the symbol `file-notify'."
  (let* ((desc (car event))
	 (registered (gethash desc file-notify-descriptors))
	 (pending-event (assoc desc file-notify--pending-events))
	 (actions (nth 1 event))
	 (file (file-notify--event-file-name event))
	 file1 callback)

    ;; Make actions a list.
    (unless (consp actions) (setq actions (cons actions nil)))

    ;; Check, that event is meant for us.
    (unless (setq callback (nth 2 registered))
      (setq actions nil))

    ;; Loop over actions.  In fact, more than one action happens only
    ;; for `inotify'.
    (dolist (action actions)

      ;; Send pending event, if it doesn't match.
      (when (and pending-event
		 ;; The cookie doesn't match.
		 (not (eq (file-notify--event-cookie pending-event)
			  (file-notify--event-cookie event)))
		 (or
		  ;; inotify.
		  (and (eq (nth 1 pending-event) 'moved-from)
		       (not (eq action 'moved-to)))
		  ;; w32notify.
		  (and (eq (nth 1 pending-event) 'renamed-from)
		       (not (eq action 'renamed-to)))))
	(funcall callback
		 (list desc 'deleted
		       (file-notify--event-file-name pending-event)))
	(setq file-notify--pending-events
	      (delete pending-event file-notify--pending-events)))

      ;; Map action.  We ignore all events which cannot be mapped.
      (setq action
	    (cond
	     ;; gfilenotify.
	     ((memq action '(attribute-changed changed created deleted)) action)
	     ((eq action 'moved)
	      (setq file1 (file-notify--event-file1-name event))
	      'renamed)

	     ;; inotify.
	     ((eq action 'attrib) 'attribute-changed)
	     ((eq action 'create) 'created)
	     ((eq action 'modify) 'changed)
	     ((memq action '(delete 'delete-self move-self)) 'deleted)
	     ;; Make the event pending.
	     ((eq action 'moved-from)
	      (add-to-list 'file-notify--pending-events
			   (list desc action file
				 (file-notify--event-cookie event)))
	      nil)
	     ;; Look for pending event.
	     ((eq action 'moved-to)
	      (if (null pending-event)
		  'created
		(setq file1 file
		      file (file-notify--event-file-name pending-event)
		      file-notify--pending-events
		      (delete pending-event file-notify--pending-events))
		'renamed))

	     ;; w32notify.
	     ((eq action 'added) 'created)
	     ((eq action 'modified) 'changed)
	     ((eq action 'removed) 'deleted)
	     ;; Make the event pending.
	     ((eq 'renamed-from action)
	      (add-to-list 'file-notify--pending-events
			   (list desc action file
				 (file-notify--event-cookie event)))
	      nil)
	     ;; Look for pending event.
	     ((eq 'renamed-to action)
	      (if (null pending-event)
		  'created
		(setq file1 file
		      file (file-notify--event-file-name pending-event)
		      file-notify--pending-events
		      (delete pending-event file-notify--pending-events))
		'renamed))))

      ;; Apply callback.
      (when (and action
		 (or
		  ;; If there is no relative file name for that watch,
		  ;; we watch the whole directory.
		  (null (nth 1 registered))
		  ;; File matches.
		  (string-equal
		   (nth 1 registered) (file-name-nondirectory file))
		  ;; File1 matches.
		  (and (stringp file1)
		       (string-equal
			(nth 1 registered) (file-name-nondirectory file1)))))
	(if file1
	    (funcall callback (list desc action file file1))
	  (funcall callback (list desc action file)))))))

(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.  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

FILE is the name of the file whose event is being reported."
  ;; Check arguments.
  (unless (stringp file)
    (signal 'wrong-type-argument (list file)))
  (setq file (expand-file-name file))
  (unless (and (consp flags)
	       (null (delq 'change (delq 'attribute-change (copy-tree flags)))))
    (signal 'wrong-type-argument (list flags)))
  (unless (functionp callback)
    (signal 'wrong-type-argument (list 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))))
	desc func l-flags)

    ;; Check, whether this has been registered already.
;    (maphash
;     (lambda (key value)
;       (when (equal (cons file callback) value) (setq desc key)))
;     file-notify-descriptors)

    (unless desc
      (if handler
	  ;; A file name handler could exist even if there is no local
	  ;; file notification support.
	  (setq desc (funcall
		      handler 'file-notify-add-watch dir flags callback))

	;; Check, whether Emacs has been compiled with file
	;; notification support.
	(unless file-notify--library
	  (signal 'file-notify-error
		  '("No file notification package available")))

	;; Determine low-level function to be called.
	(setq func
	      (cond
	       ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
	       ((eq file-notify--library 'inotify) 'inotify-add-watch)
	       ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))

	;; Determine respective flags.
	(if (eq file-notify--library 'gfilenotify)
	    (setq l-flags '(watch-mounts send-moved))
	  (when (memq 'change flags)
	    (setq
	     l-flags
	     (cond
	      ((eq file-notify--library 'inotify) '(create modify move delete))
	      ((eq file-notify--library 'w32notify)
	       '(file-name directory-name size last-write-time)))))
	  (when (memq 'attribute-change flags)
	    (add-to-list
	     'l-flags
	     (cond
	      ((eq file-notify--library 'inotify) 'attrib)
	      ((eq file-notify--library 'w32notify) 'attributes)))))

	;; Call low-level function.
	(setq desc (funcall func dir l-flags 'file-notify-callback))))

    ;; Return descriptor.
    (puthash desc
             (list (directory-file-name
		    (if (file-directory-p dir) dir (file-name-directory dir)))
                   (unless (file-directory-p file)
		     (file-name-nondirectory file))
		   callback)
             file-notify-descriptors)
    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 ((file (car (gethash descriptor file-notify-descriptors)))
	handler)

    (when (stringp file)
      (setq handler (find-file-name-handler file 'file-notify-rm-watch))
      (if handler
	  (funcall handler 'file-notify-rm-watch descriptor)
	(funcall
	 (cond
	  ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
	  ((eq file-notify--library 'inotify) 'inotify-rm-watch)
	  ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
	 descriptor)))

    (remhash descriptor file-notify-descriptors)))

;; The end:
(provide 'filenotify)

;;; filenotify.el ends here
Commit	Line	Data
864c58ca MA	1	;;; filenotify.el --- watch files for changes on disk
864c58ca MA	2
ba318903	3	;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
864c58ca MA	4
	5	;; Author: Michael Albinus <michael.albinus@gmx.de>
	6
	7	;; This file is part of GNU Emacs.
	8
	9	;; GNU Emacs is free software: you can redistribute it and/or modify
	10	;; it under the terms of the GNU General Public License as published by
	11	;; the Free Software Foundation, either version 3 of the License, or
	12	;; (at your option) any later version.
	13
	14	;; GNU Emacs is distributed in the hope that it will be useful,
	15	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	16	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	17	;; GNU General Public License for more details.
	18
	19	;; You should have received a copy of the GNU General Public License
	20	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
	21
	22	;;; Commentary
	23
	24	;; This package is an abstraction layer from the different low-level
	25	;; file notification packages `gfilenotify', `inotify' and
	26	;; `w32notify'.
	27
	28	;;; Code:
	29
e06ec67f	30	(defconst file-notify--library
864c58ca MA	31	(cond
	32	((featurep 'gfilenotify) 'gfilenotify)
	33	((featurep 'inotify) 'inotify)
	34	((featurep 'w32notify) 'w32notify))
	35	"Non-nil when Emacs has been compiled with file notification support.
	36	The value is the name of the low-level file notification package
	37	to be used for local file systems. Remote file notifications
	38	could use another implementation.")
	39
	40	(defvar file-notify-descriptors (make-hash-table :test 'equal)
	41	"Hash table for registered file notification descriptors.
	42	A key in this hash table is the descriptor as returned from
	43	`gfilenotify', `inotify', `w32notify' or a file name handler.
	44	The value in the hash table is the cons cell (DIR FILE CALLBACK).")
	45
	46	;; This function is used by `gfilenotify', `inotify' and `w32notify' events.
	47	;;;###autoload
	48	(defun file-notify-handle-event (event)
	49	"Handle file system monitoring event.
	50	If EVENT is a filewatch event, call its callback.
	51	Otherwise, signal a `file-notify-error'."
	52	(interactive "e")
	53	(if (and (eq (car event) 'file-notify)
	54	(>= (length event) 3))
	55	(funcall (nth 2 event) (nth 1 event))
	56	(signal 'file-notify-error
	57	(cons "Not a valid file-notify event" event))))
	58
	59	(defvar file-notify--pending-events nil
	60	"List of pending file notification events for a future `renamed' action.
	61	The entries are a list (DESCRIPTOR ACTION FILE COOKIE). ACTION
	62	is either `moved-from' or `renamed-from'.")
	63
	64	(defun file-notify--event-file-name (event)
	65	"Return file name of file notification event, or nil."
	66	(expand-file-name
	67	(or (and (stringp (nth 2 event)) (nth 2 event)) "")
	68	(car (gethash (car event) file-notify-descriptors))))
	69
	70	;; Only `gfilenotify' could return two file names.
	71	(defun file-notify--event-file1-name (event)
	72	"Return second file name of file notification event, or nil.
	73	This is available in case a file has been moved."
	74	(and (stringp (nth 3 event))
	75	(expand-file-name
	76	(nth 3 event) (car (gethash (car event) file-notify-descriptors)))))
	77
	78	;; Cookies are offered by `inotify' only.
	79	(defun file-notify--event-cookie (event)
	80	"Return cookie of file notification event, or nil.
	81	This is available in case a file has been moved."
	82	(nth 3 event))
	83
	84	;; The callback function used to map between specific flags of the
	85	;; respective file notifications, and the ones we return.
	86	(defun file-notify-callback (event)
	87	"Handle an EVENT returned from file notification.
	88	EVENT is the same one as in `file-notify-handle-event' except the
	89	car of that event, which is the symbol `file-notify'."
	90	(let* ((desc (car event))
	91	(registered (gethash desc file-notify-descriptors))
	92	(pending-event (assoc desc file-notify--pending-events))
	93	(actions (nth 1 event))
	94	(file (file-notify--event-file-name event))
45fdb482	95	file1 callback)
864c58ca MA	96
	97	;; Make actions a list.
	98	(unless (consp actions) (setq actions (cons actions nil)))
	99
	100	;; Check, that event is meant for us.
	101	(unless (setq callback (nth 2 registered))
	102	(setq actions nil))
	103
	104	;; Loop over actions. In fact, more than one action happens only
	105	;; for `inotify'.
	106	(dolist (action actions)
	107
	108	;; Send pending event, if it doesn't match.
	109	(when (and pending-event
	110	;; The cookie doesn't match.
	111	(not (eq (file-notify--event-cookie pending-event)
	112	(file-notify--event-cookie event)))
	113	(or
	114	;; inotify.
	115	(and (eq (nth 1 pending-event) 'moved-from)
	116	(not (eq action 'moved-to)))
	117	;; w32notify.
	118	(and (eq (nth 1 pending-event) 'renamed-from)
	119	(not (eq action 'renamed-to)))))
	120	(funcall callback
	121	(list desc 'deleted
	122	(file-notify--event-file-name pending-event)))
	123	(setq file-notify--pending-events
	124	(delete pending-event file-notify--pending-events)))
	125
	126	;; Map action. We ignore all events which cannot be mapped.
	127	(setq action
	128	(cond
	129	;; gfilenotify.
	130	((memq action '(attribute-changed changed created deleted)) action)
	131	((eq action 'moved)
	132	(setq file1 (file-notify--event-file1-name event))
	133	'renamed)
	134
	135	;; inotify.
	136	((eq action 'attrib) 'attribute-changed)
	137	((eq action 'create) 'created)
	138	((eq action 'modify) 'changed)
	139	((memq action '(delete 'delete-self move-self)) 'deleted)
	140	;; Make the event pending.
	141	((eq action 'moved-from)
	142	(add-to-list 'file-notify--pending-events
	143	(list desc action file
	144	(file-notify--event-cookie event)))
	145	nil)
	146	;; Look for pending event.
	147	((eq action 'moved-to)
	148	(if (null pending-event)
	149	'created
	150	(setq file1 file
	151	file (file-notify--event-file-name pending-event)
	152	file-notify--pending-events
	153	(delete pending-event file-notify--pending-events))
	154	'renamed))
	155
	156	;; w32notify.
	157	((eq action 'added) 'created)
	158	((eq action 'modified) 'changed)
	159	((eq action 'removed) 'deleted)
160	;; Make the event pending.
161	((eq 'renamed-from action)
162	(add-to-list 'file-notify--pending-events
163	(list desc action file
164	(file-notify--event-cookie event)))
165	nil)
166	;; Look for pending event.
167	((eq 'renamed-to action)
168	(if (null pending-event)
169	'created
170	(setq file1 file
171	file (file-notify--event-file-name pending-event)
172	file-notify--pending-events
173	(delete pending-event file-notify--pending-events))
174	'renamed))))
175
176	;; Apply callback.
177	(when (and action
178	(or
179	;; If there is no relative file name for that watch,
180	;; we watch the whole directory.
181	(null (nth 1 registered))
182	;; File matches.
183	(string-equal
184	(nth 1 registered) (file-name-nondirectory file))
185	;; File1 matches.
186	(and (stringp file1)
187	(string-equal
188	(nth 1 registered) (file-name-nondirectory file1)))))
189	(if file1
190	(funcall callback (list desc action file file1))
191	(funcall callback (list desc action file)))))))
192
193	(defun file-notify-add-watch (file flags callback)
194	"Add a watch for filesystem events pertaining to FILE.
195	This arranges for filesystem events pertaining to FILE to be reported
196	to Emacs. Use `file-notify-rm-watch' to cancel the watch.
197
198	The returned value is a descriptor for the added watch. If the
199	file cannot be watched for some reason, this function signals a
200	`file-notify-error' error.
201
202	FLAGS is a list of conditions to set what will be watched for. It can
203	include the following symbols:
204
205	`change' -- watch for file changes
206	`attribute-change' -- watch for file attributes changes, like
207	permissions or modification time
208
209	If FILE is a directory, 'change' watches for file creation or
a6e3a5d5	210	deletion in that directory. This does not work recursively.
864c58ca MA	211
	212	When any event happens, Emacs will call the CALLBACK function passing
	213	it a single argument EVENT, which is of the form
	214
	215	(DESCRIPTOR ACTION FILE [FILE1])
	216
	217	DESCRIPTOR is the same object as the one returned by this function.
	218	ACTION is the description of the event. It could be any one of the
	219	following:
	220
	221	`created' -- FILE was created
	222	`deleted' -- FILE was deleted
	223	`changed' -- FILE has changed
	224	`renamed' -- FILE has been renamed to FILE1
	225	`attribute-changed' -- a FILE attribute was changed
	226
	227	FILE is the name of the file whose event is being reported."
	228	;; Check arguments.
	229	(unless (stringp file)
	230	(signal 'wrong-type-argument (list file)))
	231	(setq file (expand-file-name file))
	232	(unless (and (consp flags)
	233	(null (delq 'change (delq 'attribute-change (copy-tree flags)))))
	234	(signal 'wrong-type-argument (list flags)))
	235	(unless (functionp callback)
	236	(signal 'wrong-type-argument (list callback)))
	237
	238	(let* ((handler (find-file-name-handler file 'file-notify-add-watch))
	239	(dir (directory-file-name
fb6a5d68	240	(if (file-directory-p file)
864c58ca MA	241	file
	242	(file-name-directory file))))
	243	desc func l-flags)
	244
	245	;; Check, whether this has been registered already.
	246	; (maphash
	247	; (lambda (key value)
	248	; (when (equal (cons file callback) value) (setq desc key)))
	249	; file-notify-descriptors)
	250
	251	(unless desc
	252	(if handler
	253	;; A file name handler could exist even if there is no local
	254	;; file notification support.
	255	(setq desc (funcall
	256	handler 'file-notify-add-watch dir flags callback))
	257
	258	;; Check, whether Emacs has been compiled with file
	259	;; notification support.
e06ec67f	260	(unless file-notify--library
864c58ca MA	261	(signal 'file-notify-error
	262	'("No file notification package available")))
	263
	264	;; Determine low-level function to be called.
d5d3c58a MA	265	(setq func
	266	(cond
	267	((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
	268	((eq file-notify--library 'inotify) 'inotify-add-watch)
	269	((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
864c58ca MA	270
864c58ca MA	271	;; Determine respective flags.
e06ec67f	272	(if (eq file-notify--library 'gfilenotify)
864c58ca MA	273	(setq l-flags '(watch-mounts send-moved))
	274	(when (memq 'change flags)
	275	(setq
	276	l-flags
	277	(cond
e06ec67f MA	278	((eq file-notify--library 'inotify) '(create modify move delete))
e06ec67f MA	279	((eq file-notify--library 'w32notify)
864c58ca MA	280	'(file-name directory-name size last-write-time)))))
	281	(when (memq 'attribute-change flags)
	282	(add-to-list
	283	'l-flags
	284	(cond
e06ec67f MA	285	((eq file-notify--library 'inotify) 'attrib)
e06ec67f MA	286	((eq file-notify--library 'w32notify) 'attributes)))))
864c58ca MA	287
	288	;; Call low-level function.
	289	(setq desc (funcall func dir l-flags 'file-notify-callback))))
	290
	291	;; Return descriptor.
	292	(puthash desc
	293	(list (directory-file-name
	294	(if (file-directory-p dir) dir (file-name-directory dir)))
	295	(unless (file-directory-p file)
	296	(file-name-nondirectory file))
	297	callback)
	298	file-notify-descriptors)
	299	desc))
	300
	301	(defun file-notify-rm-watch (descriptor)
	302	"Remove an existing watch specified by its DESCRIPTOR.
	303	DESCRIPTOR should be an object returned by `file-notify-add-watch'."
	304	(let ((file (car (gethash descriptor file-notify-descriptors)))
	305	handler)
	306
	307	(when (stringp file)
	308	(setq handler (find-file-name-handler file 'file-notify-rm-watch))
	309	(if handler
	310	(funcall handler 'file-notify-rm-watch descriptor)
	311	(funcall
	312	(cond
e06ec67f MA	313	((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
	314	((eq file-notify--library 'inotify) 'inotify-rm-watch)
	315	((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
864c58ca MA	316	descriptor)))
	317
	318	(remhash descriptor file-notify-descriptors)))
	319
	320	;; The end:
	321	(provide 'filenotify)
	322
	323	;;; filenotify.el ends here