[Emacs-diffs] Changes to emacs/lisp/files.el

[Richard M . Stallman]

Index: emacs/lisp/files.el
diff -c emacs/lisp/files.el:1.732 emacs/lisp/files.el:1.733
*** emacs/lisp/files.el:1.732   Mon Dec 13 05:08:00 2004
--- emacs/lisp/files.el Mon Dec 27 17:18:28 2004
***************
*** 1200,1206 ****
    "Return the buffer visiting file FILENAME (a string).
  This is like `get-file-buffer', except that it checks for any buffer
  visiting the same file, possibly under a different name.
! If PREDICATE is non-nil, only a buffer satisfying it can be returned.
  If there is no such live buffer, return nil."
    (let ((predicate (or predicate #'identity))
          (truename (abbreviate-file-name (file-truename filename))))
--- 1200,1207 ----
    "Return the buffer visiting file FILENAME (a string).
  This is like `get-file-buffer', except that it checks for any buffer
  visiting the same file, possibly under a different name.
! If PREDICATE is non-nil, only buffers satisfying it are eligible,
! and others are ignored.
  If there is no such live buffer, return nil."
    (let ((predicate (or predicate #'identity))
          (truename (abbreviate-file-name (file-truename filename))))
***************
*** 3363,3368 ****
--- 3364,3373 ----
    "ACTION-ALIST argument used in call to `map-y-or-n-p'.")
  (put 'save-some-buffers-action-alist 'risky-local-variable t)
  
+ (defvar buffer-save-without-query nil
+   "Non-nil means `save-some-buffers' should save this buffer without asking.")
+ (make-variable-buffer-local 'buffer-save-without-query)
+ 
  (defun save-some-buffers (&optional arg pred)
    "Save some modified file-visiting buffers.  Asks user about each one.
  You can answer `y' to save, `n' not to save, `C-r' to look at the
***************
*** 3380,3387 ****
  change the additional actions you can take on files."
    (interactive "P")
    (save-window-excursion
!     (let* ((queried nil)
!          (files-done
            (map-y-or-n-p
             (function
              (lambda (buffer)
--- 3385,3402 ----
  change the additional actions you can take on files."
    (interactive "P")
    (save-window-excursion
!     (let* (queried some-automatic
!          files-done abbrevs-done)
!       (dolist (buffer (buffer-list))
!       ;; First save any buffers that we're supposed to save unconditionally.
!       ;; That way the following code won't ask about them.
!       (with-current-buffer buffer
!         (when (and buffer-save-without-query (buffer-modified-p))
!           (setq some-automatic t)
!           (save-buffer))))
!       ;; Ask about those buffers that merit it,
!       ;; and record the number thus saved.
!       (setq files-done
            (map-y-or-n-p
             (function
              (lambda (buffer)
***************
*** 3410,3428 ****
             (buffer-list)
             '("buffer" "buffers" "save")
             save-some-buffers-action-alist))
!          (abbrevs-done
!           (and save-abbrevs abbrevs-changed
!                (progn
!                  (if (or arg
!                          (eq save-abbrevs 'silently)
!                          (y-or-n-p (format "Save abbrevs in %s? "
!                                            abbrev-file-name)))
!                      (write-abbrev-file nil))
!                  ;; Don't keep bothering user if he says no.
!                  (setq abbrevs-changed nil)
!                  t))))
        (or queried (> files-done 0) abbrevs-done
!         (message "(No files need saving)")))))
  
  (defun not-modified (&optional arg)
    "Mark current buffer as unmodified, not needing to be saved.
--- 3425,3446 ----
             (buffer-list)
             '("buffer" "buffers" "save")
             save-some-buffers-action-alist))
!       ;; Maybe to save abbrevs, and record whether 
!       ;; we either saved them or asked to.
!       (and save-abbrevs abbrevs-changed
!          (progn
!            (if (or arg
!                    (eq save-abbrevs 'silently)
!                    (y-or-n-p (format "Save abbrevs in %s? "
!                                      abbrev-file-name)))
!                (write-abbrev-file nil))
!            ;; Don't keep bothering user if he says no.
!            (setq abbrevs-changed nil)
!            (setq abbrevs-done t)))
        (or queried (> files-done 0) abbrevs-done
!         (message (if some-automatic
!                      "(Some special files were saved without asking)"
!                    "(No files need saving)"))))))
  
  (defun not-modified (&optional arg)
    "Mark current buffer as unmodified, not needing to be saved.
***************
*** 4309,4314 ****
--- 4327,4334 ----
                  (buffer-substring (point) end)))))))))
  
  
+ (defvar insert-directory-ls-version 'unknown)
+ 
  ;; insert-directory
  ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
  ;;   FULL-DIRECTORY-P is nil.
***************
*** 4418,4423 ****
--- 4438,4493 ----
                                   (concat (file-name-as-directory file) ".")
                                 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.
          (unless (eq 0 result)
            ;; Delete the error message it may have output.
***************
*** 4444,4466 ****
              (when (looking-at "//SUBDIRED//")
                (delete-region (point) (progn (forward-line 1) (point)))
                (forward-line -1))
!           (if (looking-at "//DIRED//")
!               (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 (memq (char-after end) '(?\n ?\ ))
!                         ;; End is followed by \n or by " -> ".
!                         (put-text-property start end 'dired-filename t)
!                       ;; It seems that we can't trust ls's output as to
!                       ;; byte positions of filenames.
!                       (put-text-property beg (point) 'dired-filename nil)
!                       (end-of-line))))
!                 (goto-char end)
!                 (beginning-of-line)
!                 (delete-region (point) (progn (forward-line 2) (point))))
              (forward-line 1)
              (if (looking-at "//DIRED-OPTIONS//")
                  (delete-region (point) (progn (forward-line 1) (point)))
--- 4514,4552 ----
              (when (looking-at "//SUBDIRED//")
                (delete-region (point) (progn (forward-line 1) (point)))
                (forward-line -1))
!           (when (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 (point-min))
!               (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 " -> ".
!                       (put-text-property start end 'dired-filename t)
!                     ;; It seems that we can't trust ls's output as to
!                     ;; byte positions of filenames.
!                     (put-text-property beg (point) 'dired-filename nil)
!                     (end-of-line))))
!               (goto-char end)
!               (beginning-of-line)
!               (delete-region (point) (progn (forward-line 2) (point))))
              (forward-line 1)
              (if (looking-at "//DIRED-OPTIONS//")
                  (delete-region (point) (progn (forward-line 1) (point)))
***************
*** 4512,4517 ****
--- 4598,4615 ----
                      (end-of-line)
                      (insert " available " available)))))))))))
  
+ (defun insert-directory-adj-pos (pos error-lines)
+   "Convert `ls --dird' 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)
+ 
  (defun insert-directory-safely (file switches
                                     &optional wildcard full-directory-p)
    "Insert directory listing for FILE, formatted according to SWITCHES.