*** w32-symlinks.el 2005-11-05 20:56:09.000000000 +0100 --- w32-symlinks.patched.el 2005-11-07 12:45:28.000000000 +0100 *************** *** 23,30 **** ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ! ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! ;; Boston, MA 02111-1307, USA. ;;; Commentary: --- 23,30 ---- ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ! ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ! ;; Boston, MA 02110-1301, USA. ;;; Commentary: *************** *** 38,48 **** ;; Windows itself does, by making .lnk files names "magic". ;; It contains functions to parse Windows .lnk "shortcut" (and also ! ;; obsolete Cygwin-style "symlink") files, entirely in Lisp. It ! ;; currently (partly for historic reasons) supports `dired' explicitly ! ;; by hooking into the standard ls-lisp library (Emacs 21 or later ! ;; versions ONLY), which is preloaded in NTEmacs. It does this by ! ;; redefining the stub function `ls-lisp-parse-symlink'. It allows ;; `dired' to follow symbolic links when using either ls-lisp (the ;; default) or an external Cygwin ls program. When run on Windows, it ;; also implements the missing `dired-do-symlink' command to make --- 38,44 ---- ;; Windows itself does, by making .lnk files names "magic". ;; It contains functions to parse Windows .lnk "shortcut" (and also ! ;; obsolete Cygwin-style "symlink") files, entirely in Lisp. It allows ;; `dired' to follow symbolic links when using either ls-lisp (the ;; default) or an external Cygwin ls program. When run on Windows, it ;; also implements the missing `dired-do-symlink' command to make *************** *** 217,223 **** All other `dired-mode' commands receive the symlink itself, as per default. Does not include w32-shellex commands, which are handled specially.") ! (defun ls-lisp-parse-symlink (file-name) "Optionally parse FILE-NAME as a MS Windows symlink file, if possible." ;; This function redefines a stub in ls-lisp. (and --- 213,219 ---- All other `dired-mode' commands receive the symlink itself, as per default. Does not include w32-shellex commands, which are handled specially.") ! (defun w32-symlinks-parse-symlink (file-name) "Optionally parse FILE-NAME as a MS Windows symlink file, if possible." ;; This function redefines a stub in ls-lisp. (and *************** *** 653,662 **** (mapc (lambda (x) (put (car x) 'w32-symlinks (cadr x))) '( - ;; Constant return value (in a list to distinguish nil from unset): - (file-regular-p (nil)) - (file-symlink-p (t)) - ;; Apply operation directly to the shortcut file: ;; (These could be omitted since this is the default action!) (add-name-to-file w32-symlinks-operate-on-source) --- 649,654 ---- *************** *** 665,671 **** (delete-file w32-symlinks-operate-on-source) (directory-file-name w32-symlinks-operate-on-source) (expand-file-name w32-symlinks-operate-on-source) - (file-attributes w32-symlinks-operate-on-source) (file-exists-p w32-symlinks-operate-on-source) (file-name-directory w32-symlinks-operate-on-source) (file-name-nondirectory w32-symlinks-operate-on-source) --- 657,662 ---- *************** *** 687,692 **** --- 678,684 ---- (file-newer-than-file-p w32-symlinks-operate-on-target) (file-ownership-preserved-p w32-symlinks-operate-on-target) (file-readable-p w32-symlinks-operate-on-target) + (file-regular-p w32-symlinks-operate-on-target) (file-truename w32-symlinks-operate-on-target) (file-writable-p w32-symlinks-operate-on-target) (find-backup-file-name w32-symlinks-operate-on-target) *************** *** 703,708 **** --- 695,703 ---- (write-region w32-symlinks-operate-on-target) ;; Special cases: + (directory-files-and-attributes w32-symlinks-directory-files-and-attributes) + (file-attributes w32-symlinks-file-attributes) + (file-symlink-p w32-symlinks-file-symlink-p) (insert-file-contents w32-symlinks-insert-file-contents))) ;; Currently unhandled cases: *************** *** 752,757 **** --- 747,781 ---- Called indirectly by `w32-symlinks-file-name-handler'." (w32-symlinks-operate-on-target operation args t)) + (defun w32-symlinks-file-symlink-p (operation args) + (w32-symlinks-parse-symlink (car args))) + + (defun set-attr-symlink (file-and-attr function) + (when (and (cdr file-and-attr) + (not (cadr file-and-attr)) + (setcar (cdr file-and-attr) (w32-symlinks-parse-symlink (car file-and-attr)))) + (aset (nth 9 file-and-attr) 0 ?l))) + + (defun w32-symlinks-file-attributes (operation args) + (let* ((inhibit-file-name-handlers (cons 'w32-symlinks-file-name-handler + (and (eq inhibit-file-name-operation operation) + inhibit-file-name-handlers))) + (inhibit-file-name-operation operation) + (attr (apply operation args))) + (set-attr-symlink (cons (car args) attr) 'w32-symlinks-parse-symlink) + attr)) + + (defun w32-symlinks-directory-files-and-attributes (operation args) + (let* ((inhibit-file-name-handlers (cons 'w32-symlinks-file-name-handler + (and (eq inhibit-file-name-operation operation) + inhibit-file-name-handlers))) + (inhibit-file-name-operation operation) + (attr-alist (apply operation args))) + (mapc (lambda (file-and-attr) + (set-attr-symlink file-and-attr 'w32-symlinks-parse-symlink)) + attr-alist) + attr-alist)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; *************** *** 815,821 **** (fmakunbound 'find-buffer-file-type))))) (eval-and-compile ! (when (eq system-type 'windows-nt) (defadvice file-symlink-p (around file-symlink-p-advice activate compile) ;; The original version is a built-in function. ;; According to (elisp) Magic File Names, it should support magic --- 839,846 ---- (fmakunbound 'find-buffer-file-type))))) (eval-and-compile ! (when (and (< emacs-major-version 22) ; Bug fixed in Emacs 22. ! (eq system-type 'windows-nt)) (defadvice file-symlink-p (around file-symlink-p-advice activate compile) ;; The original version is a built-in function. ;; According to (elisp) Magic File Names, it should support magic *************** *** 823,833 **** ;; (I suspect that it always returns nil in NTEmacs.) (let ((handler (find-file-name-handler filename 'file-symlink-p))) (if handler ! (funcall handler 'file-symlink-p filename) ad-do-it))) )) ! ;; Elisp Manual Error: ;; According to (elisp) Magic File Names, `substitute-in-file-name' ;; does not support magic file name handlers, but it appears that it does. --- 848,858 ---- ;; (I suspect that it always returns nil in NTEmacs.) (let ((handler (find-file-name-handler filename 'file-symlink-p))) (if handler ! (setq ad-return-value (funcall handler 'file-symlink-p filename)) ad-do-it))) )) ! ;; Elisp Manual Error (fixed in Emacs 22): ;; According to (elisp) Magic File Names, `substitute-in-file-name' ;; does not support magic file name handlers, but it appears that it does.