From:	mcook AT cognex DOT com (Michael R Cook)
Subject:	teaching emacs about mount points
23 May 1998 12:58:31 -0700 :
Message-ID:	<r4d8d8eh62.fsf.cygnus.gnu-win32@cognex.com>
To:	gnu-win32 AT cygnus DOT com

;;; cygwin32-mount.el --- Teach EMACS about cygwin32 mount points.
;;; Michael Cook <mcook AT cognex DOT 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 AT cygnus DOT com" with one line of text: "help".

- Raw text -