;;; files.el --- file input and output commands for Emacs
-;; Copyright (C) 1985, 86, 87, 92, 93, 94 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 92, 93, 94, 1995 Free Software Foundation, Inc.
;; Maintainer: FSF
'(("\\.text\\'" . text-mode)
("\\.c\\'" . c-mode)
("\\.h\\'" . c-mode)
- ("\\.tex\\'" . TeX-mode)
- ("\\.ltx\\'" . LaTeX-mode)
+ ("\\.tex\\'" . tex-mode)
+ ("\\.ltx\\'" . latex-mode)
("\\.el\\'" . emacs-lisp-mode)
("\\.mm\\'" . nroff-mode)
("\\.me\\'" . nroff-mode)
("\\.hh\\'" . c++-mode)
("\\.C\\'" . c++-mode)
("\\.H\\'" . c++-mode)
+ ("\\.cpp\\'" . c++-mode)
+ ("\\.cxx\\'" . c++-mode)
+ ("\\.hxx\\'" . c++-mode)
+ ("\\.c\\+\\+\\'" . c++-mode)
+ ("\\.h\\+\\+\\'" . c++-mode)
;;; ("\\.mk\\'" . makefile-mode)
;;; ("[Mm]akefile" . makefile-mode)
;;; Less common extensions come here
;; The following should come after the ChangeLog pattern
;; for the sake of ChangeLog.1, etc.
("\\.[12345678]\\'" . nroff-mode)
- ("\\.TeX\\'" . TeX-mode)
- ("\\.sty\\'" . LaTeX-mode)
- ("\\.bbl\\'" . LaTeX-mode)
+ ("\\.TeX\\'" . tex-mode)
+ ("\\.sty\\'" . latex-mode)
+ ("\\.cls\\'" . latex-mode) ;LaTeX 2e class
+ ("\\.bbl\\'" . latex-mode)
("\\.bib\\'" . bibtex-mode)
("\\.article\\'" . text-mode)
("\\.letter\\'" . text-mode)
;; /tmp/Re.... or Message
("^/tmp/Re" . text-mode)
("/Message[0-9]*\\'" . text-mode)
+ ("/drafts/[0-9]+\\'" . mh-letter-mode)
;; some news reader is reported to use this
("^/tmp/fol/" . text-mode)
("\\.y\\'" . c-mode)
Remember to delete the initial contents of the minibuffer
if you wish to pass an empty string as the argument."
(interactive "FSet visited file name: ")
+ (if (buffer-base-buffer)
+ (error "An indirect buffer cannot visit a file"))
(let (truename)
(if filename
(setq filename
targets (cdr backup-info))
;;; (if (file-directory-p buffer-file-name)
;;; (error "Cannot save buffer in directory %s" buffer-file-name))
- (condition-case ()
- (let ((delete-old-versions
- ;; If have old versions to maybe delete,
- ;; ask the user to confirm now, before doing anything.
- ;; But don't actually delete til later.
- (and targets
- (or (eq delete-old-versions t) (eq delete-old-versions nil))
- (or delete-old-versions
- (y-or-n-p (format "Delete excess backup versions of %s? "
- real-file-name))))))
- ;; Actually write the back up file.
- (condition-case ()
- (if (or file-precious-flag
-; (file-symlink-p buffer-file-name)
- backup-by-copying
- (and backup-by-copying-when-linked
- (> (file-nlinks real-file-name) 1))
- (and backup-by-copying-when-mismatch
- (let ((attr (file-attributes real-file-name)))
- (or (nth 9 attr)
- (not (file-ownership-preserved-p real-file-name))))))
- (condition-case ()
- (copy-file real-file-name backupname t t)
- (file-error
- ;; If copying fails because file BACKUPNAME
- ;; is not writable, delete that file and try again.
- (if (and (file-exists-p backupname)
- (not (file-writable-p backupname)))
- (delete-file backupname))
- (copy-file real-file-name backupname t t)))
- ;; rename-file should delete old backup.
- (rename-file real-file-name backupname t)
- (setq setmodes (file-modes backupname)))
- (file-error
- ;; If trouble writing the backup, write it in ~.
- (setq backupname (expand-file-name "~/%backup%~"))
- (message "Cannot write backup file; backing up in ~/%%backup%%~")
- (sleep-for 1)
- (condition-case ()
- (copy-file real-file-name backupname t t)
- (file-error
- ;; If copying fails because file BACKUPNAME
- ;; is not writable, delete that file and try again.
- (if (and (file-exists-p backupname)
- (not (file-writable-p backupname)))
- (delete-file backupname))
- (copy-file real-file-name backupname t t)))))
- (setq buffer-backed-up t)
- ;; Now delete the old versions, if desired.
- (if delete-old-versions
- (while targets
- (condition-case ()
- (delete-file (car targets))
- (file-error nil))
- (setq targets (cdr targets))))
- setmodes)
- (file-error nil)))))
+ (if backup-info
+ (condition-case ()
+ (let ((delete-old-versions
+ ;; If have old versions to maybe delete,
+ ;; ask the user to confirm now, before doing anything.
+ ;; But don't actually delete til later.
+ (and targets
+ (or (eq delete-old-versions t) (eq delete-old-versions nil))
+ (or delete-old-versions
+ (y-or-n-p (format "Delete excess backup versions of %s? "
+ real-file-name))))))
+ ;; Actually write the back up file.
+ (condition-case ()
+ (if (or file-precious-flag
+ ; (file-symlink-p buffer-file-name)
+ backup-by-copying
+ (and backup-by-copying-when-linked
+ (> (file-nlinks real-file-name) 1))
+ (and backup-by-copying-when-mismatch
+ (let ((attr (file-attributes real-file-name)))
+ (or (nth 9 attr)
+ (not (file-ownership-preserved-p real-file-name))))))
+ (condition-case ()
+ (copy-file real-file-name backupname t t)
+ (file-error
+ ;; If copying fails because file BACKUPNAME
+ ;; is not writable, delete that file and try again.
+ (if (and (file-exists-p backupname)
+ (not (file-writable-p backupname)))
+ (delete-file backupname))
+ (copy-file real-file-name backupname t t)))
+ ;; rename-file should delete old backup.
+ (rename-file real-file-name backupname t)
+ (setq setmodes (file-modes backupname)))
+ (file-error
+ ;; If trouble writing the backup, write it in ~.
+ (setq backupname (expand-file-name "~/%backup%~"))
+ (message "Cannot write backup file; backing up in ~/%%backup%%~")
+ (sleep-for 1)
+ (condition-case ()
+ (copy-file real-file-name backupname t t)
+ (file-error
+ ;; If copying fails because file BACKUPNAME
+ ;; is not writable, delete that file and try again.
+ (if (and (file-exists-p backupname)
+ (not (file-writable-p backupname)))
+ (delete-file backupname))
+ (copy-file real-file-name backupname t t)))))
+ (setq buffer-backed-up t)
+ ;; Now delete the old versions, if desired.
+ (if delete-old-versions
+ (while targets
+ (condition-case ()
+ (delete-file (car targets))
+ (file-error nil))
+ (setq targets (cdr targets))))
+ setmodes)
+ (file-error nil))))))
(defun file-name-sans-versions (name &optional keep-backup-version)
"Return FILENAME sans backup versions or strings.
(defun find-backup-file-name (fn)
"Find a file name for a backup file, and suggestions for deletions.
Value is a list whose car is the name for the backup file
- and whose cdr is a list of old versions to consider deleting now."
- (if (eq version-control 'never)
- (list (make-backup-file-name fn))
- (let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
- (bv-length (length base-versions))
- possibilities
- (versions nil)
- (high-water-mark 0)
- (deserve-versions-p nil)
- (number-to-delete 0))
- (condition-case ()
- (setq possibilities (file-name-all-completions
- base-versions
- (file-name-directory fn))
- versions (sort (mapcar
- (function backup-extract-version)
- possibilities)
- '<)
- high-water-mark (apply 'max 0 versions)
- deserve-versions-p (or version-control
- (> high-water-mark 0))
- number-to-delete (- (length versions)
- kept-old-versions kept-new-versions -1))
- (file-error
- (setq possibilities nil)))
- (if (not deserve-versions-p)
+ and whose cdr is a list of old versions to consider deleting now.
+If the value is nil, don't make a backup."
+ (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
+ ;; Run a handler for this function so that ange-ftp can refuse to do it.
+ (if handler
+ (funcall handler 'find-backup-file-name fn)
+ (if (eq version-control 'never)
(list (make-backup-file-name fn))
- (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
- (if (and (> number-to-delete 0)
- ;; Delete nothing if there is overflow
- ;; in the number of versions to keep.
- (>= (+ kept-new-versions kept-old-versions -1) 0))
- (mapcar (function (lambda (n)
- (concat fn ".~" (int-to-string n) "~")))
- (let ((v (nthcdr kept-old-versions versions)))
- (rplacd (nthcdr (1- number-to-delete) v) ())
- v))))))))
+ (let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
+ (bv-length (length base-versions))
+ possibilities
+ (versions nil)
+ (high-water-mark 0)
+ (deserve-versions-p nil)
+ (number-to-delete 0))
+ (condition-case ()
+ (setq possibilities (file-name-all-completions
+ base-versions
+ (file-name-directory fn))
+ versions (sort (mapcar
+ (function backup-extract-version)
+ possibilities)
+ '<)
+ high-water-mark (apply 'max 0 versions)
+ deserve-versions-p (or version-control
+ (> high-water-mark 0))
+ number-to-delete (- (length versions)
+ kept-old-versions kept-new-versions -1))
+ (file-error
+ (setq possibilities nil)))
+ (if (not deserve-versions-p)
+ (list (make-backup-file-name fn))
+ (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
+ (if (and (> number-to-delete 0)
+ ;; Delete nothing if there is overflow
+ ;; in the number of versions to keep.
+ (>= (+ kept-new-versions kept-old-versions -1) 0))
+ (mapcar (function (lambda (n)
+ (concat fn ".~" (int-to-string n) "~")))
+ (let ((v (nthcdr kept-old-versions versions)))
+ (rplacd (nthcdr (1- number-to-delete) v) ())
+ v))))))))))
(defun file-nlinks (filename)
"Return number of names file FILENAME has."
(defun basic-save-buffer ()
"Save the current buffer in its visited file, if it has been modified."
(interactive)
- (if (buffer-modified-p)
- (let ((recent-save (recent-auto-save-p))
- setmodes tempsetmodes)
- ;; On VMS, rename file and buffer to get rid of version number.
- (if (and (eq system-type 'vax-vms)
- (not (string= buffer-file-name
- (file-name-sans-versions buffer-file-name))))
- (let (buffer-new-name)
- ;; Strip VMS version number before save.
- (setq buffer-file-name
- (file-name-sans-versions buffer-file-name))
- ;; Construct a (unique) buffer name to correspond.
- (let ((buf (create-file-buffer (downcase buffer-file-name))))
- (setq buffer-new-name (buffer-name buf))
- (kill-buffer buf))
- (rename-buffer buffer-new-name)))
- ;; If buffer has no file name, ask user for one.
- (or buffer-file-name
- (set-visited-file-name
- (expand-file-name (read-file-name "File to save in: ") nil)))
- (or (verify-visited-file-modtime (current-buffer))
- (not (file-exists-p buffer-file-name))
- (yes-or-no-p
- (format "%s has changed since visited or saved. Save anyway? "
- (file-name-nondirectory buffer-file-name)))
- (error "Save not confirmed"))
- (save-restriction
- (widen)
- (and (> (point-max) 1)
- (/= (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
- (goto-char (point-max))
- (insert ?\n)))
- (or (run-hook-with-args-until-success 'write-contents-hooks)
- (run-hook-with-args-until-success 'local-write-file-hooks)
- (run-hook-with-args-until-success 'write-file-hooks)
- ;; If a hook returned t, file is already "written".
- ;; Otherwise, write it the usual way now.
- (setq setmodes (basic-save-buffer-1)))
- (setq buffer-file-number (nth 10 (file-attributes buffer-file-name)))
- (if setmodes
- (condition-case ()
- (set-file-modes buffer-file-name setmodes)
- (error nil))))
- ;; If the auto-save file was recent before this command,
- ;; delete it now.
- (delete-auto-save-file-if-necessary recent-save)
- (run-hooks 'after-save-hook))
- (message "(No changes need to be saved)")))
+ (save-excursion
+ ;; In an indirect buffer, save its base buffer instead.
+ (if (buffer-base-buffer)
+ (set-buffer (buffer-base-buffer)))
+ (if (buffer-modified-p)
+ (let ((recent-save (recent-auto-save-p))
+ setmodes tempsetmodes)
+ ;; On VMS, rename file and buffer to get rid of version number.
+ (if (and (eq system-type 'vax-vms)
+ (not (string= buffer-file-name
+ (file-name-sans-versions buffer-file-name))))
+ (let (buffer-new-name)
+ ;; Strip VMS version number before save.
+ (setq buffer-file-name
+ (file-name-sans-versions buffer-file-name))
+ ;; Construct a (unique) buffer name to correspond.
+ (let ((buf (create-file-buffer (downcase buffer-file-name))))
+ (setq buffer-new-name (buffer-name buf))
+ (kill-buffer buf))
+ (rename-buffer buffer-new-name)))
+ ;; If buffer has no file name, ask user for one.
+ (or buffer-file-name
+ (set-visited-file-name
+ (expand-file-name (read-file-name "File to save in: ") nil)))
+ (or (verify-visited-file-modtime (current-buffer))
+ (not (file-exists-p buffer-file-name))
+ (yes-or-no-p
+ (format "%s has changed since visited or saved. Save anyway? "
+ (file-name-nondirectory buffer-file-name)))
+ (error "Save not confirmed"))
+ (save-restriction
+ (widen)
+ (and (> (point-max) 1)
+ (/= (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
+ (goto-char (point-max))
+ (insert ?\n)))
+ (or (run-hook-with-args-until-success 'write-contents-hooks)
+ (run-hook-with-args-until-success 'local-write-file-hooks)
+ (run-hook-with-args-until-success 'write-file-hooks)
+ ;; If a hook returned t, file is already "written".
+ ;; Otherwise, write it the usual way now.
+ (setq setmodes (basic-save-buffer-1)))
+ (setq buffer-file-number (nth 10 (file-attributes buffer-file-name)))
+ (if setmodes
+ (condition-case ()
+ (set-file-modes buffer-file-name setmodes)
+ (error nil))))
+ ;; If the auto-save file was recent before this command,
+ ;; delete it now.
+ (delete-auto-save-file-if-necessary recent-save)
+ (run-hooks 'after-save-hook))
+ (message "(No changes need to be saved)"))))
;; This does the "real job" of writing a buffer into its visited file
;; and making a backup file. This is what is normally done
(function
(lambda (buffer)
(and (buffer-modified-p buffer)
+ (not (buffer-base-buffer buffer))
(or
(buffer-file-name buffer)
(and exiting
\f
(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."
+With prefix arg, mark buffer as modified, so \\[save-buffer] will save.
+
+It is not a good idea to use this function in Lisp programs, because it
+prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
(interactive "P")
(message (if arg "Modification-flag set"
"Modification-flag cleared"))
With a prefix argument, offer to revert from latest auto-save file, if
that is more recent than the visited file.
-When called from lisp, The first argument is IGNORE-AUTO; only offer
+When called from Lisp, the first argument is IGNORE-AUTO; only offer
to revert from the auto-save file when this is nil. Note that the
sense of this argument is the reverse of the prefix argument, for the
sake of backward compatibility. IGNORE-AUTO is optional, defaulting
;; there's no straightforward way to encourage authors to notice a
;; reversal of the argument sense. So I'm just changing the user
;; interface, but leaving the programmatic interface the same.
- (interactive (list (not prefix-arg)))
+ (interactive (list (not current-prefix-arg)))
(if revert-buffer-function
(funcall revert-buffer-function ignore-auto noconfirm)
(let* ((opoint (point))
(insert-file-contents file-name (not auto-save-p)
nil nil t)))
(goto-char (min opoint (point-max)))
+ ;; Recompute the truename in case changes in symlinks
+ ;; have changed the truename.
+ (setq buffer-file-truename
+ (abbreviate-file-name (file-truename buffer-file-name)))
(after-find-file nil nil t t)
(run-hooks 'after-revert-hook)
t)))))
(defun recover-file (file)
"Visit file FILE, but get contents from its last auto-save file."
- (interactive
- (let ((prompt-file buffer-file-name)
- (file-name nil)
- (file-dir nil))
- (and prompt-file
- (setq file-name (file-name-nondirectory prompt-file)
- file-dir (file-name-directory prompt-file)))
- (list (read-file-name "Recover file: "
- file-dir nil nil file-name))))
+ ;; Actually putting the file name in the minibuffer should be used
+ ;; only rarely.
+ ;; Not just because users often use the default.
+ (interactive "fRecover file: ")
(setq file (expand-file-name file))
(if (auto-save-file-name-p (file-name-nondirectory file))
(error "%s is an auto-save file" file))
(defvar kill-emacs-query-functions nil
"Functions to call with no arguments to query about killing Emacs.
-If any of these functions returns nil, killing Emacs is cancelled.")
+If any of these functions returns nil, killing Emacs is cancelled.
+`save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions,
+but `kill-emacs', the low level primitive, does not.
+See also `kill-emacs-hook'.")
(defun save-buffers-kill-emacs (&optional arg)
"Offer to save each buffer, then kill this Emacs process.
(or (not active)
(yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
;; Query the user for other things, perhaps.
- (not (run-hook-with-args-until-failure 'kill-emacs-query-functions))
+ (run-hook-with-args-until-failure 'kill-emacs-query-functions)
(kill-emacs)))
\f
(define-key ctl-x-map "\C-f" 'find-file)
HCoop / bpt / emacs.git / blobdiff