Mail Archives: cygwin/1998/06/19/00:30:38
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".
- Raw text -