23
23
24
24
; ;; Code:
25
25
26
- ; ; (require 'url)
27
26
(require 'url-parse )
28
- ; ; (require 'url-util)
29
27
(eval-when-compile (require 'mm-decode ))
30
- ; ; (require 'mailcap)
31
28
(eval-when-compile (require 'subr-x ))
32
29
; ; The following are autoloaded instead of `require' d to avoid eagerly
33
30
; ; loading all of URL when turning on url-handler-mode in the .emacs.
34
- (autoload 'url-expand-file-name " url-expand" " Convert url to a fully specified url, and canonicalize it." )
35
- (autoload 'mm-dissect-buffer " mm-decode" " Dissect the current buffer and return a list of MIME handles." )
36
- (autoload 'url-scheme-get-property " url-methods" " Get property of a URL SCHEME." )
31
+ (autoload 'url-expand-file-name " url-expand"
32
+ " Convert URL to a fully specified URL, and canonicalize it." )
33
+ (autoload 'mm-dissect-buffer " mm-decode"
34
+ " Dissect the current buffer and return a list of MIME handles." )
35
+ (autoload 'url-scheme-get-property " url-methods"
36
+ " Get PROPERTY of a URL SCHEME." )
37
37
38
38
; ; Always used after mm-dissect-buffer and defined in the same file.
39
39
(declare-function mm-save-part-to-file " mm-decode" (handle file))
112
112
(push (cons url-handler-regexp 'url-file-handler )
113
113
file-name-handler-alist)))
114
114
115
- (defcustom url-handler-regexp " \\ `\\ (https?\\ |ftp\\ |file\\ |nfs\\ |ssh\\ |scp\\ |rsync\\ |telnet\\ )://"
115
+ (defcustom url-handler-regexp
116
+ " \\ `\\ (?:https?\\ |ftp\\ |file\\ |nfs\\ |ssh\\ |scp\\ |rsync\\ |telnet\\ )://"
116
117
" Regular expression for URLs handled by `url-handler-mode' .
117
118
When URL Handler mode is enabled, this regular expression is
118
119
added to `file-name-handler-alist' .
119
120
120
121
Some valid URL protocols just do not make sense to visit
121
- interactively \ ( about, data, info, irc, mailto, etc.). This
122
+ interactively (about, data, info, irc, mailto, etc.). This
122
123
regular expression avoids conflicts with local files that look
123
- like URLs \ ( Gnus is particularly bad at this)."
124
+ like URLs (Gnus is particularly bad at this)."
124
125
:group 'url
125
126
:type 'regexp
126
127
:version " 25.1"
@@ -144,57 +145,55 @@ like URLs \(Gnus is particularly bad at this)."
144
145
;;;### autoload
145
146
(defun url-file-handler (operation &rest args )
146
147
" Function called from the `file-name-handler-alist' routines.
147
- OPERATION is what needs to be done (`file-exists-p' , etc). ARGS are
148
- the arguments that would have been passed to OPERATION."
148
+ OPERATION is what needs to be done (`file-exists-p' , etc.).
149
+ ARGS are the arguments that would have been passed to OPERATION."
149
150
; ; Avoid recursive load.
150
151
(if (and load-in-progress url-file-handler-load-in-progress)
151
152
(url-run-real-handler operation args)
152
153
(let ((url-file-handler-load-in-progress load-in-progress))
153
154
; ; Check, whether there are arguments we want pass to Tramp.
154
155
(if (catch :do
155
156
(dolist (url (cons default-directory args))
156
- (and (member
157
- (url-type (url-generic-parse-url ( and ( stringp url) url) ))
158
- url-tramp-protocols)
157
+ (and (stringp url)
158
+ ( member (url-type (url-generic-parse-url url))
159
+ url-tramp-protocols)
159
160
(throw :do t ))))
160
- (apply 'url-tramp-file-handler operation args)
161
+ (apply # 'url-tramp-file-handler operation args)
161
162
; ; Otherwise, let's do the job.
162
163
(let ((fn (get operation 'url-file-handlers ))
163
- (val nil )
164
- (hooked nil ))
165
- (if (and (not fn) (intern-soft (format " url-%s " operation))
164
+ val)
165
+ (if (and (not fn)
166
166
(fboundp (intern-soft (format " url-%s " operation))))
167
167
(error " Missing URL handler mapping for %s " operation))
168
- (if fn
169
- (setq hooked t
170
- val (save-match-data (apply fn args)))
171
- (setq hooked nil
172
- val (url-run-real-handler operation args)))
173
- (url-debug 'handlers " %s %S%S => %S" (if hooked " Hooked" " Real" )
168
+ (setq val (if fn (save-match-data (apply fn args))
169
+ (url-run-real-handler operation args)))
170
+ (url-debug 'handlers " %s %S%S => %S" (if fn " Hooked" " Real" )
174
171
operation args val)
175
172
val)))))
176
173
177
- (defun url-file-handler-identity (&rest args )
178
- ; ; Identity function
179
- (car args))
180
-
181
- ; ; These are operations that we can fully support
182
- (put 'file-readable-p 'url-file-handlers 'url-file-exists-p )
183
- (put 'substitute-in-file-name 'url-file-handlers 'url-file-handler-identity )
184
- (put 'file-name-absolute-p 'url-file-handlers (lambda (&rest ignored ) t ))
185
- (put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name )
186
- (put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name )
187
- (put 'file-name-directory 'url-file-handlers 'url-handler-file-name-directory )
188
- (put 'unhandled-file-name-directory 'url-file-handlers 'url-handler-unhandled-file-name-directory )
189
- (put 'file-remote-p 'url-file-handlers 'url-handler-file-remote-p )
190
- ; ; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory)
174
+ (defun url-file-handler-identity (arg &rest _ignored )
175
+ ; ; Identity function.
176
+ arg)
177
+
178
+ ; ; These are operations that we can fully support.
179
+ (put 'file-readable-p 'url-file-handlers #'url-file-exists-p )
180
+ (put 'substitute-in-file-name 'url-file-handlers #'url-file-handler-identity )
181
+ (put 'file-name-absolute-p 'url-file-handlers (lambda (&rest _ignored ) t ))
182
+ (put 'expand-file-name 'url-file-handlers #'url-handler-expand-file-name )
183
+ (put 'directory-file-name 'url-file-handlers #'url-handler-directory-file-name )
184
+ (put 'file-name-directory 'url-file-handlers #'url-handler-file-name-directory )
185
+ (put 'unhandled-file-name-directory 'url-file-handlers
186
+ #'url-handler-unhandled-file-name-directory )
187
+ (put 'file-remote-p 'url-file-handlers #'url-handler-file-remote-p )
188
+ ; ; (put 'file-name-as-directory 'url-file-handlers
189
+ ; ; #'url-handler-file-name-as-directory)
191
190
192
191
; ; These are operations that we do not support yet (DAV!!!)
193
- (put 'file-writable-p 'url-file-handlers 'ignore )
194
- (put 'file-symlink-p 'url-file-handlers 'ignore )
192
+ (put 'file-writable-p 'url-file-handlers # 'ignore )
193
+ (put 'file-symlink-p 'url-file-handlers # 'ignore )
195
194
; ; Just like for ange-ftp: let's not waste time trying to look for RCS/foo,v
196
195
; ; files and such since we can't do anything clever with them anyway.
197
- (put 'vc-registered 'url-file-handlers 'ignore )
196
+ (put 'vc-registered 'url-file-handlers # 'ignore )
198
197
199
198
(defun url-handler-expand-file-name (file &optional base )
200
199
; ; When we see "/foo/bar" in a file whose working dir is "http://bla/bla",
@@ -215,7 +214,7 @@ the arguments that would have been passed to OPERATION."
215
214
; ; reversible: (f-n-a-d (d-f-n (f-n-a-d X))) == (f-n-a-d X)
216
215
(defun url-handler-directory-file-name (dir )
217
216
; ; When there's more than a single /, just don't touch the slashes at all.
218
- (if (string-match " //\\ ' " dir) dir
217
+ (if (string-suffix-p " //" dir) dir
219
218
(url-run-real-handler 'directory-file-name (list dir))))
220
219
221
220
(defun url-handler-unhandled-file-name-directory (filename )
@@ -257,44 +256,42 @@ the arguments that would have been passed to OPERATION."
257
256
; ; `url-handler-unhandled-file-name-directory' .
258
257
nil )))
259
258
260
- ; ; The actual implementation
259
+ ; ; The actual implementation.
261
260
;;;### autoload
262
- (defun url-copy-file (url newname &optional ok-if-already-exists
263
- _keep-time _preserve-uid-gid _preserve-permissions )
264
- " Copy URL to NEWNAME. Both args must be strings.
265
- Signal a `file-already-exists' error if file NEWNAME already exists,
266
- unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
267
- A number as third arg means request confirmation if NEWNAME already exists.
268
- This is what happens in interactive use with M-x.
269
- Fourth arg KEEP-TIME non-nil means give the new file the same
270
- last-modified time as the old one. (This works on only some systems.)
271
- Args PRESERVE-UID-GID and PRESERVE-PERMISSIONS are ignored.
272
- A prefix arg makes KEEP-TIME non-nil."
273
- (if (and (file-exists-p newname)
274
- (not ok-if-already-exists))
275
- (signal 'file-already-exists (list " File exists" newname)))
276
- (let ((buffer (url-retrieve-synchronously url))
277
- (handle nil ))
278
- (if (not buffer)
279
- (signal 'file-missing (list " Opening URL" " No such file or directory"
280
- url)))
281
- (with-current-buffer buffer
282
- (setq handle (mm-dissect-buffer t )))
261
+ (defun url-copy-file (url newname &optional ok-if-already-exists &rest _ignored )
262
+ " Copy URL to NEWNAME. Both arguments must be strings.
263
+ Signal a `file-already-exists' error if file NEWNAME already
264
+ exists, unless a third argument OK-IF-ALREADY-EXISTS is supplied
265
+ and non-nil. An integer as third argument means request
266
+ confirmation if NEWNAME already exists."
267
+ (and (file-exists-p newname)
268
+ (or (not ok-if-already-exists)
269
+ (and (integerp ok-if-already-exists)
270
+ (not (yes-or-no-p
271
+ (format " File %s already exists; copy to it anyway? "
272
+ newname)))))
273
+ (signal 'file-already-exists (list " File already exists" newname)))
274
+ (let* ((buffer (or (url-retrieve-synchronously url)
275
+ (signal 'file-missing
276
+ (list " Opening URL"
277
+ " No such file or directory" url))))
278
+ (handle (with-current-buffer buffer
279
+ (mm-dissect-buffer t ))))
283
280
(let ((mm-attachment-file-modes (default-file-modes )))
284
281
(mm-save-part-to-file handle newname))
285
282
(kill-buffer buffer)
286
283
(mm-destroy-parts handle)))
287
- (put 'copy-file 'url-file-handlers 'url-copy-file )
284
+ (put 'copy-file 'url-file-handlers # 'url-copy-file )
288
285
289
286
;;;### autoload
290
- (defun url-file-local-copy (url &rest ignored )
287
+ (defun url-file-local-copy (url &rest _ignored )
291
288
" Copy URL into a temporary file on this machine.
292
289
Returns the name of the local copy, or nil, if FILE is directly
293
290
accessible."
294
291
(let ((filename (make-temp-file " url" )))
295
292
(url-copy-file url filename 'ok-if-already-exists )
296
293
filename))
297
- (put 'file-local-copy 'url-file-handlers 'url-file-local-copy )
294
+ (put 'file-local-copy 'url-file-handlers # 'url-file-local-copy )
298
295
299
296
(defun url-insert (buffer &optional beg end )
300
297
" Insert the body of a URL object.
@@ -330,8 +327,8 @@ This is like `url-insert', but also decodes the current buffer as
330
327
if it had been inserted from a file named URL."
331
328
(if visit (setq buffer-file-name url))
332
329
(save-excursion
333
- (let* ((start (point ))
334
- (size-and-charset (url-insert buffer beg end)))
330
+ (let ((start (point ))
331
+ (size-and-charset (url-insert buffer beg end)))
335
332
(kill-buffer buffer)
336
333
(when replace
337
334
(delete-region (point-min ) start)
@@ -342,10 +339,9 @@ if it had been inserted from a file named URL."
342
339
(decode-coding-inserted-region (point-min ) (point ) url
343
340
visit beg end replace))
344
341
(let ((inserted (car size-and-charset)))
345
- (when (fboundp 'after-insert-file-set-coding )
346
- (let ((insval (after-insert-file-set-coding inserted visit)))
347
- (if insval (setq inserted insval))))
348
- (list url inserted)))))
342
+ (list url (or (and (fboundp 'after-insert-file-set-coding )
343
+ (after-insert-file-set-coding inserted visit))
344
+ inserted))))))
349
345
350
346
;;;### autoload
351
347
(defun url-insert-file-contents (url &optional visit beg end replace )
@@ -356,23 +352,22 @@ if it had been inserted from a file named URL."
356
352
; ; instead. See bug#17549.
357
353
(url-http--insert-file-helper buffer url visit))
358
354
(url-insert-buffer-contents buffer url visit beg end replace)))
359
-
360
- (put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents )
355
+ (put 'insert-file-contents 'url-file-handlers #'url-insert-file-contents )
361
356
362
357
(defun url-file-name-completion (url _directory &optional _predicate )
363
358
; ; Even if it's not implemented, it's not an error to ask for completion,
364
359
; ; in case it's available (bug#14806).
365
360
; ; (error "Unimplemented")
366
361
url)
367
- (put 'file-name-completion 'url-file-handlers 'url-file-name-completion )
362
+ (put 'file-name-completion 'url-file-handlers # 'url-file-name-completion )
368
363
369
364
(defun url-file-name-all-completions (_file _directory )
370
365
; ; Even if it's not implemented, it's not an error to ask for completion,
371
366
; ; in case it's available (bug#14806).
372
367
; ; (error "Unimplemented")
373
368
nil )
374
369
(put 'file-name-all-completions
375
- 'url-file-handlers 'url-file-name-all-completions )
370
+ 'url-file-handlers # 'url-file-name-all-completions )
376
371
377
372
; ; All other handlers map onto their respective backends.
378
373
(defmacro url-handlers-create-wrapper (method args )
@@ -382,10 +377,10 @@ if it had been inserted from a file named URL."
382
377
(or (documentation method t ) " No original documentation." ))
383
378
(setq url (url-generic-parse-url url))
384
379
(when (url-type url)
385
- (funcall (url-scheme-get-property (url-type url) ( quote , method) )
386
- ,@(remove '&rest (remove '&optional args)))))
380
+ (funcall (url-scheme-get-property (url-type url) ' , method )
381
+ ,@(remq '&rest (remq '&optional args)))))
387
382
(unless (get ', method 'url-file-handlers )
388
- (put ', method 'url-file-handlers ',(intern (format " url-%s " method))))))
383
+ (put ', method 'url-file-handlers # ' ,(intern (format " url-%s " method))))))
389
384
390
385
(url-handlers-create-wrapper file-exists-p (url))
391
386
(url-handlers-create-wrapper file-attributes (url &optional id-format))
@@ -396,12 +391,12 @@ if it had been inserted from a file named URL."
396
391
(url-handlers-create-wrapper directory-files (url &optional full match nosort))
397
392
(url-handlers-create-wrapper file-truename (url &optional counter prev-dirs))
398
393
399
- (add-hook 'find-file-hook 'url-handlers-set-buffer-mode )
394
+ (add-hook 'find-file-hook # 'url-handlers-set-buffer-mode )
400
395
401
396
(defun url-handlers-set-buffer-mode ()
402
397
" Set correct modes for the current buffer if visiting a remote file."
403
- (and ( stringp buffer-file-name)
404
- (string-match url-handler-regexp buffer-file-name)
398
+ (and buffer-file-name
399
+ (string-match-p url-handler-regexp buffer-file-name)
405
400
(auto-save-mode 0 )))
406
401
407
402
(provide 'url-handlers )
0 commit comments