;;; url-handlers.el --- file-name-handler stuff for URL loading
-;; Copyright (c) 1996,97,98,1999,2004 Free Software Foundation, Inc.
-;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
+;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
;;
;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
-(require 'url)
-(require 'url-parse)
-(require 'url-util)
-(require 'mm-decode)
-(require 'mailcap)
+;; (require 'url)
+(eval-when-compile (require 'url-parse))
+;; (require 'url-util)
+(eval-when-compile (require 'mm-decode))
+;; (require 'mailcap)
+;; The following functions in the byte compiler's warnings are known not
+;; to cause any real problem for the following reasons:
+;; - mm-save-part-to-file, mm-destroy-parts: always used
+;; after mm-dissect-buffer and defined in the same file.
+;; The following are autoloaded instead of `require'd to avoid eagerly
+;; loading all of URL when turning on url-handler-mode in the .emacs.
+(autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.")
+(autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.")
+(autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.")
(eval-when-compile
(require 'cl))
;;;###autoload
(define-minor-mode url-handler-mode
"Use URL to handle URL-like file names."
- :global t
+ :global t :group 'url
(if (not (boundp 'file-name-handler-alist))
;; Can't be turned ON anyway.
(setq url-handler-mode nil)
(inhibit-file-name-operation operation))
(apply operation args)))
+;;;###autoload
(defun url-file-handler (operation &rest args)
"Function called from the `file-name-handler-alist' routines.
OPERATION is what needs to be done (`file-exists-p', etc). ARGS are
(put 'substitute-in-file-name 'url-file-handlers 'url-file-handler-identity)
(put 'file-name-absolute-p 'url-file-handlers (lambda (&rest ignored) t))
(put 'expand-file-name 'url-file-handlers 'url-handler-expand-file-name)
+(put 'directory-file-name 'url-file-handlers 'url-handler-directory-file-name)
+(put 'unhandled-file-name-directory 'url-file-handlers 'url-handler-unhandled-file-name-directory)
+;; (put 'file-name-as-directory 'url-file-handlers 'url-handler-file-name-as-directory)
;; These are operations that we do not support yet (DAV!!!)
(put 'file-writable-p 'url-file-handlers 'ignore)
(put 'file-symlink-p 'url-file-handlers 'ignore)
+;; Just like for ange-ftp: let's not waste time trying to look for RCS/foo,v
+;; files and such since we can't do anything clever with them anyway.
+(put 'vc-registered 'url-file-handlers 'ignore)
(defun url-handler-expand-file-name (file &optional base)
+ ;; When we see "/foo/bar" in a file whose working dir is "http://bla/bla",
+ ;; there are two interpretations possible: either it's a local "/foo/bar"
+ ;; or it's "http:/bla/foo/bar". When working with URLs, the second
+ ;; interpretation is the right one, but when working with Emacs file
+ ;; names, the first is preferred.
(if (file-name-absolute-p file)
(expand-file-name file "/")
(url-expand-file-name file base)))
+;; directory-file-name and file-name-as-directory are kind of hard to
+;; implement really right for URLs since URLs can have repeated / chars.
+;; We'd want the following behavior:
+;; idempotence: (d-f-n (d-f-n X) == (d-f-n X)
+;; idempotence: (f-n-a-d (f-n-a-d X) == (f-n-a-d X)
+;; reversible: (d-f-n (f-n-a-d (d-f-n X))) == (d-f-n X)
+;; reversible: (f-n-a-d (d-f-n (f-n-a-d X))) == (f-n-a-d X)
+(defun url-handler-directory-file-name (dir)
+ ;; When there's more than a single /, just don't touch the slashes at all.
+ (if (string-match "//\\'" dir) dir
+ (url-run-real-handler 'directory-file-name (list dir))))
+
+(defun url-handler-unhandled-file-name-directory (filename)
+ ;; Copied from tramp.el. This is used as the cwd for subprocesses:
+ ;; without it running call-process or start-process in a URL directory
+ ;; signals an error.
+ ;; FIXME: we can do better if `filename' is a "file://" URL.
+ (expand-file-name "~/"))
+
;; The actual implementation
;;;###autoload
(defun url-copy-file (url newname &optional ok-if-already-exists keep-time)
(handle nil))
(if (not buffer)
(error "Opening input file: No such file or directory, %s" url))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq handle (mm-dissect-buffer t)))
(mm-save-part-to-file handle newname)
(kill-buffer buffer)
"Copy URL into a temporary file on this machine.
Returns the name of the local copy, or nil, if FILE is directly
accessible."
- (let ((filename (make-temp-name "url")))
- (url-copy-file url filename)
+ (let ((filename (make-temp-file "url")))
+ (url-copy-file url filename 'ok-if-already-exists)
filename))
+(defun url-insert (buffer &optional beg end)
+ "Insert the body of a URL object.
+BUFFER should be a complete URL buffer as returned by `url-retrieve'.
+If the headers specify a coding-system, it is applied to the body before it is inserted.
+Returns a list of the form (SIZE CHARSET), where SIZE is the size in bytes
+of the inserted text and CHARSET is the charset that was specified in the header,
+or nil if none was found.
+BEG and END can be used to only insert a subpart of the body.
+They count bytes from the beginning of the body."
+ (let* ((handle (with-current-buffer buffer (mm-dissect-buffer t)))
+ (data (with-current-buffer (mm-handle-buffer handle)
+ (if beg
+ (buffer-substring (+ (point-min) beg)
+ (if end (+ (point-min) end) (point-max)))
+ (buffer-string))))
+ (charset (mail-content-type-get (mm-handle-type handle)
+ 'charset)))
+ (mm-destroy-parts handle)
+ (if charset
+ (insert (mm-decode-string data (mm-charset-to-coding-system charset)))
+ (insert data))
+ (list (length data) charset)))
+
;;;###autoload
(defun url-insert-file-contents (url &optional visit beg end replace)
- (let ((buffer (url-retrieve-synchronously url))
- (handle nil)
- (data nil))
+ (let ((buffer (url-retrieve-synchronously url)))
(if (not buffer)
(error "Opening input file: No such file or directory, %s" url))
(if visit (setq buffer-file-name url))
(save-excursion
- (set-buffer buffer)
- (setq handle (mm-dissect-buffer t))
- (set-buffer (mm-handle-buffer handle))
- (if beg
- (setq data (buffer-substring beg end))
- (setq data (buffer-string))))
- (kill-buffer buffer)
- (mm-destroy-parts handle)
- (if replace (delete-region (point-min) (point-max)))
- (save-excursion
- (insert data))
- (list url (length data))))
+ (let* ((start (point))
+ (size-and-charset (url-insert buffer beg end)))
+ (kill-buffer buffer)
+ (when replace
+ (delete-region (point-min) start)
+ (delete-region (point) (point-max)))
+ (unless (cadr size-and-charset)
+ ;; If the headers don't specify any particular charset, use the
+ ;; usual heuristic/rules that we apply to files.
+ (decode-coding-inserted-region start (point) url visit beg end replace))
+ (list url (car size-and-charset))))))
(defun url-file-name-completion (url directory)
(error "Unimplemented"))
,@(remove '&rest (remove '&optional args))))))
(url-handlers-create-wrapper file-exists-p (url))
-(url-handlers-create-wrapper file-attributes (url))
+(url-handlers-create-wrapper file-attributes (url &optional id-format))
(url-handlers-create-wrapper file-symlink-p (url))
(url-handlers-create-wrapper file-writable-p (url))
(url-handlers-create-wrapper file-directory-p (url))
(url-handlers-create-wrapper file-executable-p (url))
+(url-handlers-create-wrapper directory-files (url &optional full match nosort))
+(url-handlers-create-wrapper file-truename (url &optional counter prev-dirs))
-(if (featurep 'xemacs)
- (progn
- ;; XEmacs specific prototypes
- (url-handlers-create-wrapper
- directory-files (url &optional full match nosort files-only))
- (url-handlers-create-wrapper
- file-truename (url &optional default)))
- ;; Emacs specific prototypes
- (url-handlers-create-wrapper
- directory-files (url &optional full match nosort))
- (url-handlers-create-wrapper
- file-truename (url &optional counter prev-dirs)))
-
-(add-hook 'find-file-hooks 'url-handlers-set-buffer-mode)
+(add-hook 'find-file-hook 'url-handlers-set-buffer-mode)
(defun url-handlers-set-buffer-mode ()
"Set correct modes for the current buffer if visiting a remote file."