ftp-url

[Katsumi Yamaoka <yamaoka@xxxxxxx>]

ange-ftp や efs を使う場合に、"/ftp@host:/dir/file" ではなくて、
いきなり "ftp://host/dir/file" のような文字列を使って find-file
や dired を行なうことができるようにするプログラムがあります。
で、実はこれが変なところで w3m とバッティングして、無限ループを
起こしてしまうのです。
明かにそのプログラムを直すべきなのですが、w3m 側で対策してもそれ
なりに正当な言い訳ができるので、実行いたしました。(^^;;)

なお、これは過去にもりけいすけさん <ksk@ntts.com> が作られたもの
で、たしか w3 でも同じ問題を起こしていたと思います。短いので添付
します。

;;; Written by Keisuke Mori <ksk@ntts.com>.
(defun convert-ftp-url-run-real-handler (operation args)
  (let ((inhibit-file-name-handlers
	 (cons 'convert-ftp-url-to-efs-filename
	       (and (eq inhibit-file-name-operation operation)
		    inhibit-file-name-handlers)))
	(inhibit-file-name-operation operation))
    (apply operation args)))

(defun convert-ftp-url-to-efs-filename (operation string &rest args)
  (string-match "^ftp://\\([^/@]+@\\)?\\([^/~]+\\)" string)
  (convert-ftp-url-run-real-handler
   operation
   (cons (concat "/"
		 (if (match-beginning 1)
		     (substring string (match-beginning 1) (match-end 1))
		   "anonymous@")
		 (substring string (match-beginning 2) (match-end 2))
		 ":"
		 (substring string (match-end 2)))
	 args)))

(defun convert-ftp-url-hook-function (operation &rest args)
  (let ((fn (get operation 'convert-ftp-url-to-efs-filename)))
    (if fn (apply fn operation args)
      (convert-ftp-url-run-real-handler operation args))))

(or (assoc "^ftp://[^/~]+"; file-name-handler-alist)
    (setq file-name-handler-alist
	  (cons '("^ftp://[^/~]+"; . convert-ftp-url-hook-function)
		file-name-handler-alist)))

(put 'substitute-in-file-name
     'convert-ftp-url-to-efs-filename 'convert-ftp-url-to-efs-filename)
(put 'expand-file-name
     'convert-ftp-url-to-efs-filename 'convert-ftp-url-to-efs-filename)
-- 
Katsumi Yamaoka <yamaoka@jpl.org>