;;; Generic URL handling (require 'cl) (defconst surly-non-punct-regexp "[^;?@:/]") (defconst surly-regexp (concat "^" surly-non-punct-regexp "+://")) (defvar surly-handlers nil) (defun add-surly (matcher-or-regexp handler-type) "adds a new URL matcher along with the handler-type for an URL scheme" (setq surly-handlers (cons (cons matcher-or-regexp handler-type) surly-handlers))) (defun surly-find-handler (operation args) (let* ((check-handlers (lambda (arg handlers) (if (null handlers) nil (let ((matcher (caar handlers)) (handler (cdar handlers))) (or (and (stringp matcher) (equal 0 (string-match matcher arg)) handler) (and (functionp matcher) (funcall matcher arg) handler) (funcall check-handlers arg (cdr handlers)))) ))) (check-args (lambda (args) (if (null args) nil (let* ((arg (car args)) (handler (and (stringp arg) (funcall check-handlers arg surly-handlers)))) (or handler (funcall check-args (cdr args)))) )))) (funcall check-args args))) (defun surly-file-handler-function (operation &rest args) "Function to call special file handlers for URLs" (let* ((type (surly-find-handler operation args)) (handler (get operation type))) (if handler (apply handler args) (let ((inhibit-file-name-handlers (cons 'surly-file-handler-function (and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers))) (inhibit-file-name-operation operation)) (apply operation args))))) (or (assoc surly-regexp file-name-handler-alist) (nconc file-name-handler-alist (list (cons surly-regexp 'surly-file-handler-function)))) (provide 'surly)