From: ksk AT ntts DOT com (Keisuke Mori)
Subject: Re: teaching emacs about mount points
19 Jun 1998 00:30:38 -0700
Message-ID: <wkemwm74xo.fsf.cygnus.gnu-win32@ntts.com>
References: <r4d8d8eh62 DOT fsf AT cognex DOT com>
Mime-Version: 1.0 (generated by SEMI MIME-Edit 0.91 - "Hinomiko")
Content-Type: text/plain; charset=US-ASCII
To: Michael R Cook <mcook AT cognex DOT com>
Cc: gnu-win32 AT cygnus DOT com

Hi Michael,

Michael R Cook <mcook AT cognex DOT com> writes:
> ;;; cygwin32-mount.el --- Teach EMACS about cygwin32 mount points.
> ;;; Michael Cook <mcook AT cognex DOT com>.

I tried your program and it works pretty good. The only problem
is that, however, it does not work with the lovely ange-ftp.

Here is my modified version of cygwin32-mount.el that works with
ange-ftp. It also allows you to use '//e/' style of drive
specification and it will be just mapped into like 'e:/'.

I hope it helps. Thank you.
-- 
	Keisuke Mori / NTT Software Corp. California Branch
	E-Mail: ksk AT ntts DOT com

----8<--------8<--------8<--------8<--------8<--------8<---- Cut here
;;; cygwin32-mount.el --- Teach EMACS about cygwin32 mount points.
;;; Michael Cook <mcook AT cognex DOT com>.
;;; modified Jun 18 1998 by Keisuke Mori <ksk AT ntts DOT 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)

-
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".