|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: fn-handler.el
|
|
|
5 ;; Description: enhanced file-name-handler-alist support for pre-19.23 Emacs
|
|
|
6 ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it>
|
|
|
7 ;; Created: Sat Mar 19 00:50:10 1994 by sandy on ibm550
|
|
|
8 ;; Modified: Tue Sep 13 20:59:19 1994 by sandy on ibm550
|
|
|
9 ;; Language: Emacs-Lisp
|
|
|
10 ;;
|
|
|
11 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
12
|
|
|
13
|
|
|
14 ;;; One of the problems with the file-name-handler-alist, is that when
|
|
|
15 ;;; a handler gets called, and it has nothing to do for that function,
|
|
|
16 ;;; the usual procedure is to remove the handler from the alist, and
|
|
|
17 ;;; re-call the function. This is necessary to avoid an infinite
|
|
|
18 ;;; recursion. However, if the function calling
|
|
|
19 ;;; find-file-name-handler is not a primitive, there may be other lisp
|
|
|
20 ;;; functions inside of it for which the handler does have some
|
|
|
21 ;;; special actions specified. They won't run, because the let-bound
|
|
|
22 ;;; value of file-name-handler-alist doesn't contain the handler.
|
|
|
23 ;;;
|
|
|
24 ;;; This problem was solved in Emacs 19.23 with the variables
|
|
|
25 ;;; inhibit-file-name-handlers and inhibit-file-name-operation
|
|
|
26 ;;; This file provides this solution to older versions of emacs.
|
|
|
27
|
|
|
28
|
|
|
29 (provide 'fn-handler)
|
|
|
30 (require 'efs-ovwrt)
|
|
|
31
|
|
|
32 (or (boundp 'file-name-handler-alist)
|
|
|
33 (defvar file-name-handler-alist nil
|
|
|
34 "Association list of regexps for special file names and handlers."))
|
|
|
35
|
|
|
36 (defvar inhibit-file-name-handlers nil
|
|
|
37 "List of handlers \(symbols\) to be avoided by `find-file-name-handler'.")
|
|
|
38
|
|
|
39 (defvar inhibit-file-name-operation nil
|
|
|
40 "Defines to which operation `inhibit-file-name-handlers applies'
|
|
|
41 Must be a synbol.")
|
|
|
42
|
|
|
43 (defun find-file-name-handler (filename &optional operation)
|
|
|
44 "Return FILENAME1's handler function, if its syntax is handled specially.
|
|
|
45 Does not return handlers in `inhibit-file-name-handlers' list.
|
|
|
46 If there is no handler for FILENAME1, searches for one for FILENAME2.
|
|
|
47 Returns nil, if there is no handler for either file name.
|
|
|
48 A file name is handles specially if one of the regular expressions in
|
|
|
49 `file-name-handler-alist' matches it."
|
|
|
50 (let ((match-data (match-data)))
|
|
|
51 (unwind-protect
|
|
|
52 (catch 'handler
|
|
|
53 (mapcar (function
|
|
|
54 (lambda (x)
|
|
|
55 (and
|
|
|
56 (not
|
|
|
57 (and
|
|
|
58 (or (null operation)
|
|
|
59 (eq operation inhibit-file-name-operation))
|
|
|
60 (memq (cdr x) inhibit-file-name-handlers)))
|
|
|
61 (string-match (car x) filename)
|
|
|
62 (throw 'handler (cdr x)))))
|
|
|
63 file-name-handler-alist)
|
|
|
64 nil)
|
|
|
65 (store-match-data match-data))))
|
|
|
66
|
|
|
67 ;;; Overloads to supply the file-name-handler-alist
|
|
|
68
|
|
|
69 (defun fn-handler-insert-file-contents (filename &optional visit &rest args)
|
|
|
70 "Documented as original."
|
|
|
71 (let* ((filename (expand-file-name filename))
|
|
|
72 (handler (find-file-name-handler filename 'insert-file-contents)))
|
|
|
73 (if handler
|
|
|
74 (apply handler 'insert-file-contents filename visit args)
|
|
|
75 (let (file-name-handler-alist)
|
|
|
76 (apply 'fn-handler-real-insert-file-contents filename visit args)))))
|
|
|
77
|
|
|
78 (efs-overwrite-fn "fn-handler" 'insert-file-contents
|
|
|
79 'fn-handler-insert-file-contents)
|
|
|
80
|
|
|
81 (defun fn-handler-directory-files (directory &optional full match &rest nosort)
|
|
|
82 "Documented as original."
|
|
|
83 (let ((handler (find-file-name-handler directory 'directory-files)))
|
|
|
84 (if handler
|
|
|
85 (apply handler 'directory-files directory full match nosort)
|
|
|
86 (let (file-name-handler-alist)
|
|
|
87 (apply 'fn-handler-real-directory-files
|
|
|
88 directory full match nosort)))))
|
|
|
89
|
|
|
90 (efs-overwrite-fn "fn-handler" 'directory-files 'fn-handler-directory-files)
|
|
|
91
|
|
|
92 (defun fn-handler-list-directory (dirname &optional verbose)
|
|
|
93 "Documented as original."
|
|
|
94 (interactive (let ((pfx current-prefix-arg))
|
|
|
95 (list (read-file-name (if pfx "List directory (verbose): "
|
|
|
96 "List directory (brief): ")
|
|
|
97 nil default-directory nil)
|
|
|
98 pfx)))
|
|
|
99 (let ((handler (find-file-name-handler dirname 'list-directory)))
|
|
|
100 (if handler
|
|
|
101 (funcall handler 'list-directory dirname verbose)
|
|
|
102 (let (file-name-handler-alist)
|
|
|
103 (fn-handler-real-list-directory dirname verbose)))))
|
|
|
104
|
|
|
105 (efs-overwrite-fn "fn-handler" 'list-directory 'fn-handler-list-directory)
|
|
|
106
|
|
|
107 (defun fn-handler-file-directory-p (filename)
|
|
|
108 "Documented as original."
|
|
|
109 (let* ((filename (expand-file-name filename))
|
|
|
110 (handler (find-file-name-handler filename 'file-directory-p)))
|
|
|
111 (if handler
|
|
|
112 (funcall handler 'file-directory-p filename)
|
|
|
113 (let (file-name-handler-alist)
|
|
|
114 (fn-handler-real-file-directory-p filename)))))
|
|
|
115
|
|
|
116 (efs-overwrite-fn "fn-handler" ' file-directory-p 'fn-handler-file-directory-p)
|
|
|
117
|
|
|
118 (defun fn-handler-file-writable-p (filename)
|
|
|
119 "Documented as original."
|
|
|
120 (let* ((filename (expand-file-name filename))
|
|
|
121 (handler (find-file-name-handler filename 'file-writable-p)))
|
|
|
122 (if handler
|
|
|
123 (funcall handler 'file-writable-p filename)
|
|
|
124 (let (file-name-handler-alist)
|
|
|
125 (fn-handler-real-file-writable-p filename)))))
|
|
|
126
|
|
|
127 (efs-overwrite-fn "fn-handler" 'file-writable-p 'fn-handler-file-writable-p)
|
|
|
128
|
|
|
129 (defun fn-handler-file-readable-p (filename)
|
|
|
130 "Documented as original."
|
|
|
131 (let* ((filename (expand-file-name filename))
|
|
|
132 (handler (find-file-name-handler filename 'file-readable-p)))
|
|
|
133 (if handler
|
|
|
134 (funcall handler 'file-readable-p filename)
|
|
|
135 (let (file-name-handler-alist)
|
|
|
136 (fn-handler-real-file-readable-p filename)))))
|
|
|
137
|
|
|
138 (efs-overwrite-fn "fn-handler" 'file-readable-p 'fn-handler-file-readable-p)
|
|
|
139
|
|
|
140 (defun fn-handler-file-symlink-p (filename)
|
|
|
141 "Documented as original."
|
|
|
142 (let* ((filename (expand-file-name filename))
|
|
|
143 (handler (find-file-name-handler filename 'file-symlink-p)))
|
|
|
144 (if handler
|
|
|
145 (funcall handler 'file-symlink-p filename)
|
|
|
146 (let (file-name-handler-alist)
|
|
|
147 (fn-handler-real-file-symlink-p filename)))))
|
|
|
148
|
|
|
149 (efs-overwrite-fn "fn-handler" 'file-symlink-p 'fn-handler-file-symlink-p)
|
|
|
150
|
|
|
151 (defun fn-handler-delete-file (file)
|
|
|
152 "Documented as original"
|
|
|
153 (interactive (list (read-file-name "Delete-file: " nil nil t)))
|
|
|
154 (let* ((file (expand-file-name file))
|
|
|
155 (handler (find-file-name-handler file 'delete-file)))
|
|
|
156 (if handler
|
|
|
157 (funcall handler 'delete-file file)
|
|
|
158 (let (file-name-handler-alist)
|
|
|
159 (fn-handler-real-delete-file file)))))
|
|
|
160
|
|
|
161 (efs-overwrite-fn "fn-handler" 'delete-file 'fn-handler-delete-file)
|
|
|
162
|
|
|
163 (defun fn-handler-file-exists-p (filename)
|
|
|
164 "Documented as original"
|
|
|
165 (let* ((filename (expand-file-name filename))
|
|
|
166 (handler (find-file-name-handler filename 'file-exists-p)))
|
|
|
167 (if handler
|
|
|
168 (funcall handler 'file-exists-p filename)
|
|
|
169 (let (file-name-handler-alist)
|
|
|
170 (fn-handler-real-file-exists-p filename)))))
|
|
|
171
|
|
|
172 (efs-overwrite-fn "fn-handler" 'file-exists-p 'fn-handler-file-exists-p)
|
|
|
173
|
|
|
174 (defun fn-handler-write-region (start end filename &optional append visit)
|
|
|
175 "Documented as original"
|
|
|
176 ;; Use read-file-name, rather then interactive spec,
|
|
|
177 ;; to make it easier to get decent initial contents in the minibuffer.
|
|
|
178 (interactive
|
|
|
179 (progn
|
|
|
180 (or (mark) (error "The mark is not set now."))
|
|
|
181 (list (min (point) (mark))
|
|
|
182 (max (point) (mark))
|
|
|
183 (read-file-name "Write region to file: "))))
|
|
|
184 (let* ((filename (expand-file-name filename))
|
|
|
185 (handler (or (find-file-name-handler filename 'write-region)
|
|
|
186 (and (stringp visit)
|
|
|
187 (find-file-name-handler (expand-file-name visit)
|
|
|
188 'write-region)))))
|
|
|
189 (if handler
|
|
|
190 (funcall handler 'write-region start end filename append visit)
|
|
|
191 (let (file-name-handler-alist)
|
|
|
192 (fn-handler-real-write-region start end filename append visit)))))
|
|
|
193
|
|
|
194 (efs-overwrite-fn "fn-handler" 'write-region
|
|
|
195 'fn-handler-write-region)
|
|
|
196
|
|
|
197 (defun fn-handler-verify-visited-file-modtime (buffer)
|
|
|
198 "Documented as original"
|
|
|
199 (let* ((file (buffer-file-name buffer))
|
|
|
200 (handler (and file (find-file-name-handler
|
|
|
201 file
|
|
|
202 'verify-visited-file-modtime))))
|
|
|
203 (if handler
|
|
|
204 (funcall handler 'verify-visited-file-modtime buffer)
|
|
|
205 (let (file-name-handler-alist)
|
|
|
206 (fn-handler-real-verify-visited-file-modtime buffer)))))
|
|
|
207
|
|
|
208 (efs-overwrite-fn "fn-handler" 'verify-visited-file-modtime
|
|
|
209 'fn-handler-verify-visited-file-modtime)
|
|
|
210
|
|
|
211 (defun fn-handler-backup-buffer ()
|
|
|
212 "Documented as original"
|
|
|
213 (let ((handler (and buffer-file-name
|
|
|
214 (find-file-name-handler buffer-file-name
|
|
|
215 'backup-buffer))))
|
|
|
216 (if handler
|
|
|
217 (funcall handler 'backup-buffer)
|
|
|
218 ;; Don't let-bind file-name-handler-alist to nil, as backup-buffer
|
|
|
219 ;; is a lisp function and I want handlers to be available inside it.
|
|
|
220 (fn-handler-real-backup-buffer))))
|
|
|
221
|
|
|
222 (efs-overwrite-fn "fn-handler" 'backup-buffer 'fn-handler-backup-buffer)
|
|
|
223
|
|
|
224 (defun fn-handler-copy-file (filename newname &optional ok-if-already-exists
|
|
|
225 keep-date)
|
|
|
226 "Documented as original"
|
|
|
227 ;; handler for filename takes precedence over the handler for newname.
|
|
|
228 (interactive
|
|
|
229 (let* ((from (read-file-name "Copy file: " nil nil t))
|
|
|
230 (to (read-file-name (format "Copy %s to: " (abbreviate-file-name
|
|
|
231 from)))))
|
|
|
232 (list from to 0 current-prefix-arg)))
|
|
|
233 (let* ((filename (expand-file-name filename))
|
|
|
234 (newname (expand-file-name newname))
|
|
|
235 (handler (or (find-file-name-handler filename 'copy-file)
|
|
|
236 (find-file-name-handler newname 'copy-file))))
|
|
|
237 (if handler
|
|
|
238 ;; Using the NOWAIT arg is a bit risky for other users of the
|
|
|
239 ;; handler-alist
|
|
|
240 (funcall handler 'copy-file filename newname ok-if-already-exists
|
|
|
241 keep-date)
|
|
|
242 (let (file-name-handler-alist)
|
|
|
243 (fn-handler-real-copy-file filename newname ok-if-already-exists
|
|
|
244 keep-date)))))
|
|
|
245
|
|
|
246 (efs-overwrite-fn "fn-handler" 'copy-file 'fn-handler-copy-file)
|
|
|
247
|
|
|
248 (defun fn-handler-file-newer-than-file-p (file1 file2)
|
|
|
249 "Documented as original"
|
|
|
250 ;; The handler for file2 takes precedence over the handler for file1.
|
|
|
251 (let* ((file1 (expand-file-name file1))
|
|
|
252 (file2 (expand-file-name file2))
|
|
|
253 (handler (or (find-file-name-handler file2 'file-newer-than-file-p)
|
|
|
254 (find-file-name-handler file1 'file-newer-than-file-p))))
|
|
|
255 (if handler
|
|
|
256 (funcall handler 'file-newer-than-file-p file1 file2)
|
|
|
257 (let (file-name-handler-alist)
|
|
|
258 (fn-handler-real-file-newer-than-file-p file1 file2)))))
|
|
|
259
|
|
|
260 (efs-overwrite-fn "fn-handler" 'file-newer-than-file-p
|
|
|
261 'fn-handler-file-newer-than-file-p)
|
|
|
262
|
|
|
263 (defun fn-handler-file-attributes (file)
|
|
|
264 "Documented as original"
|
|
|
265 (let* ((file (expand-file-name file))
|
|
|
266 (handler (find-file-name-handler file 'file-attributes)))
|
|
|
267 (if handler
|
|
|
268 (funcall handler 'file-attributes file)
|
|
|
269 (let (file-name-handler-alist)
|
|
|
270 (fn-handler-real-file-attributes file)))))
|
|
|
271
|
|
|
272 (efs-overwrite-fn "fn-handler" 'file-attributes 'fn-handler-file-attributes)
|
|
|
273
|
|
|
274 (defun fn-handler-file-name-directory (file)
|
|
|
275 "Documented as original"
|
|
|
276 (let ((handler (find-file-name-handler file 'file-name-directory)))
|
|
|
277 (if handler
|
|
|
278 (funcall handler 'file-name-directory file)
|
|
|
279 (let (file-name-handler-alist)
|
|
|
280 (fn-handler-real-file-name-directory file)))))
|
|
|
281
|
|
|
282 (efs-overwrite-fn "fn-handler" 'file-name-directory
|
|
|
283 'fn-handler-file-name-directory)
|
|
|
284
|
|
|
285 (defun fn-handler-rename-file (filename newname &optional ok-if-already-exists)
|
|
|
286 "Documented as original"
|
|
|
287 (interactive
|
|
|
288 (let* ((from (read-file-name "Rename file: " nil nil t))
|
|
|
289 (to (read-file-name (format "Rename %s to: " (abbreviate-file-name
|
|
|
290 from)))))
|
|
|
291 (list from to 0)))
|
|
|
292 (let* ((filename (expand-file-name filename))
|
|
|
293 (newname (expand-file-name newname))
|
|
|
294 (handler (or (find-file-name-handler filename 'rename-file)
|
|
|
295 (find-file-name-handler newname 'rename-file))))
|
|
|
296 (if handler
|
|
|
297 (funcall handler 'rename-file filename newname ok-if-already-exists)
|
|
|
298 (let (file-name-handler-alist)
|
|
|
299 (fn-handler-real-rename-file filename newname ok-if-already-exists)))))
|
|
|
300
|
|
|
301 (efs-overwrite-fn "fn-handler" 'rename-file 'fn-handler-rename-file)
|
|
|
302
|
|
|
303 (defun fn-handler-insert-directory (file switches
|
|
|
304 &optional wildcard full-directory-p)
|
|
|
305 "Documented as original"
|
|
|
306 (let* ((file (expand-file-name file))
|
|
|
307 (handler (find-file-name-handler file 'insert-directory)))
|
|
|
308 (if handler
|
|
|
309 (funcall handler 'insert-directory file switches wildcard
|
|
|
310 full-directory-p)
|
|
|
311 (let (file-name-handler-alist)
|
|
|
312 (fn-handler-real-insert-directory file switches wildcard
|
|
|
313 full-directory-p)))))
|
|
|
314
|
|
|
315 (efs-overwrite-fn "fn-handler" 'insert-directory 'fn-handler-insert-directory)
|
|
|
316
|
|
|
317 (defun fn-handler-set-visited-file-modtime (&optional time)
|
|
|
318 "Sets the buffer's record of file modtime to the modtime of buffer-file-name.
|
|
|
319 With optional TIME, sets the modtime to TIME. This is an emacs 19 function.
|
|
|
320 In emacs 18, efs will make this work for remote files only."
|
|
|
321 (if buffer-file-name
|
|
|
322 (let ((handler (find-file-name-handler buffer-file-name
|
|
|
323 'set-visited-file-modtime)))
|
|
|
324 (if handler
|
|
|
325 (funcall handler 'set-visited-file-modtime time)
|
|
|
326 (let (file-name-handler-alist)
|
|
|
327 (fn-handler-real-set-visited-file-modtime time))))))
|
|
|
328
|
|
|
329 (efs-overwrite-fn "fn-handler" 'set-visited-file-modtime
|
|
|
330 'fn-handler-set-visited-file-modtime)
|
|
|
331
|
|
|
332 (defun fn-handler-file-name-nondirectory (name)
|
|
|
333 "Documented as original"
|
|
|
334 (let ((handler (find-file-name-handler name 'file-name-nondirectory)))
|
|
|
335 (if handler
|
|
|
336 (funcall handler 'file-name-nondirectory name)
|
|
|
337 (let (file-name-handler-alist)
|
|
|
338 (fn-handler-real-file-name-nondirectory name)))))
|
|
|
339
|
|
|
340 (efs-overwrite-fn "fn-handler" 'file-name-nondirectory
|
|
|
341 'fn-handler-file-name-nondirectory)
|
|
|
342
|
|
|
343 (defun fn-handler-file-name-as-directory (name)
|
|
|
344 "Documented as original"
|
|
|
345 (let ((handler (find-file-name-handler name 'file-name-as-directory)))
|
|
|
346 (if handler
|
|
|
347 (funcall handler 'file-name-as-directory name)
|
|
|
348 (let (file-name-handler-alist)
|
|
|
349 (fn-handler-real-file-name-as-directory name)))))
|
|
|
350
|
|
|
351 (efs-overwrite-fn "fn-handler" 'file-name-as-directory
|
|
|
352 'fn-handler-file-name-as-directory)
|
|
|
353
|
|
|
354 (defun fn-handler-directory-file-name (directory)
|
|
|
355 "Documented as original"
|
|
|
356 (let ((handler (find-file-name-handler directory 'directory-file-name)))
|
|
|
357 (if handler
|
|
|
358 (funcall handler 'directory-file-name directory)
|
|
|
359 (let (file-name-handler-alist)
|
|
|
360 (fn-handler-real-directory-file-name directory)))))
|
|
|
361
|
|
|
362 (efs-overwrite-fn "fn-handler" 'directory-file-name
|
|
|
363 'fn-handler-directory-file-name)
|
|
|
364
|
|
|
365 (defun fn-handler-get-file-buffer (file)
|
|
|
366 "Documented as original"
|
|
|
367 (let ((handler (find-file-name-handler file 'get-file-buffer)))
|
|
|
368 (if handler
|
|
|
369 (funcall handler 'get-file-buffer file)
|
|
|
370 (let (file-name-handler-alist)
|
|
|
371 (fn-handler-real-get-file-buffer file)))))
|
|
|
372
|
|
|
373 (efs-overwrite-fn "fn-handler" 'get-file-buffer 'fn-handler-get-file-buffer)
|
|
|
374
|
|
|
375 (defun fn-handler-create-file-buffer (file)
|
|
|
376 "Documented as original"
|
|
|
377 (let ((handler (find-file-name-handler file 'create-file-buffer)))
|
|
|
378 (if handler
|
|
|
379 (funcall handler 'create-file-buffer file)
|
|
|
380 (let (file-name-handler-alist)
|
|
|
381 (fn-handler-real-create-file-buffer file)))))
|
|
|
382
|
|
|
383 (efs-overwrite-fn "fn-handler" 'create-file-buffer
|
|
|
384 'fn-handler-create-file-buffer)
|
|
|
385
|
|
|
386 (defun fn-handler-set-file-modes (file mode)
|
|
|
387 "Documented as original"
|
|
|
388 (let* ((file (expand-file-name file))
|
|
|
389 (handler (find-file-name-handler file 'set-file-modes)))
|
|
|
390 (if handler
|
|
|
391 (funcall handler 'set-file-modes file mode)
|
|
|
392 (let (file-name-handler-alist)
|
|
|
393 (fn-handler-real-set-file-modes file mode)))))
|
|
|
394
|
|
|
395 (efs-overwrite-fn "fn-handler" 'set-file-modes 'fn-handler-set-file-modes)
|
|
|
396
|
|
|
397 (defun fn-handler-file-modes (file)
|
|
|
398 "Documented as original"
|
|
|
399 (let* ((file (expand-file-name file))
|
|
|
400 (handler (find-file-name-handler file 'file-modes)))
|
|
|
401 (if handler
|
|
|
402 (funcall handler 'file-modes file)
|
|
|
403 (let (file-name-handler-alist)
|
|
|
404 (fn-handler-real-file-modes file)))))
|
|
|
405
|
|
|
406 (efs-overwrite-fn "fn-handler" 'file-modes 'fn-handler-file-modes)
|
|
|
407
|
|
|
408 (if (string-match emacs-version "Lucid")
|
|
|
409
|
|
|
410 (progn
|
|
|
411 (defun fn-handler-abbreviate-file-name (filename &optional hack-homedir)
|
|
|
412 "Documented as original"
|
|
|
413 (let ((handler (find-file-name-handler filename
|
|
|
414 'abbreviate-file-name)))
|
|
|
415 (if handler
|
|
|
416 (funcall handler 'abbreviate-file-name filename hack-homedir)
|
|
|
417 (let (file-name-handler-alist)
|
|
|
418 (fn-handler-real-abbreviate-file-name filename hack-homedir))))))
|
|
|
419
|
|
|
420 (defun fn-handler-abbreviate-file-name (filename)
|
|
|
421 "Documented as original"
|
|
|
422 (let ((handler (find-file-name-handler filename 'abbreviate-file-name)))
|
|
|
423 (if handler
|
|
|
424 (funcall handler 'abbreviate-file-name filename)
|
|
|
425 (let (file-name-handler-alist)
|
|
|
426 (fn-handler-real-abbreviate-file-name filename))))))
|
|
|
427
|
|
|
428 (efs-overwrite-fn "fn-handler" 'abbreviate-file-name
|
|
|
429 'fn-handler-abbreviate-file-name)
|
|
|
430
|
|
|
431 (defun fn-handler-file-name-sans-versions (filename
|
|
|
432 &optional keep-backup-version)
|
|
|
433 "Documented as original"
|
|
|
434 (let ((handler (find-file-name-handler filename 'file-name-sans-versions)))
|
|
|
435 (if handler
|
|
|
436 (funcall handler 'file-name-sans-versions filename
|
|
|
437 keep-backup-version)
|
|
|
438 (let (file-name-handler-alist)
|
|
|
439 (fn-handler-real-file-name-sans-versions filename
|
|
|
440 keep-backup-version)))))
|
|
|
441
|
|
|
442 (efs-overwrite-fn "fn-handler" 'file-name-sans-versions
|
|
|
443 'fn-handler-file-name-sans-versions)
|
|
|
444
|
|
|
445 (if (fboundp 'make-directory-internal) ; not defined in lemacs 19.[67]
|
|
|
446 (progn
|
|
|
447 (defun fn-handler-make-directory-internal (dirname)
|
|
|
448 "Documented as original"
|
|
|
449 (let* ((dirname (expand-file-name dirname))
|
|
|
450 (handler (find-file-name-handler dirname
|
|
|
451 'make-directory-internal)))
|
|
|
452 (if handler
|
|
|
453 (funcall handler 'make-directory-internal dirname)
|
|
|
454 (let (file-name-handler-alist)
|
|
|
455 (fn-handler-real-make-directory-internal dirname)))))
|
|
|
456
|
|
|
457 (efs-overwrite-fn "fn-handler" 'make-directory-internal
|
|
|
458 'fn-handler-make-directory-internal)))
|
|
|
459
|
|
|
460 (defun fn-handler-delete-directory (dirname)
|
|
|
461 "Documented as original"
|
|
|
462 (let* ((dirname (expand-file-name dirname))
|
|
|
463 (handler (find-file-name-handler dirname 'delete-directory)))
|
|
|
464 (if handler
|
|
|
465 (funcall handler 'delete-directory dirname)
|
|
|
466 (let (file-name-handler-alist)
|
|
|
467 (fn-handler-real-delete-directory dirname)))))
|
|
|
468
|
|
|
469 (efs-overwrite-fn "fn-handler" 'delete-directory 'fn-handler-delete-directory)
|
|
|
470
|
|
|
471 (defun fn-handler-make-symbolic-link (target linkname
|
|
|
472 &optional ok-if-already-exists)
|
|
|
473 "Documented as original"
|
|
|
474 (interactive
|
|
|
475 (let (target)
|
|
|
476 (list
|
|
|
477 (setq target (read-string "Make symbolic link to file: "))
|
|
|
478 (read-file-name (format "Make symbolic link to file %s: " target))
|
|
|
479 0)))
|
|
|
480 (let* ((linkname (expand-file-name linkname))
|
|
|
481 (handler (or (find-file-name-handler linkname 'make-symbolic-link)
|
|
|
482 (find-file-name-handler target 'make-symbolic-link))))
|
|
|
483 (if handler
|
|
|
484 (funcall handler 'make-symbolic-link
|
|
|
485 target linkname ok-if-already-exists)
|
|
|
486 (let (file-name-handler-alist)
|
|
|
487 (fn-handler-real-make-symbolic-link target linkname
|
|
|
488 ok-if-already-exists)))))
|
|
|
489
|
|
|
490 (efs-overwrite-fn "fn-handler" 'make-symbolic-link
|
|
|
491 'fn-handler-make-symbolic-link)
|
|
|
492
|
|
|
493 (defun fn-handler-add-name-to-file (file newname &optional
|
|
|
494 ok-if-already-exists)
|
|
|
495 "Documented as original"
|
|
|
496 (interactive
|
|
|
497 (let (file)
|
|
|
498 (list
|
|
|
499 (setq file (read-file-name "Add name to file: " nil nil t))
|
|
|
500 (read-file-name (format "Name to add to %s: " file))
|
|
|
501 0)))
|
|
|
502 (let* ((file (expand-file-name file))
|
|
|
503 (newname (expand-file-name newname))
|
|
|
504 (handler (or (find-file-name-handler newname 'add-name-to-file)
|
|
|
505 (find-file-name-handler file 'add-name-to-file))))
|
|
|
506 (if handler
|
|
|
507 (funcall handler 'add-name-to-file file newname ok-if-already-exists)
|
|
|
508 (let (file-name-handler-alist)
|
|
|
509 (fn-handler-real-add-name-to-file file newname
|
|
|
510 ok-if-already-exists)))))
|
|
|
511
|
|
|
512 (efs-overwrite-fn "fn-handler" 'add-name-to-file 'fn-handler-add-name-to-file)
|
|
|
513
|
|
|
514 (defun fn-handler-recover-file (file)
|
|
|
515 "Documented as original"
|
|
|
516 (interactive "FRecover file: ")
|
|
|
517 (let* ((file (expand-file-name file))
|
|
|
518 (handler (or (find-file-name-handler file 'recover-file)
|
|
|
519 (find-file-name-handler (let ((buffer-file-name file))
|
|
|
520 (make-auto-save-file-name))
|
|
|
521 'recover-file))))
|
|
|
522 (if handler
|
|
|
523 (funcall handler 'recover-file file)
|
|
|
524 (let (file-name-handler-alist)
|
|
|
525 (fn-handler-real-recover-file file)))))
|
|
|
526
|
|
|
527 (efs-overwrite-fn "fn-handler" 'recover-file 'fn-handler-recover-file)
|
|
|
528
|
|
|
529 (defun fn-handler-file-name-completion (file dir)
|
|
|
530 "Documented as original."
|
|
|
531 (let* ((dir (expand-file-name dir))
|
|
|
532 (handler (find-file-name-handler dir 'file-name-completion)))
|
|
|
533 (if handler
|
|
|
534 (funcall handler 'file-name-completion file dir)
|
|
|
535 (let (file-name-handler-alist)
|
|
|
536 (fn-handler-real-file-name-completion file dir)))))
|
|
|
537
|
|
|
538 (efs-overwrite-fn "fn-handler" 'file-name-completion
|
|
|
539 'fn-handler-file-name-completion)
|
|
|
540
|
|
|
541 (defun fn-handler-file-name-all-completions (file dir)
|
|
|
542 "Documented as original."
|
|
|
543 (let* ((dir (expand-file-name dir))
|
|
|
544 (handler (find-file-name-handler dir 'file-name-all-completions)))
|
|
|
545 (if handler
|
|
|
546 (funcall handler 'file-name-all-completions file dir)
|
|
|
547 (let (file-name-handler-alist)
|
|
|
548 (fn-handler-real-file-name-all-completions file dir)))))
|
|
|
549
|
|
|
550 (efs-overwrite-fn "fn-handler" 'file-name-all-completions
|
|
|
551 'fn-handler-file-name-all-completions)
|
|
|
552
|
|
|
553 (if (fboundp 'file-truename)
|
|
|
554 (progn
|
|
|
555 (defun fn-handler-file-truename (filename)
|
|
|
556 "Documented as original"
|
|
|
557 (let* ((fn (expand-file-name filename))
|
|
|
558 (handler (find-file-name-handler filename 'file-truename)))
|
|
|
559 (if handler
|
|
|
560 (funcall handler 'file-truename filename)
|
|
|
561 (let (file-name-handler-alist)
|
|
|
562 (fn-handler-real-file-truename filename)))))
|
|
|
563 (efs-overwrite-fn "fn-handler" 'file-truename
|
|
|
564 'fn-handler-file-truename)))
|
|
|
565
|
|
|
566 (if (fboundp 'unhandled-file-name-directory)
|
|
|
567 (progn
|
|
|
568 (defun fn-handler-unhandled-file-name-directory (filename)
|
|
|
569 "Documented as original"
|
|
|
570 (let ((handler (find-file-name-handler
|
|
|
571 filename 'unhandled-file-name-directory)))
|
|
|
572 (if handler
|
|
|
573 (funcall handler 'unhandled-file-name-directory filename)
|
|
|
574 (let (file-name-handler-alist)
|
|
|
575 (fn-handler-real-unhandled-file-name-directory filename)))))
|
|
|
576
|
|
|
577 (efs-overwrite-fn "fn-handler" 'unhandled-file-name-directory
|
|
|
578 'fn-handler-unhandled-file-name-directory)))
|
|
|
579
|
|
|
580
|
|
|
581 ;; We don't need the file-name-handler-alist for these. Inhibit it to
|
|
|
582 ;; avoid an infinite recursion. Hope that this doesn't step
|
|
|
583 ;; on any other packages' toes.
|
|
|
584 (defun fn-handler-expand-file-name (filename &optional default)
|
|
|
585 "Documented as original."
|
|
|
586 (let (file-name-handler-alist)
|
|
|
587 (fn-handler-real-expand-file-name filename default)))
|
|
|
588
|
|
|
589 (efs-overwrite-fn "fn-handler" 'expand-file-name 'fn-handler-expand-file-name)
|
|
|
590
|
|
|
591 (defun fn-handler-substitute-in-file-name (filename)
|
|
|
592 "Documented as original."
|
|
|
593 (let ((handler (find-file-name-handler filename 'substitute-in-file-name)))
|
|
|
594 (if handler
|
|
|
595 (funcall handler 'substitute-in-file-name filename)
|
|
|
596 (let (file-name-handler-alist)
|
|
|
597 (fn-handler-real-substitute-in-file-name filename)))))
|
|
|
598
|
|
|
599 (efs-overwrite-fn "fn-handler" 'substitute-in-file-name
|
|
|
600 'fn-handler-substitute-in-file-name)
|
|
|
601
|
|
|
602 (if (fboundp 'file-executable-p)
|
|
|
603 (progn
|
|
|
604 (defun fn-handler-file-executable-p (file)
|
|
|
605 (let ((handler (find-file-name-handler file 'file-executable-p)))
|
|
|
606 (if handler
|
|
|
607 (funcall handler 'file-executable-p file)
|
|
|
608 (let (file-name-handler-alist)
|
|
|
609 (fn-handler-real-file-executable-p file)))))
|
|
|
610 (efs-overwrite-fn "fn-handler" 'file-executable-p
|
|
|
611 'fn-handler-file-executable-p)))
|
|
|
612
|
|
|
613 (if (fboundp 'file-accessible-directory-p)
|
|
|
614 (progn
|
|
|
615 (defun fn-handler-file-accessible-directory-p (file)
|
|
|
616 (let ((handler (find-file-name-handler file
|
|
|
617 'file-accessible-directory-p)))
|
|
|
618 (if handler
|
|
|
619 (funcall handler 'file-accessible-directory-p file)
|
|
|
620 (let (file-name-handler-alist)
|
|
|
621 (fn-handler-real-file-accessible-directory-p file)))))
|
|
|
622 (efs-overwrite-fn "fn-handler" 'file-accessible-directory-p
|
|
|
623 'fn-handler-file-accessible-directory-p)))
|
|
|
624
|
|
|
625 (defun fn-handler-load (file &optional noerror nomessage nosuffix)
|
|
|
626 (let ((handler (find-file-name-handler file 'load)))
|
|
|
627 (if handler
|
|
|
628 (funcall handler 'load file noerror nomessage nosuffix)
|
|
|
629 (let (file-name-handler-alist)
|
|
|
630 (fn-handler-real-load file noerror nomessage nosuffix)))))
|
|
|
631
|
|
|
632 (efs-overwrite-fn "fn-handler" 'load 'fn-handler-load)
|
|
|
633
|
|
|
634 ;; We don't need file-name-handlers for do-auto-save.
|
|
|
635 ;; If it does try to access them there is a risk of an infinite recursion.
|
|
|
636 (defun fn-handler-do-auto-save (&rest args)
|
|
|
637 "Documented as original."
|
|
|
638 (let (file-name-handler-alist)
|
|
|
639 (apply 'fn-handler-real-do-auto-save args)))
|
|
|
640
|
|
|
641 (efs-overwrite-fn "fn-handler" 'do-auto-save 'fn-handler-do-auto-save)
|
|
|
642
|
|
|
643 (if (fboundp 'vc-registered)
|
|
|
644 (progn
|
|
|
645 (defun fn-handler-vc-registered (file)
|
|
|
646 "Documented as original."
|
|
|
647 (let ((handler (find-file-name-handler file 'vc-registered)))
|
|
|
648 (if handler
|
|
|
649 (funcall handler 'vc-registered file)
|
|
|
650 (let (file-name-handler-alist)
|
|
|
651 (fn-handler-real-vc-registered file)))))
|
|
|
652
|
|
|
653 (efs-overwrite-fn "fn-handler" 'vc-registered
|
|
|
654 'fn-handler-vc-registered)))
|
|
|
655
|
|
|
656 ;;; end of fn-handler.el
|
