Mailing-List: contact cygwin-help AT sourceware DOT cygnus DOT com; run by ezmlm List-Subscribe: List-Archive: List-Post: List-Help: , Sender: cygwin-owner AT sources DOT redhat DOT com Delivered-To: mailing list cygwin AT sources DOT redhat DOT com Date: Fri, 25 Aug 2000 16:12:03 -0400 From: Adam Schlegel To: cygwin AT sources DOT redhat DOT com Subject: symlinks and Emacs Message-ID: <20000825161203.A31819@mailhost.thinkage.ca> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="0F1p//8PRICkK4MW" X-Mailer: Mutt 0.95.4us --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. ;;; 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 "^!\\(.*\\)\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--