;;; url-handlers.el --- file-name-handler stuff for URL loading
-;; Copyright (C) 1996-1999, 2004-2012 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
(push (cons url-handler-regexp 'url-file-handler)
file-name-handler-alist)))
-(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\)://"
+(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\|ssh\\|scp\\|rsync\\|telnet\\)://"
"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'.
like URLs \(Gnus is particularly bad at this\)."
:group 'url
:type 'regexp
+ :version "24.5"
:set (lambda (symbol value)
(let ((enable url-handler-mode))
(url-handler-mode 0)
(inhibit-file-name-operation operation))
(apply operation args)))
+(defvar url-file-handler-load-in-progress nil
+ "Check for recursive load.")
+
;;;###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
the arguments that would have been passed to OPERATION."
- (let ((fn (get operation 'url-file-handlers))
- (val nil)
- (hooked nil))
- (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
- val (url-run-real-handler operation args)))
- (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real")
- operation args val)
- val))
+ ;; Avoid recursive load.
+ (if (and load-in-progress url-file-handler-load-in-progress)
+ (url-run-real-handler operation args)
+ (let ((url-file-handler-load-in-progress load-in-progress))
+ ;; Check, whether there are arguments we want pass to Tramp.
+ (if (catch :do
+ (dolist (url (cons default-directory args))
+ (and (member
+ (url-type (url-generic-parse-url (and (stringp url) url)))
+ url-tramp-protocols)
+ (throw :do t))))
+ (apply 'url-tramp-file-handler operation args)
+ ;; Otherwise, let's do the job.
+ (let ((fn (get operation 'url-file-handlers))
+ (val nil)
+ (hooked nil))
+ (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
+ val (url-run-real-handler operation args)))
+ (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real")
+ operation args val)
+ val)))))
(defun url-file-handler-identity (&rest args)
;; Identity function
(insert data))
(list (length data) charset)))
+(defvar url-http-codes)
+
;;;###autoload
(defun url-insert-file-contents (url &optional visit beg end replace)
(let ((buffer (url-retrieve-synchronously url)))
- (if (not buffer)
- (error "Opening input file: No such file or directory, %s" url))
+ (unless buffer (signal 'file-error (list url "No Data")))
+ (with-current-buffer buffer
+ ;; XXX: This is HTTP/S specific and should be moved to url-http
+ ;; instead. See http://debbugs.gnu.org/17549.
+ (when (bound-and-true-p url-http-response-status)
+ (unless (and (>= url-http-response-status 200)
+ (< url-http-response-status 300))
+ (let ((desc (nth 2 (assq url-http-response-status url-http-codes))))
+ (kill-buffer buffer)
+ ;; Signal file-error per http://debbugs.gnu.org/16733.
+ (signal 'file-error (list url desc))))))
(if visit (setq buffer-file-name url))
(save-excursion
(let* ((start (point))
;; 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)
HCoop / bpt / emacs.git / blobdiff