;;; dir-ftp - Fast access to ftp sites

(defvar dir-ftp-history nil)

(defvar dir-ftp-prefix
  "/anonymous@")

(defvar dir-ftp-sites-alist
  '(("elisp-archive"
     "archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/"
;;     "ftp.cs.umn.edu:pub/elisp-archive/"
     "calypso-2.oit.unc.edu:pub/gnu/elisp-archive/"
     "ftp.uu.net:packages/gnu/emacs-lisp/"
     "gatekeeper.dec.com:pub/GNU/elisp-archive/"
     "nic.switch.ch:mirror/elisp-archive/"
     "ftp.diku.dk:pub/elisp-archive/"
     "quepasa.cs.tu-berlin.de:pub/gnu/elisp/"
     "faui43.informatik.uni-erlangen.de:pub/gnu/elisp-archive/"
     "ftp.uni-mainz.de:pub/gnu/elisp-archive/"
     "nic.funet.fi:pub/gnu/emacs/elisp-archive/"
     "src.doc.ic.ac.uk:gnu/EmacsBits/elisp-archive/")
    ("scheme-repository"
     "ftp.cs.indiana.edu:/pub/scheme-repository")
    ("linux-HOWTO"
     "tsx-11.mit.edu:/pub/linux/docs/HOWTO")
    ("linux"
     "sunsite.unc.edu:/pub/Linux/"
     "tsx-11.mit.edu:/pub/linux/"
     "ftp.funet.fi:/pub/Linux/")
    ("garbage"
     "ftp.cs.utexas.edu:/pub/garbage/")
    ("gnu"
     "ftp.ms.uky.edu:/pub3/gnu"
     "ftp.digex.net:/pub/gnu"
     "wuarchive.wustl.edu:/systems/gnu"
     "uiarchive.cso.uiuc.edu:/pub/gnu"
     "ftp.cs.columbia.edu:/archives/gnu/prep"
     "jaguar.utah.edu:/gnustuff/"
     "gatekeeper.dec.com:/pub/GNU"
     "labrea.stanford.edu:/gnu"
     "ftp.hawaii.edu:/mirrors/gnu"
     "ftp.cis.ohio-state.edu:/pub/gnu"
     "gnu.egr.msu.edu:/pub/gnu"
     "ftp.uu.net/archive:/systems/gnu")
    ("rtfm"
;     "ftp.uu.net:/usenet/news.answers"
     "ftp.seas.gwu.edu:/pub/rtfm"
     "rtfm.mit.edu:/pub/usenet-by-hierarchy"
     )
    ))


(defvar dir-ftp-next-site nil)

(defun dir-ftp-next-site ()
  (interactive)
  (and (null dir-ftp-next-site)
       (error "Haven't visited a site yet"))
  (let ((name (car dir-ftp-next-site))
	(sites (cdr dir-ftp-next-site)))
    (if (null sites)
	(error "Last site")
      (dir-ftp-visit-site name sites))))


(defun dir-ftp-visit-site (name sites)
  "Dired visit a NAME site.  Attempt to connect to each site listed in
SITES until a connection is successful.  Signal error if no site can
be reached."
  (if (null sites)
      (error (format "Can't open %s" name))
    (let* ((site (car sites))
	   (site-name
	    (if (string-match ".*:" site)
		(substring site
			   (match-beginning 0)
			   (1- (match-end 0)))
	      "some site"))
	   (win-config (current-window-configuration)))
      (condition-case nil
	  (progn
	    (message (format "Trying %s..." site-name))
	    (setq dir-ftp-next-site (cons name (cdr sites)))
	    (dired (concat dir-ftp-prefix site))
	    (message (format "Trying %s... Welcome!" site-name)))
	(ftp-error
	 (message (format "Unable to connect with %s" site-name))
	 (set-window-configuration win-config)
	 (sit-for 1)
	 (dir-ftp-visit-site name (cdr sites)))))))

(defun dir-ftp (where)
  (interactive (list (completing-read "Where: "
				      dir-ftp-sites-alist
				      nil nil "" 'dir-ftp-history)))
  (let ((sites (cdr (assoc where dir-ftp-sites-alist))))
    (dir-ftp-visit-site where sites)))