From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Jari Aalto Newsgroups: gmane.emacs.devel Subject: ["Matt Swift" ] new-style Cygwin symlinks, NTEmacs' dired mode, and ls-lisp.el Date: Wed, 10 Jul 2002 18:47:03 +0300 Sender: emacs-devel-admin@gnu.org Message-ID: NNTP-Posting-Host: localhost.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: main.gmane.org 1026316146 9633 127.0.0.1 (10 Jul 2002 15:49:06 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Wed, 10 Jul 2002 15:49:06 +0000 (UTC) Keywords: com,cygwin,file,flags,point,jul,hotpop,offset,shortcut,received,network,mss Cc: "Matt Swift" , Emacs-L pretest Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by main.gmane.org with esmtp (Exim 3.33 #1 (Debian)) id 17SJiD-0002VB-00 for ; Wed, 10 Jul 2002 17:49:05 +0200 Original-Received: from fencepost.gnu.org ([199.232.76.164]) by quimby.gnus.org with esmtp (Exim 3.12 #1 (Debian)) id 17SJrB-0006Qa-00 for ; Wed, 10 Jul 2002 17:58:21 +0200 Original-Received: from localhost ([127.0.0.1] helo=fencepost.gnu.org) by fencepost.gnu.org with esmtp (Exim 3.35 #1 (Debian)) id 17SJhK-0006bZ-00; Wed, 10 Jul 2002 11:48:10 -0400 Original-Received: from smtp2.sooninternet.net ([212.246.17.84]) by fencepost.gnu.org with esmtp (Exim 3.35 #1 (Debian)) id 17SJh4-0006bF-00 for ; Wed, 10 Jul 2002 11:47:55 -0400 Original-Received: from poboxes.com (ip10-133.dial.tpo.fi [212.246.177.133]) by smtp2.sooninternet.net (8.10.2+Sun/8.10.2) with ESMTP id g6AFmUT22055; Wed, 10 Jul 2002 18:48:37 +0300 (EEST) Original-To: Sebastian Kremer X-Sender-Info: Emacs resources http://tiny-tools.sourceforge.net/ http://poboxes.com/jari.aalto ICQ 'jari-aalto' 82313129 PGP 2.6.x keyid 47141D35 http://www.pgpi.net/ Original-Lines: 216 User-Agent: Gnus/5.090007 (Oort Gnus v0.07) Emacs/20.7 (i386-*-nt5.0.2195) (i386-*-nt5.0.2195) Errors-To: emacs-devel-admin@gnu.org X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.0.11 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: Xref: main.gmane.org gmane.emacs.devel:5631 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:5631 Sebastian and Emacs dev team, could you look at this code and incorporate it into the Main distributions. The code is welcomed in Win32 environment. Jari -------------------- Start of forwarded message -------------------- X-From-Line: cygwin-return-53232-letters=hotpop.com@cygwin.com Thu Jul 4 01:39:40 2002 Received: from snickers.hotpop.com (snickers.hotpop.com [204.57.55.49]) by faraday.tpu.fi (8.9.3/8.9.3) with ESMTP id BAA06106 for ; Thu, 4 Jul 2002 01:39:39 +0300 (EET DST) Received: from hotpop.com (kubrick.hotpop.com [204.57.55.16]) by snickers.hotpop.com (Postfix) with SMTP id 722BA76A3C for ; Wed, 3 Jul 2002 22:39:30 +0000 (UTC) Received: from sources.redhat.com (sources.redhat.com [209.249.29.67]) by mx1.hotpop.com (Postfix) with SMTP id ACE34E8025 for ; Wed, 3 Jul 2002 22:39:25 +0000 (UTC) Received: (qmail 11353 invoked by alias); 3 Jul 2002 22:38:31 -0000 Mailing-List: contact cygwin-help@cygwin.com; run by ezmlm Precedence: bulk List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: cygwin-owner@cygwin.com Mail-Followup-To: cygwin@cygwin.com Delivered-To: mailing list cygwin@cygwin.com Received: (qmail 11290 invoked from network); 3 Jul 2002 22:38:28 -0000 Received: from unknown (HELO smtprelay9.dc2.adelphia.net) (64.8.50.53) by sources.redhat.com with SMTP; 3 Jul 2002 22:38:28 -0000 Received: from zayin ([24.48.255.101]) by smtprelay9.dc2.adelphia.net (Netscape Messaging Server 4.15) with ESMTP id GYP2W100.3CW; Wed, 3 Jul 2002 18:38:25 -0400 From: "Matt Swift" To: Cc: , 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> X-Priority: 3 (Normal) X-MSMail-Priority: Normal Importance: Normal X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2600.0000 Lines: 159 Xref: W2KPICASSO list.cygwin:37159 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 ;; 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/ -------------------- End of forwarded message -------------------- -- http://tiny-tools.sourceforge.net/ Swatch @time http://www.ryanthiessen.com/swatch/resources.htm Convert @time http://www.mir.com.my/iTime/itime.htm