;;; cygwin32-mount.el --- Teach EMACS about cygwin32 mount points.
;;; Michael Cook <mcook@cognex.com>.
;;; modified Jun 18 1998 by Keisuke Mori <ksk@ntts.com> 
;;;  to make it work with ange-ftp and enable mapping a drive letter
(defun cygwin32-mount-build-table ()
  ;; Determine the cygwin mount points.
  (let ((buf (get-buffer-create " *mount*"))
	(case-fold-search t)
	mounts)
    (save-excursion
      (set-buffer buf)
      (erase-buffer)
      (call-process "mount" nil t)
      (goto-char (point-min))
      (while (search-forward-regexp
	      "^\\([a-z]:[^ \t\n]*\\) +\\([^ \t\n]+\\)" nil t)
	(let ((device (buffer-substring (match-beginning 1)
					(match-end 1)))
	      (direct (buffer-substring (match-beginning 2)
					(match-end 2))))
	  (setq mounts (cons (cons device direct)
			     mounts)))))
    (kill-buffer buf)
    mounts))

(defvar cygwin32-mount-table (cygwin32-mount-build-table)
  "Alist of cygwin32 mount points.")

(or (assoc "^/[^/:]+\\(\\'\\|/\\)" file-name-handler-alist)
    (setq file-name-handler-alist
	  (cons '("^/[^/:]+\\(\\'\\|/\\)" . cygwin32-mount-name-hook-function)
		file-name-handler-alist)))

(or (assoc "^//[A-Za-z]/" file-name-handler-alist)
    (setq file-name-handler-alist
	  (cons '("^//[A-Za-z]/" . cygwin32-mount-map-drive-hook-function)
		file-name-handler-alist)))

(defun cygwin32-mount-name-hook-function (operation &rest args)
  (let ((fn (get operation 'cygwin32-mount-name)))
    (if fn (apply fn operation args)
      (cygwin32-mount-run-real-handler operation args))))

(defun cygwin32-mount-map-drive-hook-function (operation &rest args)
  (let ((fn (get operation 'cygwin32-mount-map-drive)))
    (if fn (apply fn operation args)
      (cygwin-32-mount-run-real-handler operation args))))

(defun cygwin32-mount-run-real-handler (operation args)
  (let ((inhibit-file-name-handlers
	 (cons 'cygwin32-mount-name-hook-function
	       (cons 'cygwin32-mount-map-drive-hook-function
		     (and (eq inhibit-file-name-operation operation)
			  inhibit-file-name-handlers))))
	(inhibit-file-name-operation operation))
    (apply operation args)))

(put 'substitute-in-file-name 'cygwin32-mount-name 'cygwin32-mount-name-expand)
(put 'expand-file-name 'cygwin32-mount-name 'cygwin32-mount-name-expand)

(put 'substitute-in-file-name
     'cygwin32-mount-map-drive 'cygwin32-mount-map-drive)
(put 'expand-file-name 'cygwin32-mount-map-drive 'cygwin32-mount-map-drive)

(require 'cl)

(defun cygwin32-mount-name-expand (operation name &rest args)
  ;; If NAME uses a mount directory, substitute the mount device
  ;; and return the resulting string.  Otherwise, return NAME.
  (let ((mounts cygwin32-mount-table)
	(len (length name))
	match)
    (while mounts
      (let ((mount (file-name-as-directory (cdar mounts))))
	(and (>= len (length mount))
	     (string= mount (substring name 0 (length mount)))
	     (or (null match)
		 (> (length (cdar mounts)) (length (cdr match))))
	     (setq match (car mounts))))
      (setq mounts (cdr mounts)))
    (if match
	(concat (file-name-as-directory (car match))
		(substring name (length (file-name-as-directory (cdr match)))))
      (cygwin32-mount-run-real-handler operation (cons name args)))))

(defun cygwin32-mount-map-drive (operation name &rest args)
  ;; NAME must have the format looks like "^//[A-Za-z]/" here.
  (cygwin32-mount-run-real-handler
   operation
   (cons (concat (substring name 2 3) ":" (substring name 3 nil))
	 args)))

(provide 'cygwin32-mount)