9:26 a.m.
User: michaels
Date: 05/03/17 10:26:11
Modified: xemacs/lisp ChangeLog files.el
Log:
2005-03-17 Mike Sperber <mike(a)xemacs.org>
* files.el: Merge the following changes from GNU Emacs:
2005-01-04 Andreas Schwab <schwab(a)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(a)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(a)iro.umontreal.ca>
* files.el (insert-directory): Obey --dired even with symlinks.
2004-05-25 Luc Teirlinck <teirllm(a)auburn.edu>
(insert-directory): Check that lines were really inserted by
the --dired switch, before erasing them.
2004-04-17 Richard M. Stallman <rms(a)gnu.org>
* files.el (insert-directory): Delete any error msg output by the
`insert-directory-program'.
Revision Changes Path
1.653 +32 -0 XEmacs/xemacs/lisp/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.652
retrieving revision 1.653
diff -u -r1.652 -r1.653
--- ChangeLog 2005/03/12 20:57:40 1.652
+++ ChangeLog 2005/03/17 09:26:07 1.653
＠＠ -1,3 +1,35 ＠＠
+2005-03-17 Mike Sperber <mike(a)xemacs.org>
+
+ * files.el: Merge the following changes from GNU Emacs:
+
+ 2005-01-04 Andreas Schwab <schwab(a)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(a)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(a)iro.umontreal.ca>
+
+ * files.el (insert-directory): Obey --dired even with symlinks.
+
+ 2004-05-25 Luc Teirlinck <teirllm(a)auburn.edu>
+
+ (insert-directory): Check that lines were really inserted by
+ the --dired switch, before erasing them.
+
+ 2004-04-17 Richard M. Stallman <rms(a)gnu.org>
+
+ * files.el (insert-directory): Delete any error msg output by the
+ `insert-directory-program'.
+
2005-03-12 Fabrice Popineau <Fabrice.Popineau(a)supelec.fr>
* select.el (get-selection): As described in
1.72 +126 -28 XEmacs/xemacs/lisp/files.el
Index: files.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/files.el,v
retrieving revision 1.71
retrieving revision 1.72
diff -u -r1.71 -r1.72
--- files.el 2004/12/12 02:47:09 1.71
+++ files.el 2005/03/17 09:26:09 1.72
＠＠ -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.