mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-17 17:58:46 +00:00
(buffer-save-without-query): New var (buffer-local).
(save-some-buffers): Save those buffers first, w/o asking. (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.
This commit is contained in:
Richard M. Stallman
parent
56011a8c59
commit
a1b0c2a764
162
lisp/files.el
162
lisp/files.el
@ -1200,7 +1200,8 @@ name to this list as a string."
|
||||
"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 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,6 +3364,10 @@ This requires the external program `diff' to be in your `exec-path'."
|
||||
"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,8 +3385,18 @@ See `save-some-buffers-action-alist' if you want to
|
||||
change the additional actions you can take on files."
|
||||
(interactive "P")
|
||||
(save-window-excursion
|
||||
(let* ((queried nil)
|
||||
(files-done
|
||||
(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,19 +3425,22 @@ change the additional actions you can take on files."
|
||||
(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))))
|
||||
;; 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 "(No files need saving)")))))
|
||||
(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,6 +4327,8 @@ program specified by `directory-free-space-program' if that is non-nil."
|
||||
(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,6 +4438,56 @@ normally equivalent short `-D' option is just passed on to
|
||||
(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,23 +4514,39 @@ normally equivalent short `-D' option is just passed on to
|
||||
(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))))
|
||||
(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,6 +4598,18 @@ normally equivalent short `-D' option is just passed on to
|
||||
(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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user