;;; url-handlers.el --- file-name-handler stuff for URL loading
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
;; (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.")
+;; Always used after mm-dissect-buffer and defined in the same file.
+(declare-function mm-save-part-to-file "mm-decode" (handle file))
+(declare-function mm-destroy-parts "mm-decode" (handles))
+;; mm-decode loads mm-bodies.
+(declare-function mm-decode-string "mm-bodies" (string charset))
+;; mm-decode loads mail-parse.
+(declare-function mail-content-type-get "mail-parse" (ct attribute))
+
;; Implementation status
;; ---------------------
;; Function Status
;; verify-visited-file-modtime
;; write-region
-(defvar url-handler-regexp
- "\\`\\(https?\\|ftp\\|file\\|nfs\\)://"
- "*A regular expression for matching URLs handled by `file-name-handler-alist'.
-Some valid URL protocols just do not make sense to visit interactively
-\(about, data, info, irc, mailto, etc\). This regular expression
-avoids conflicts with local files that look like URLs \(Gnus is
-particularly bad at this\).")
+(defvar url-handler-regexp) ; defined below to avoid recursive load (revno:108572)
;;;###autoload
(define-minor-mode url-handler-mode
- "Use URL to handle URL-like file names."
+ "Toggle using `url' library for URL filenames (URL Handler mode).
+With a prefix argument ARG, enable URL Handler mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil."
:global t :group 'url
- (if (not (boundp 'file-name-handler-alist))
- ;; Can't be turned ON anyway.
- (setq url-handler-mode nil)
- ;; Remove old entry, if any.
- (setq file-name-handler-alist
- (delq (rassq 'url-file-handler file-name-handler-alist)
- file-name-handler-alist))
- (if url-handler-mode
- (push (cons url-handler-regexp 'url-file-handler)
- file-name-handler-alist))))
+ ;; Remove old entry, if any.
+ (setq file-name-handler-alist
+ (delq (rassq 'url-file-handler file-name-handler-alist)
+ file-name-handler-alist))
+ (if url-handler-mode
+ (push (cons url-handler-regexp 'url-file-handler)
+ file-name-handler-alist)))
+
+(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\)://"
+ "Regular expression for URLs handled by `url-handler-mode'.
+When URL Handler mode is enabled, this regular expression is
+added to `file-name-handler-alist'.
+
+Some valid URL protocols just do not make sense to visit
+interactively \(about, data, info, irc, mailto, etc\). This
+regular expression avoids conflicts with local files that look
+like URLs \(Gnus is particularly bad at this\)."
+ :group 'url
+ :type 'regexp
+ :set (lambda (symbol value)
+ (let ((enable url-handler-mode))
+ (url-handler-mode 0)
+ (set-default symbol value)
+ (if enable
+ (url-handler-mode)))))
(defun url-run-real-handler (operation args)
(let ((inhibit-file-name-handlers (cons 'url-file-handler
"Function called from the `file-name-handler-alist' routines.
OPERATION is what needs to be done (`file-exists-p', etc). ARGS are
the arguments that would have been passed to OPERATION."
- (let ((fn (or (get operation 'url-file-handlers)
- (intern-soft (format "url-%s" operation))))
+ (let ((fn (get operation 'url-file-handlers))
(val nil)
(hooked nil))
- (if (and fn (fboundp fn))
+ (if (and (not fn) (intern-soft (format "url-%s" operation))
+ (fboundp (intern-soft (format "url-%s" operation))))
+ (error "Missing URL handler mapping for %s" operation))
+ (if fn
(setq hooked t
val (save-match-data (apply fn args)))
(setq hooked nil
(mm-save-part-to-file handle newname)
(kill-buffer buffer)
(mm-destroy-parts handle)))
+(put 'copy-file 'url-file-handlers 'url-copy-file)
;;;###autoload
(defun url-file-local-copy (url &rest ignored)
(let ((filename (make-temp-file "url")))
(url-copy-file url filename 'ok-if-already-exists)
filename))
+(put 'file-local-copy 'url-file-handlers 'url-file-local-copy)
(defun url-insert (buffer &optional beg end)
"Insert the body of a URL object.
;; 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))))))
+(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents)
(defun url-file-name-completion (url directory &optional predicate)
- (error "Unimplemented"))
+ ;; Even if it's not implemented, it's not an error to ask for completion,
+ ;; in case it's available (bug#14806).
+ ;; (error "Unimplemented")
+ url)
+(put 'file-name-completion 'url-file-handlers 'url-file-name-completion)
(defun url-file-name-all-completions (file directory)
- (error "Unimplemented"))
+ ;; Even if it's not implemented, it's not an error to ask for completion,
+ ;; in case it's available (bug#14806).
+ ;; (error "Unimplemented")
+ nil)
+(put 'file-name-all-completions
+ 'url-file-handlers 'url-file-name-all-completions)
;; All other handlers map onto their respective backends.
(defmacro url-handlers-create-wrapper (method args)
- `(defun ,(intern (format "url-%s" method)) ,args
- ,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method
- (or (documentation method t) "No original documentation."))
- (setq url (url-generic-parse-url url))
- (when (url-type url)
- (funcall (url-scheme-get-property (url-type url) (quote ,method))
- ,@(remove '&rest (remove '&optional args))))))
+ `(progn
+ (defun ,(intern (format "url-%s" method)) ,args
+ ,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method
+ (or (documentation method t) "No original documentation."))
+ (setq url (url-generic-parse-url url))
+ (when (url-type url)
+ (funcall (url-scheme-get-property (url-type url) (quote ,method))
+ ,@(remove '&rest (remove '&optional args)))))
+ (unless (get ',method 'url-file-handlers)
+ (put ',method 'url-file-handlers ',(intern (format "url-%s" method))))))
(url-handlers-create-wrapper file-exists-p (url))
(url-handlers-create-wrapper file-attributes (url &optional id-format))
HCoop / bpt / emacs.git / blobdiff