changeset 2671:5402bf7d11a5

[xemacs-hg @ 2005-03-17 09:26:07 by michaels] 2005-03-17 Mike Sperber <mike@xemacs.org> * files.el: Merge the following changes from GNU Emacs: 2005-01-04 Andreas Schwab <schwab@suse.de> * files.el (insert-directory): Only look for error lines in inserted text. Don't move too far after processing --dired markers. 2004-12-27 Richard M. Stallman <rms@gnu.org> * files.el (insert-directory-ls-version): New variable. (insert-directory): When ls returns an error, test the version number to decide what the return code means. With --dired output format, detect and distinguish lines that are really error messages. (insert-directory-adj-pos): New function. 2004-09-25 Stefan Monnier <monnier@iro.umontreal.ca> * files.el (insert-directory): Obey --dired even with symlinks. 2004-05-25 Luc Teirlinck <teirllm@auburn.edu> (insert-directory): Check that lines were really inserted by the --dired switch, before erasing them. 2004-04-17 Richard M. Stallman <rms@gnu.org> * files.el (insert-directory): Delete any error msg output by the `insert-directory-program'.
author michaels
date Thu, 17 Mar 2005 09:26:09 +0000
parents a7412c3275d9
children 75a450280e05
files lisp/ChangeLog lisp/files.el
diffstat 2 files changed, 158 insertions(+), 28 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Mar 16 22:51:36 2005 +0000
+++ b/lisp/ChangeLog	Thu Mar 17 09:26:09 2005 +0000
@@ -1,3 +1,35 @@
+2005-03-17  Mike Sperber  <mike@xemacs.org>
+
+	* files.el: Merge the following changes from GNU Emacs:
+
+	2005-01-04  Andreas Schwab  <schwab@suse.de>
+	
+		* files.el (insert-directory): Only look for error lines in
+		inserted text.  Don't move too far after processing --dired markers.
+	
+	2004-12-27  Richard M. Stallman  <rms@gnu.org>
+	
+		* files.el (insert-directory-ls-version): New variable.
+		(insert-directory): When ls returns an error, test the version
+		number to decide what the return code means.
+		With --dired output format, detect and distinguish lines
+		that are really error messages.
+		(insert-directory-adj-pos): New function.
+	
+	2004-09-25  Stefan Monnier  <monnier@iro.umontreal.ca>
+	
+		* files.el (insert-directory): Obey --dired even with symlinks.
+	
+	2004-05-25  Luc Teirlinck  <teirllm@auburn.edu>
+	
+		(insert-directory): Check that lines were really inserted by
+		the --dired switch, before erasing them.
+	
+	2004-04-17  Richard M. Stallman  <rms@gnu.org>
+	
+		* files.el (insert-directory): Delete any error msg output by the
+		`insert-directory-program'.
+	
 2005-03-12  Fabrice Popineau <Fabrice.Popineau@supelec.fr> 
 
 	* select.el (get-selection): As described in
--- a/lisp/files.el	Wed Mar 16 22:51:36 2005 +0000
+++ b/lisp/files.el	Thu Mar 17 09:26:09 2005 +0000
@@ -4085,6 +4085,8 @@
 
 ;; END SYNC WITH FSF 21.2.
 
+(defvar insert-directory-ls-version 'unknown)
+
 (defun insert-directory (file switches &optional wildcard full-directory-p)
   "Insert directory listing for FILE, formatted according to SWITCHES.
 Leaves point after the inserted text.
@@ -4165,13 +4167,73 @@
 					      ;;#### Unix-specific
 					      ".")
 				    file))))))))
+
+	  ;; If we got "//DIRED//" in the output, it means we got a real
+	  ;; directory listing, even if `ls' returned nonzero.
+	  ;; So ignore any errors.
+	  (when (if (stringp switches)
+		    (string-match "--dired\\>" switches)
+		  (member "--dired" switches))
+	    (save-excursion
+	      (forward-line -2)
+	      (when (looking-at "//SUBDIRED//")
+		(forward-line -1))
+	      (if (looking-at "//DIRED//")
+		  (setq result 0))))
+
+	  (when (and (not (eq 0 result))
+		     (eq insert-directory-ls-version 'unknown))
+	    ;; The first time ls returns an error,
+	    ;; find the version numbers of ls,
+	    ;; and set insert-directory-ls-version
+	    ;; to > if it is more than 5.2.1, < if it is less, nil if it
+	    ;; is equal or if the info cannot be obtained.
+	    ;; (That can mean it isn't GNU ls.)
+	    (let ((version-out
+		   (with-temp-buffer
+		     (call-process "ls" nil t nil "--version")
+		     (buffer-string))))
+	      (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out)
+		  (let* ((version (match-string 1 version-out))
+			 (split (split-string version "[.]"))
+			 (numbers (mapcar 'string-to-int split))
+			 (min '(5 2 1))
+			 comparison)
+		    (while (and (not comparison) (or numbers min))
+		      (cond ((null min)
+			     (setq comparison '>))
+			    ((null numbers)
+			     (setq comparison '<))
+			    ((> (car numbers) (car min))
+			     (setq comparison '>))
+			    ((< (car numbers) (car min))
+			     (setq comparison '<))
+			    (t
+			     (setq numbers (cdr numbers)
+				   min (cdr min)))))
+		    (setq insert-directory-ls-version (or comparison '=)))
+		(setq insert-directory-ls-version nil))))
+
+	  ;; For GNU ls versions 5.2.2 and up, ignore minor errors.
+	  (when (and (eq 1 result) (eq insert-directory-ls-version '>))
+	    (setq result 0))
+
 	;; If `insert-directory-program' failed, signal an error.
-	(if (/= result 0)
-	    ;; On non-Posix systems, we cannot open a directory, so
-	    ;; don't even try, because that will always result in
-	    ;; the ubiquitous "Access denied".  Instead, show the
-	    ;; command line so the user can try to guess what went wrong.
-	    (error "Listing directory failed."))
+	(unless (eq 0 result)
+	  ;; Delete the error message it may have output.
+	  (delete-region beg (point))
+	  ;; On non-Posix systems, we cannot open a directory, so
+	  ;; don't even try, because that will always result in
+	  ;; the ubiquitous "Access denied".  Instead, show the
+	  ;; command line so the user can try to guess what went wrong.
+	  (if (and (file-directory-p file)
+		   (memq system-type '(ms-dos windows-nt)))
+	      (error
+	       "Reading directory: \"%s %s -- %s\" exited with status %s"
+	       insert-directory-program
+	       (if (listp switches) (concat switches) switches)
+	       file result)
+	    (error "Listing directory failed")))
 
 	(when (or (and (listp switches)
 		       (member "--dired" switches))
@@ -4180,28 +4242,64 @@
 	  (when (looking-at "//SUBDIRED//")
 	    (delete-region (point) (progn (forward-line 1) (point)))
 	    (forward-line -1))
-	  (let ((end (line-end-position)))
-	    (forward-word 1)
-	    (forward-char 3)
-	    (while (< (point) end)
-	      (let ((start (+ beg (read (current-buffer))))
-		    (end (+ beg (read (current-buffer)))))
-		(if (= (char-after end) ?\n)
-		    (let ((filename-extent (make-extent start end)))
-		      (set-extent-property filename-extent 'dired-file-name t)
-		      (set-extent-property filename-extent 'start-open t)
-		      (set-extent-property filename-extent 'end-open t))
-		  ;; It seems that we can't trust ls's output as to
-		  ;; byte positions of filenames.
-		  (map-extents
-		   #'(lambda (extent maparg)
-		       (delete-extent extent)
-		       nil)
-		   nil beg (point) nil nil 'dired-file-name)
-		  (end-of-line))))
-	    (goto-char end)
-	    (beginning-of-line)
-	    (delete-region (point) (progn (forward-line 2) (point))))))))))
+	  (if (looking-at "//DIRED//")
+	      (let ((end (line-end-position))
+		    (linebeg (point))
+		    error-lines)
+		;; Find all the lines that are error messages,
+		;; and record the bounds of each one.
+		(goto-char beg)
+		(while (< (point) linebeg)
+		  (or (eql (following-char) ?\s)
+		      (push (list (point) (line-end-position)) error-lines))
+		  (forward-line 1))
+		(setq error-lines (nreverse error-lines))
+		;; Now read the numeric positions of file names.
+		(goto-char linebeg)
+		(forward-word 1)
+		(forward-char 3)
+		(while (< (point) end)
+		  (let ((start (insert-directory-adj-pos
+				(+ beg (read (current-buffer)))
+				error-lines))
+			(end (insert-directory-adj-pos
+			      (+ beg (read (current-buffer)))
+			      error-lines)))
+		    (if (memq (char-after end) '(?\n ?\ ))
+			;; End is followed by \n or by " -> ".
+			(let ((filename-extent (make-extent start end)))
+			  (set-extent-property filename-extent 'dired-file-name t)
+			  (set-extent-property filename-extent 'start-open t)
+			  (set-extent-property filename-extent 'end-open t))
+		      ;; It seems that we can't trust ls's output as to
+		      ;; byte positions of filenames.
+		      (map-extents
+		       #'(lambda (extent maparg)
+			   (delete-extent extent)
+			   nil)
+		       nil beg (point) nil nil 'dired-file-name)
+		      (end-of-line))))
+		(goto-char end)
+		(beginning-of-line)
+		(delete-region (point) (progn (forward-line 1) (point))))
+	    ;; Take care of the case where the ls output contains a
+	    ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
+	    ;; and we went one line too far back (see above).
+	    (forward-line 1))
+	  (if (looking-at "//DIRED-OPTIONS//")
+	      (delete-region (point) (progn (forward-line 1) (point))))))))))
+
+(defun insert-directory-adj-pos (pos error-lines)
+  "Convert `ls --dired' file name position value POS to a buffer position.
+File name position values returned in ls --dired output
+count only stdout; they don't count the error messages sent to stderr.
+So this function converts to them to real buffer positions.
+ERROR-LINES is a list of buffer positions of error message lines,
+of the form (START END)."
+  (while (and error-lines (< (caar error-lines) pos))
+    (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines)))))
+    (pop error-lines))
+  pos)
 
 ;; BEGIN SYNC WITH FSF 21.2.