diff options
| author | Michael Albinus | 2008-02-06 20:34:23 +0000 |
|---|---|---|
| committer | Michael Albinus | 2008-02-06 20:34:23 +0000 |
| commit | a9f31e3df9023b8ee7447f4a4b7fd53b091ca5aa (patch) | |
| tree | 14ade1477a8bd5e9e9b98523ce7fa96c1ee14731 | |
| parent | dce13547790f2d3422597926b6aaf49d56bddaf7 (diff) | |
| download | emacs-a9f31e3df9023b8ee7447f4a4b7fd53b091ca5aa.tar.gz emacs-a9f31e3df9023b8ee7447f4a4b7fd53b091ca5aa.zip | |
* url-handlers.el (file-remote-p): Add handler.
(url-handler-file-remote-p): New fun.
| -rw-r--r-- | lisp/url/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/url/url-handlers.el | 21 |
2 files changed, 26 insertions, 0 deletions
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 11f99ec5280..dca2782b0f5 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2008-02-06 Michael Albinus <michael.albinus@gmx.de> | ||
| 2 | |||
| 3 | * url-handlers.el (file-remote-p): Add handler. | ||
| 4 | (url-handler-file-remote-p): New fun. | ||
| 5 | |||
| 1 | 2008-02-06 Stefan Monnier <monnier@iro.umontreal.ca> | 6 | 2008-02-06 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 7 | ||
| 3 | * url-handlers.el (url-handler-unhandled-file-name-directory): | 8 | * url-handlers.el (url-handler-unhandled-file-name-directory): |
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 088e7a6a534..7fa797e121b 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el | |||
| @@ -73,6 +73,7 @@ | |||
| 73 | ;; file-ownership-preserved-p No way to know | 73 | ;; file-ownership-preserved-p No way to know |
| 74 | ;; file-readable-p Finished | 74 | ;; file-readable-p Finished |
| 75 | ;; file-regular-p !directory_p | 75 | ;; file-regular-p !directory_p |
| 76 | ;; file-remote-p Finished | ||
| 76 | ;; file-symlink-p Needs DAV bindings | 77 | ;; file-symlink-p Needs DAV bindings |
| 77 | ;; file-truename Needs DAV bindings | 78 | ;; file-truename Needs DAV bindings |
| 78 | ;; file-writable-p Check for LOCK? | 79 | ;; file-writable-p Check for LOCK? |
| @@ -151,6 +152,7 @@ the arguments that would have been passed to OPERATION." | |||
| 151 | (put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name) | 152 | (put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name) |
| 152 | (put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name) | 153 | (put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name) |
| 153 | (put 'unhandled-file-name-directory 'url-file-handlers 'url-handler-unhandled-file-name-directory) | 154 | (put 'unhandled-file-name-directory 'url-file-handlers 'url-handler-unhandled-file-name-directory) |
| 155 | (put 'file-remote-p 'url-file-handlers 'url-handler-file-remote-p) | ||
| 154 | ;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory) | 156 | ;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory) |
| 155 | 157 | ||
| 156 | ;; These are operations that we do not support yet (DAV!!!) | 158 | ;; These are operations that we do not support yet (DAV!!!) |
| @@ -194,6 +196,25 @@ the arguments that would have been passed to OPERATION." | |||
| 194 | ;; a local process. | 196 | ;; a local process. |
| 195 | nil))) | 197 | nil))) |
| 196 | 198 | ||
| 199 | (defun url-handler-file-remote-p (filename &optional identification connected) | ||
| 200 | (let ((url (url-generic-parse-url filename))) | ||
| 201 | (if (and (url-type url) (not (equal (url-type url) "file"))) | ||
| 202 | ;; Maybe we can find a suitable check for CONNECTED. For now, | ||
| 203 | ;; we ignore it. | ||
| 204 | (cond | ||
| 205 | ((eq identification 'method) (url-type url)) | ||
| 206 | ((eq identification 'user) (url-user url)) | ||
| 207 | ((eq identification 'host) (url-host url)) | ||
| 208 | ((eq identification 'localname) (url-filename url)) | ||
| 209 | (t (url-recreate-url | ||
| 210 | (url-parse-make-urlobj (url-type url) (url-user url) nil | ||
| 211 | (url-host url) (url-port url))))) | ||
| 212 | ;; If there is no URL type, or it is a "file://" URL, the | ||
| 213 | ;; filename is expected to be non remote. A more subtle check | ||
| 214 | ;; for "file://" URLs could be applied, as said in | ||
| 215 | ;; `url-handler-unhandled-file-name-directory'. | ||
| 216 | nil))) | ||
| 217 | |||
| 197 | ;; The actual implementation | 218 | ;; The actual implementation |
| 198 | ;;;###autoload | 219 | ;;;###autoload |
| 199 | (defun url-copy-file (url newname &optional ok-if-already-exists keep-time) | 220 | (defun url-copy-file (url newname &optional ok-if-already-exists keep-time) |