Mail Archives: cygwin/2000/08/25/16:14:11
--0F1p//8PRICkK4MW
Content-Type: text/plain; charset=us-ascii
I know there are quite a few Emacs users out there who would like
to be able to work with cygwin's symlinks. I know I do. I've seen
a few ways of working with symlinked files, but symlinked
directories always seem to cause problems. I've written a small
package in ELisp to deal with this. I'd welcome any feedback ...etc.
Requirements: This package requires the cygwin32-mount package.
I found the package here:
http://www.egroups.com/group/gnu-win32/5283.html
Instructions: Copy the cygwin32-symlink file into a directory in
your load-path.
Add the line (require 'cygwin32-symlink) to your
.emacs file.
Like most software projects, this is a work in progress.
Let me know what you think.
Adam Schlegel
--0F1p//8PRICkK4MW
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="cygwin32-symlink.el"
;;; -*- emacs-lisp -*-
;;; Make Emacs understnd Cygwin-style symlinks
;;; AUTHOR: Adam Schlegel, Thinkage Ltd. <aceschle AT uwaterloo DOT ca>
;;; CREATED: July 21, 2000 14:46:12
;;; MODIFIED: August 25, 2000 16:03:51
;;; INSTRUCTIONS: Just place this file somewhere in your load path and add
;;; the line (require 'cygwin32-symlink) to your .emacs file
;;; BUGS: The default directory for a file is changed to the location
;;; of the destination file. It should remain the location of
;;; the link file.
;;;
;;; Symlinkd dirs still complete as files (because they *are* files)
;;;
;;; Symlinks will not work on a network machine. So don't try. This is
;;; very hard to fix because you'd have to know the mount table for the
;;; new computer. Not worth the effort.
;;;
;;; Doesn't help emacs follow the current directory in shell mode.
;;; BACKGROUND:
;;; AFICT, the filename in a link is in the same format as
;;; it was when it was created (with the ln -s command). This means that
;;; it can be in *any* format acceptable to cygwin.
;;; Cygwin32-mount is required to be able to parse files referred to
;;; by mount points. (Most importantly the slash mount point)
(require 'cygwin32-mount)
(defvar cygwin32-follow-symlinks t
"What to do when visiting a Cygwin symlink.
When non-nil, any Cygwin-style symlink will be followed to the file that
it points to (unless that file is not there). Otherwise, just open the
link file itself.")
(defconst cygwin32-symlink-style-regexp "^!<symlink>\\(.*\\)\0$"
"A regular expression matching the structure of a symlink file.
A file is considered to be a symlink if its first line matches
this regular expression. Furthermore, the first sub-expression is
considered to be the filename of the file to which it is linked.")
;; I wish I didn't need this, but I don't see any way around it.
;; The right solution is to scan up to the first NULL, but
;; `insert-file-contents' needs to have a number supplied.
(defconst cygwin32-symlink-max-length 500
"The maximum length of a cygwin symlink file.
This determines how far into a file to look for the *entire* definition of
a cygwin symlink.")
(defconst cygwin32-symlink-drive-root
"^\\([a-zA-Z]:\\|/\\|/cygdrive/[a-zA-Z]\\|~\\)[/\\\\]?$"
"Controls when to stop looking for symlinked directories in a path.
How can this be made more 'general'? I want the same regexp to be used for
this and `smart-compile'.")
;; File-Handler Stuff
(or (assoc "" file-name-handler-alist)
(setq file-name-handler-alist
(cons '("" . cygwin32-symlink-handler) file-name-handler-alist)))
(defun cygwin32-symlink-handler (operation &rest args)
(let ((inhibit-file-name-handlers ; directly
(cons 'cygwin32-symlink-handler ; from the
(and (eq inhibit-file-name-operation operation) ; GNU E-Lisp
inhibit-file-name-handlers))) ; manual on
(inhibit-file-name-operation operation) ; the web
;; need to completely disable this handler within itself
(file-name-handler-alist
(delete '("" . cygwin32-symlink-handler) file-name-handler-alist)))
(cond ((and cygwin32-follow-symlinks
(or (eq operation 'expand-file-name)
(eq operation 'substitute-in-file-name)))
(apply operation
(cons (cygwin32-symlink-internal-expand (car args))
(cdr args))))
(t (apply operation args)))))
(defun cygwin32-symlink-p (file)
"Returns non-nil if file is regognized as a symlink.
Reads the first `cygwin32-symlink-max-length' characters of the file and
compares it to known symlink styles, found in `cygwin32-symlink-style-regexp'.
If the format matches the regexp, the function returns the filename found in
the first sub-expression, otherwise, it returns nil."
(let ((return-value nil)
(cygwin32-follow-symlinks nil))
(if (and (file-exists-p file)
(file-readable-p file)
(not (file-directory-p file)))
(with-temp-buffer
(insert-file-contents-literally
file nil 0 cygwin32-symlink-max-length)
(goto-char (point-min))
(if (looking-at cygwin32-symlink-style-regexp)
(setq return-value (match-string 1)))))
return-value))
(defun cygwin32-symlink-expand (file)
"Return the actual (DOS/Windows) path from a cygwin path."
(interactive "F") ; so the user can actually call this
(message "%s" (cygwin32-symlink-internal-expand file nil)))
;; This will always look at the file relative to the current directory.
(defun cygwin32-symlink-internal-expand (file &optional circle)
"Return the actual (DOS/Windows) path from a cygwin path.
File is the filename to expand.
Circle is a list of links that have already been visited. This checks for
circular references. When initially calling this, pass it nil unless you
have a *very* good reason not to (I can't think of one)."
;; Set file to what the user actually wants us to work with
(setq file (substitute-in-file-name file))
(let ((my-list (break-file-name file))
(my-file)
(dir)
(result))
(while my-list
(setq dir my-file) ;; the last value of my-file
(setq my-file (concat my-file (car my-list)))
(setq my-list (cdr my-list))
(setq result (cygwin32-symlink-p my-file))
(if result ;; my-file refers to a symlink
(progn
(if (string-match
;; drive-root is anchored.. need non-anchored version
;; ASSUMPTION: drive root ends in a $
(substring cygwin32-symlink-drive-root 0 -1)
result)
;; File is 'rooted' into the file-system
nil ; nothing needed
;; otherwise file is a relative name
;; interpret relative to the directory we were last in
(setq result (concat dir "/" result)))
(if (member result circle)
(error "Too many symbolic links"))
(let ((circle (cons result circle)))
(setq my-file
(cygwin32-symlink-internal-expand result circle))))))
;; do any necessary post-processing
(setq result my-file)
result))
(defun break-file-name (file)
"Returns a list of components of file's directories."
(let* ((cygwin32-follow-symlinks nil)
(my-file file)
(my-list ()))
(while (not (or (string= my-file "")
(string-match cygwin32-symlink-drive-root my-file)))
(if (string-match "\\(.*\\)\\([/\\\\].+\\)" my-file)
(let ((first (match-string 1 my-file))
(second (match-string 2 my-file)))
;; delete any ending /'s or \'s unless its either the / mount
;; or the first (leaf) entry [for filename completion]
(if (and my-list
(string-match "\\(.+\\)[/\\\\]" second))
(setq second (match-string 1 second)))
(setq my-list (cons second my-list))
(setq my-file first))
(progn
(setq my-list (cons my-file my-list))
(setq my-file ""))))
(setq my-list (cons my-file my-list))
my-list))
(provide 'cygwin32-symlink)
--0F1p//8PRICkK4MW
Content-Type: text/plain; charset=us-ascii
--
Want to unsubscribe from this list?
Send a message to cygwin-unsubscribe AT sourceware DOT cygnus DOT com
--0F1p//8PRICkK4MW--
- Raw text -