teaching emacs about mount points

Fri May 22 22:15:00 GMT 1998

;;; cygwin32-mount.el --- Teach EMACS about cygwin32 mount points.
;;; Michael Cook <mcook@cognex.com>.
(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)))
(defun cygwin32-mount-name-hook-function (operation &rest args)
 (let ((fn (get operation 'cygwin32-mount-name)))
 (if fn
	(apply fn args)
 (let ((inhibit-file-name-handlers
	 (cons 'cygwin32-mount-name-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)
(require 'cl)
(defun cygwin32-mount-name-expand (name &optional unused)
 ;; 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)))))
 name)))
(provide 'cygwin32-mount)
-
For help on using this list (especially unsubscribing), send a message to
"gnu-win32-request@cygnus.com" with one line of text: "help".