Mailing-List: contact cygwin-help AT cygwin DOT com; run by ezmlm
Sender: cygwin-owner AT cygwin DOT com
Mail-Followup-To: cygwin AT cygwin DOT com
From: "Matt Swift" <swift AT alum DOT mit DOT edu>
To: <F DOT J DOT Wright AT maths DOT qmw DOT ac DOT uk>
Cc: <cygwin AT cygwin DOT com>, <ntemacs-users AT cs DOT washington DOT edu>
Subject: new-style Cygwin symlinks, NTEmacs' dired mode, and ls-lisp.el
Date: Wed, 3 Jul 2002 18:38:17 -0400
Message-ID: <000001c222e2$53bcf180$65ff3018@swift.xxx>
MIME-Version: 1.0
Content-Type: text/plain;
	charset="us-ascii"
Content-Transfer-Encoding: 7bit
Importance: Normal

Maybe this has already been done, but I have hacked ls-lisp.el so that
it understands the new-style Cygwin symlinks (which seem like Windows
shortcuts to Windows, but not to ls-lisp.el).  I have had to
reverse-engineer and hack without a full understanding of shortcut
headers.  Putting the following code in a startup .el file works for me
with EmacsNT 20.7.  It causes Emacs to do two things after loading
dired: load ls-lisp, then redefine one function defined in ls-lisp.el.
My modifications are commented and labeled with "MSS".   I am sending
this email because I think others may be interested in this code.
Someone with full knowledge could make this code more efficient and
address the question of robustness with odd file names and unusual
symlink headers.  

(defun swift-after-dired ()
  "Load `ls-lisp' library.
Redefine `ls-lisp-parse-w32-lnk'."

(load-library "ls-lisp")

; a Windows link and a Cygwin link to test:
; (ls-lisp-parse-w32-lnk "~/lib.lnk")
; (ls-lisp-parse-w32-lnk "~/library.lnk")
(defun ls-lisp-parse-w32-lnk (file)
  "Return file or directory referenced by MS Windows shortcut (.lnk)
FILE.
Return nil if the file cannot be parsed.
MSS modified."
  ;;  Based on \"The Windows Shortcut File Format\" as
  ;;  reverse-engineered by Jesse Hager <jessehager AT iname DOT com>
  ;;  available from http://www.wotsit.org/download.asp?f=shortcut.
  (with-temp-buffer
    (set-buffer-multibyte nil)		; need to force unibyte mode
here!
    (insert-file-contents file)
    (and
     ;; Parse the File Header Table.
     (looking-at "L\0\0\0")		; otherwise not a shortcut file
     ;; Get the main flags dword at offset 14h.
     (let ((flags (ls-lisp-buffer-substring-as-int (+ (point) ?\x14) 4))
	   ;; begin MSS mods
	   ;; add a var to the `let'
	   result)
       ;; Check for new-style cygwin symlinks.
       ;;
       ;; Beware: we seem to be in an environment where errors are
silently
       ;; passed over (how?! `with-temp-file'?), so debugging is a
challenge,
       ;; and the case of flags=12 and yet not the link we expect is a
       ;; problem.
       (if (and (equal flags 12)	; number reverse engineered
		;; always true, so will not affect `and'
;;;		(message "MSS | %s: flags 12" file)
		(setq result
		      ;; The following ought to return nil if we do not
have
		      ;; the link we expect.  I do not know what happens
if we
		      ;; pass the tests so far (.lnk suffix, flags=12)
and it
		      ;; is not a link.

		      ;; Returns the linked tofile name if `file' is a
		      ;; new-style Cygwin symlink.
		      (save-excursion
				    (forward-char 78) ; number reverse
engineered
				    (buffer-substring 79
						      (progn
	
(skip-chars-forward
							 ;; should
include at least all legal
							 ;; filename
chars; if it contains
							 ;; illegal
ones, that's OK as long as
							 ;; they won't
occur in the header
	
"a-zA-Z0-9\-\^\",./<>?;:'[]{}|!@#$%&*()-=_+")
							(point))))))
	   (progn
;;;	     (message "MSS | Result: [%s]" result)
	     result)

	 ;; ELSE not a new-style Cygwin symlink but maybe a Windows
shortcut.

;;;	 (message "MSS | %s: flags other" file)
	 ;; end MSS mods, except one more paren below, because the
following are
	 ;; the `else' forms now (also the `message' just above).

	 ;; Bit 1 set means shortcut to file or directory:
	 (when (= (logand flags 2) 2)
	   ;; Skip to end of Header:
	   (forward-char ?\x4C)
	   ;; Skip Shell Item Id List.
	   ;; It is present if flags bit 0 is set, in which case the
list
	   ;; length is the first word, which must also be skipped:
	   (if (= (logand flags 1) 1)
	       (forward-char
		(+ 2 (ls-lisp-buffer-substring-as-int (point) 2))))
	   ;; Parse the File Location Info Table.
	   ;; The full file pathname is (generally) stored in two
	   ;; pieces: a head depending on whether the file is on a local
	   ;; or network volume and a remaining pathname tail.
	   ;; Get and check the volume flags dword at offset 8h:
	   (setq flags (ls-lisp-buffer-substring-as-int (+ (point) ?\x8)
4))
	   (if (/= (logand flags 3) 0)	; Must have bit 0 or 1 set.
	       (let ((head		; Get local or network
		      (save-excursion	; pathname head.
			;; If bit 0 then local else network:
			(if (setq flags (= (logand flags 1) 1))
			    ;; Go to the base pathname on the local
system at
			    ;; the offset specified as a dword at offset
10h:
			    (forward-char
			     (ls-lisp-buffer-substring-as-int (+ (point)
?\x10) 4))
			  ;; Go to the network volume table at the
offset
			  ;; specified as a dword at offset 14h:
			  (forward-char
			   (ls-lisp-buffer-substring-as-int (+ (point)
?\x14) 4))
			  ;; Go to the network share name at offset 14h:
			  (forward-char ?\x14))
			(buffer-substring (point) (1- (search-forward
"\0")))))
		     (tail		; Get the remaining pathname
tail
		      (progn		; specified as a dword at
			(forward-char	; offset 18h.
			 (ls-lisp-buffer-substring-as-int (+ (point)
?\x18) 4))
			(buffer-substring (point) (1- (search-forward
"\0"))))))
		 (expand-file-name	; Convert \ to /, etc.
		  (concat head
			  ;; Network share name needs trailing \ added:
			  (unless (or flags (string= tail "")) "\\")
			  tail))))))))))
); redefine
(add-hook 'dired-load-hook 'swift-after-dired)


--
Unsubscribe info:      http://cygwin.com/ml/#unsubscribe-simple
Bug reporting:         http://cygwin.com/bugs.html
Documentation:         http://cygwin.com/docs.html
FAQ:                   http://cygwin.com/faq/