This is the mail archive of the mailing list for the Cygwin project.

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

new-style Cygwin symlinks, NTEmacs' dired mode, and ls-lisp.el

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)
Return nil if the file cannot be parsed.
MSS modified."
  ;;  Based on \"The Windows Shortcut File Format\" as
  ;;  reverse-engineered by Jesse Hager <>
  ;;  available from
    (set-buffer-multibyte nil)		; need to force unibyte mode
    (insert-file-contents file)
     ;; 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'
       ;; Check for new-style cygwin symlinks.
       ;; Beware: we seem to be in an environment where errors are
       ;; passed over (how?! `with-temp-file'?), so debugging is a
       ;; 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
		      ;; 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.
				    (forward-char 78) ; number reverse
				    (buffer-substring 79
							 ;; 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
;;;	     (message "MSS | Result: [%s]" result)

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

;;;	 (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
	   ;; length is the first word, which must also be skipped:
	   (if (= (logand flags 1) 1)
		(+ 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)
	   (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
			     (ls-lisp-buffer-substring-as-int (+ (point)
?\x10) 4))
			  ;; Go to the network volume table at the
			  ;; specified as a dword at offset 14h:
			   (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
		     (tail		; Get the remaining pathname
		      (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
		 (expand-file-name	; Convert \ to /, etc.
		  (concat head
			  ;; Network share name needs trailing \ added:
			  (unless (or flags (string= tail "")) "\\")
); redefine
(add-hook 'dired-load-hook 'swift-after-dired)

Unsubscribe info:
Bug reporting:

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]