comparison lisp/files.el @ 90070:95879cc1ed20

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-81 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-748 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-749 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-750 Merge from gnus--rel--5.10 * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-751 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-753 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-754 Merge from gnus--rel--5.10 * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-755 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-757 Update from CVS * [e-mail]--gnu-2004/gnus--rel--5.10--patch-78 Merge from emacs--cvs-trunk--0 * [e-mail]--gnu-2004/gnus--rel--5.10--patch-79 - [e-mail]--gnu-2004/gnus--rel--5.10--patch-80 Update from CVS * [e-mail]--gnu-2004/gnus--rel--5.10--patch-81 Merge from emacs--cvs-trunk--0 * [e-mail]--gnu-2004/gnus--rel--5.10--patch-82 Update from CVS

90069:fa0a5c4db2c8

Includes the new backup.  Must be > 0"
  :type 'integer
  :group 'backup)

(defcustom require-final-newline nil
  "*Value of t says silently ensure a file ends in a newline when it is saved.
Non-nil but not t says ask user whether to add a newline when there isn't one.
nil means don't add newlines."
  :type '(choice (const :tag "Off" nil)
		 (const :tag "Add" t)
		 (other :tag "Ask" ask))
  :group 'editing-basics)

(defcustom auto-save-default t
  "*Non-nil says by default do auto-saving of every file-visiting buffer."
  :type 'boolean
  :group 'auto-save)

(defun find-buffer-visiting (filename &optional predicate)
  "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))))
    (or (let ((buf (get-file-buffer filename)))
          (when (and buf (funcall predicate buf)) buf))

    (setq buffer-read-only t))
  (unless nomodes
    (when (and view-read-only view-mode)
      (view-mode-disable))
    (normal-mode t)
    (when (and buffer-read-only
	       view-read-only
	       (not (eq (get major-mode 'mode-class) 'special)))
      (view-mode-enter))
    (run-hooks 'find-file-hook)))

					      (if buffer-file-name
						  (file-name-nondirectory
						   buffer-file-name)
						(concat "buffer "
							(buffer-name))))))))))
	  (let (prefix prefixlen suffix beg
		(enable-local-eval enable-local-eval))
	    ;; The prefix is what comes before "local variables:" in its line.
	    ;; The suffix is what comes after "local variables:" in its line.
	    (skip-chars-forward " \t")
	    (or (eolp)

	    (or (bolp)
		(setq prefix
		      (buffer-substring (point)
					(progn (beginning-of-line) (point)))))

	    (if prefix (setq prefixlen (length prefix)
			     prefix (regexp-quote prefix)))
	    (if suffix (setq suffix (concat (regexp-quote suffix) "$")))
	    (forward-line 1)
	    (let ((startpos (point))
		  endpos
		  (thisbuf (current-buffer)))

		   (not find-file-literally)
		   (/= (char-after (1- (point-max))) ?\n)
		   (not (and (eq selective-display t)
			     (= (char-after (1- (point-max))) ?\r)))
		   (or (eq require-final-newline t)
		       (and require-final-newline
			    (y-or-n-p
			     (format "Buffer %s does not end in newline.  Add one? "
				     (buffer-name)))))
		   (save-excursion

;; It returns a value (MODES . BACKUPNAME), like backup-buffer.
(defun basic-save-buffer-1 ()
  (if save-buffer-coding-system
      (let ((coding-system-for-write save-buffer-coding-system))
	(basic-save-buffer-2))
    (basic-save-buffer-2)))

;; This returns a value (MODES . BACKUPNAME), like backup-buffer.
(defun basic-save-buffer-2 ()
  (let (tempsetmodes setmodes)
    (if (not (file-writable-p buffer-file-name))

    (?d diff-buffer-with-file
	"show difference to last saved version"))
  "ACTION-ALIST argument used in call to `map-y-or-n-p'.")
(put 'save-some-buffers-action-alist 'risky-local-variable t)

(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
buffer in question with `view-buffer' before deciding or `d' to
view the differences using `diff-buffer-to-file'.

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
	    (map-y-or-n-p
	     (function
	      (lambda (buffer)
		(and (buffer-modified-p buffer)
		     (not (buffer-base-buffer buffer))

		(set-buffer buffer)
		(save-buffer)))
	     (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.
With prefix arg, mark buffer as modified, so \\[save-buffer] will save.

		   (let ((buffer-file-name nil))
		     (or auto-save-p
			 (unlock-buffer)))
		   (widen)
		   (let ((coding-system-for-read
			  ;; Auto-saved file shoule be read without
			  ;; any code conversion.
			  (if auto-save-p 'utf-8-emacs
			    (or coding-system-for-read
				buffer-file-coding-system))))
		     ;; This force after-insert-file-set-coding
		     ;; (called from insert-file-contents) to set
		     ;; buffer-file-coding-system to a proper value.
		     (kill-local-variable 'buffer-file-coding-system)

		(let ((end (point)))
		  (forward-word -1)
		  (buffer-substring (point) end)))))))))


;; insert-directory
;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
;;   FULL-DIRECTORY-P is nil.
;;   The single line of output must display FILE's name as it was
;;   given, namely, an absolute path name.

			      (list
			       (if full-directory-p
				   (concat (file-name-as-directory file) ".")
				 file))))))))

	  ;; If `insert-directory-program' failed, signal an error.
	  (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

		  (member "--dired" switches))
	    (forward-line -2)
            (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)))
		(forward-line 1))))

		    (when available
		      ;; Replace "total" with "used", to avoid confusion.
		      (replace-match "total used in directory" nil nil nil 1)
		      (end-of-line)
		      (insert " available " available)))))))))))

(defun insert-directory-safely (file switches
				     &optional wildcard full-directory-p)
  "Insert directory listing for FILE, formatted according to SWITCHES.

90070:95879cc1ed20

Includes the new backup.  Must be > 0"
  :type 'integer
  :group 'backup)

(defcustom require-final-newline nil
  "*Whether to add a newline automatically at the end of the file.

A value of t means do this only when the file is about to be saved.
A value of `visit' means do this right after the file is visited.
A value of `visit-save' means do it at both of those times.
Any other non-nil value means ask user whether to add a newline, when saving.
nil means don't add newlines.

Certain major modes set this locally to the value obtained
from `mode-require-final-newline'."
  :type '(choice (const :tag "When visiting" visit)
		 (const :tag "When saving" t)
		 (const :tag "When visiting or saving" visit-save)
		 (const :tag "Never" nil)
		 (other :tag "Ask" ask))
  :group 'editing-basics)

(defcustom mode-require-final-newline t
  "*Whether to add a newline at the end of the file, in certain major modes.
Those modes set `require-final-newline' to this value when you enable them.
They do so because they are used for files that are supposed
to end in newlines, and the question is how to arrange that.

A value of t means do this only when the file is about to be saved.
A value of `visit' means do this right after the file is visited.
A value of `visit-save' means do it at both of those times.
Any other non-nil value means ask user whether to add a newline, when saving."
  :type '(choice (const :tag "When visiting" visit)
		 (const :tag "When saving" t)
		 (const :tag "When visiting or saving" visit-save)
		 (other :tag "Ask" ask))
  :group 'editing-basics
  :version "21.4")

(defcustom auto-save-default t
  "*Non-nil says by default do auto-saving of every file-visiting buffer."
  :type 'boolean
  :group 'auto-save)

(defun find-buffer-visiting (filename &optional predicate)
  "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))))
    (or (let ((buf (get-file-buffer filename)))
          (when (and buf (funcall predicate buf)) buf))

    (setq buffer-read-only t))
  (unless nomodes
    (when (and view-read-only view-mode)
      (view-mode-disable))
    (normal-mode t)
    ;; If requested, add a newline at the end of the file.
    (and (memq require-final-newline '(visit visit-save))
	 (> (point-max) (point-min))
	 (/= (char-after (1- (point-max))) ?\n)
	 (not (and (eq selective-display t)
		   (= (char-after (1- (point-max))) ?\r)))
	 (save-excursion
	   (goto-char (point-max))
	   (insert "\n")))
    (when (and buffer-read-only
	       view-read-only
	       (not (eq (get major-mode 'mode-class) 'special)))
      (view-mode-enter))
    (run-hooks 'find-file-hook)))

					      (if buffer-file-name
						  (file-name-nondirectory
						   buffer-file-name)
						(concat "buffer "
							(buffer-name))))))))))
	  (let (prefix suffix beg
		(enable-local-eval enable-local-eval))
	    ;; The prefix is what comes before "local variables:" in its line.
	    ;; The suffix is what comes after "local variables:" in its line.
	    (skip-chars-forward " \t")
	    (or (eolp)

	    (or (bolp)
		(setq prefix
		      (buffer-substring (point)
					(progn (beginning-of-line) (point)))))

	    (setq prefix (if prefix (regexp-quote prefix) "^"))
	    (if suffix (setq suffix (concat (regexp-quote suffix) "$")))
	    (forward-line 1)
	    (let ((startpos (point))
		  endpos
		  (thisbuf (current-buffer)))

		   (not find-file-literally)
		   (/= (char-after (1- (point-max))) ?\n)
		   (not (and (eq selective-display t)
			     (= (char-after (1- (point-max))) ?\r)))
		   (or (eq require-final-newline t)
		       (eq require-final-newline 'visit-save)
		       (and require-final-newline
			    (y-or-n-p
			     (format "Buffer %s does not end in newline.  Add one? "
				     (buffer-name)))))
		   (save-excursion

;; It returns a value (MODES . BACKUPNAME), like backup-buffer.
(defun basic-save-buffer-1 ()
  (if save-buffer-coding-system
      (let ((coding-system-for-write save-buffer-coding-system))
	(basic-save-buffer-2))
    (basic-save-buffer-2))
  (setq buffer-file-coding-system-explicit last-coding-system-used))

;; This returns a value (MODES . BACKUPNAME), like backup-buffer.
(defun basic-save-buffer-2 ()
  (let (tempsetmodes setmodes)
    (if (not (file-writable-p buffer-file-name))

    (?d diff-buffer-with-file
	"show difference to last saved version"))
  "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
buffer in question with `view-buffer' before deciding or `d' to
view the differences using `diff-buffer-to-file'.

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 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)
		(and (buffer-modified-p buffer)
		     (not (buffer-base-buffer buffer))

		(set-buffer buffer)
		(save-buffer)))
	     (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.
With prefix arg, mark buffer as modified, so \\[save-buffer] will save.

		   (let ((buffer-file-name nil))
		     (or auto-save-p
			 (unlock-buffer)))
		   (widen)
		   (let ((coding-system-for-read
			  ;; Auto-saved file shoule be read by Emacs'
			  ;; internal coding.
			  (if auto-save-p 'auto-save-coding
			    (or coding-system-for-read
				buffer-file-coding-system-explicit))))
		     ;; This force after-insert-file-set-coding
		     ;; (called from insert-file-contents) to set
		     ;; buffer-file-coding-system to a proper value.
		     (kill-local-variable 'buffer-file-coding-system)

		(let ((end (point)))
		  (forward-word -1)
		  (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.
;;   The single line of output must display FILE's name as it was
;;   given, namely, an absolute path name.

			      (list
			       (if full-directory-p
				   (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.
	    (delete-region beg (point))
	    ;; On non-Posix systems, we cannot open a directory, so

		  (member "--dired" switches))
	    (forward-line -2)
            (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)))
		(forward-line 1))))

		    (when available
		      ;; Replace "total" with "used", to avoid confusion.
		      (replace-match "total used in directory" nil nil nil 1)
		      (end-of-line)
		      (insert " available " available)))))))))))

(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)

(defun insert-directory-safely (file switches
				     &optional wildcard full-directory-p)
  "Insert directory listing for FILE, formatted according to SWITCHES.