;;; Code:
(defconst delete-auto-save-files t
- "*Non-nil means delete a buffer's auto-save file when the buffer is saved.")
+ "*Non-nil means delete auto-save file when a buffer is saved or killed.")
(defconst directory-abbrev-alist
nil
(defvar buffer-file-truename nil
"The abbreviated truename of the file visited in the current buffer.
-That is, (abbreviated-file-name (file-truename buffer-file-name)).
+That is, (abbreviate-file-name (file-truename buffer-file-name)).
This variable is automatically local in all buffers, when non-nil.")
(make-variable-buffer-local 'buffer-file-truename)
(put 'buffer-file-truename 'permanent-local t)
(defvar dired-kept-versions 2
"*When cleaning directory, number of versions to keep.")
-(defvar trim-versions-without-asking nil
- "*If t, deletes excess backup versions silently.
-If nil, asks confirmation. Any other value prevents any trimming.")
+(defvar delete-old-versions nil
+ "*If t, delete excess backup versions silently.
+If nil, ask confirmation. Any other value prevents any trimming.")
(defvar kept-old-versions 2
"*Number of oldest versions to keep when a new numbered backup is made.")
(defun cd-absolute (dir)
"Change current directory to given absolute file name DIR."
- (setq dir (abbreviate-file-name (expand-file-name dir)))
+ ;; Put the name into directory syntax now,
+ ;; because otherwise expand-file-name may give some bad results.
(if (not (eq system-type 'vax-vms))
(setq dir (file-name-as-directory dir)))
+ (setq dir (abbreviate-file-name (expand-file-name dir)))
(if (not (file-directory-p dir))
(error "%s is not a directory" dir)
(if (file-executable-p dir)
(funcall handler 'file-local-copy file)
nil)))
-(defun file-truename (filename)
+(defun file-truename (filename &optional counter prev-dirs)
"Return the truename of FILENAME, which should be absolute.
The truename of a file name is found by chasing symbolic links
both at the level of the file and at the level of the directories
-containing it, until no links are left at any level."
+containing it, until no links are left at any level.
+
+The arguments COUNTER and PREV-DIRS are used only in recursive calls.
+Do not specify them in other calls."
+ ;; COUNTER can be a cons cell whose car is the count of how many more links
+ ;; to chase before getting an error.
+ ;; PREV-DIRS can be a cons cell whose car is an alist
+ ;; of truenames we've just recently computed.
(if (or (string= filename "~")
(and (string= (substring filename 0 1) "~")
(string-match "~[^/]*" filename)))
(setq filename (expand-file-name filename))
(if (string= filename "")
(setq filename "/"))))
- (let ((handler (find-file-name-handler filename 'file-truename)))
- ;; For file name that has a special handler, call handler.
- ;; This is so that ange-ftp can save time by doing a no-op.
- (if handler
- (funcall handler 'file-truename filename)
- (let ((dir (file-name-directory filename))
- target dirfile)
- ;; Get the truename of the directory.
- (setq dirfile (directory-file-name dir))
- ;; If these are equal, we have the (or a) root directory.
- (or (string= dir dirfile)
- (setq dir (file-name-as-directory (file-truename dirfile))))
- (if (equal ".." (file-name-nondirectory filename))
- (directory-file-name (file-name-directory (directory-file-name dir)))
- (if (equal "." (file-name-nondirectory filename))
- (directory-file-name dir)
- ;; Put it back on the file name.
- (setq filename (concat dir (file-name-nondirectory filename)))
- ;; Is the file name the name of a link?
- (setq target (file-symlink-p filename))
- (if target
- ;; Yes => chase that link, then start all over
- ;; since the link may point to a directory name that uses links.
- ;; We can't safely use expand-file-name here
- ;; since target might look like foo/../bar where foo
- ;; is itself a link. Instead, we handle . and .. above.
- (if (file-name-absolute-p target)
- (file-truename target)
- (file-truename (concat dir target)))
- ;; No, we are done!
- filename)))))))
+ (or counter (setq counter (list 100)))
+ (let (done
+ ;; For speed, remove the ange-ftp completion handler from the list.
+ ;; We know it's not needed here.
+ ;; For even more speed, do this only on the outermost call.
+ (file-name-handler-alist
+ (if prev-dirs file-name-handler-alist
+ (let ((tem (copy-sequence file-name-handler-alist)))
+ (delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
+ (or prev-dirs (setq prev-dirs (list nil)))
+ ;; If this file directly leads to a link, process that iteratively
+ ;; so that we don't use lots of stack.
+ (while (not done)
+ (setcar counter (1- (car counter)))
+ (if (< (car counter) 0)
+ (error "Apparent cycle of symbolic links for %s" filename))
+ (let ((handler (find-file-name-handler filename 'file-truename)))
+ ;; For file name that has a special handler, call handler.
+ ;; This is so that ange-ftp can save time by doing a no-op.
+ (if handler
+ (setq filename (funcall handler 'file-truename filename)
+ done t)
+ (let ((dir (or (file-name-directory filename) default-directory))
+ target dirfile)
+ ;; Get the truename of the directory.
+ (setq dirfile (directory-file-name dir))
+ ;; If these are equal, we have the (or a) root directory.
+ (or (string= dir dirfile)
+ ;; If this is the same dir we last got the truename for,
+ ;; save time--don't recalculate.
+ (if (assoc dir (car prev-dirs))
+ (setq dir (cdr (assoc dir (car prev-dirs))))
+ (let ((old dir)
+ (new (file-name-as-directory (file-truename dirfile counter prev-dirs))))
+ (setcar prev-dirs (cons (cons old new) (car prev-dirs)))
+ (setq dir new))))
+ (if (equal ".." (file-name-nondirectory filename))
+ (setq filename
+ (directory-file-name (file-name-directory (directory-file-name dir)))
+ done t)
+ (if (equal "." (file-name-nondirectory filename))
+ (setq filename (directory-file-name dir)
+ done t)
+ ;; Put it back on the file name.
+ (setq filename (concat dir (file-name-nondirectory filename)))
+ ;; Is the file name the name of a link?
+ (setq target (file-symlink-p filename))
+ (if target
+ ;; Yes => chase that link, then start all over
+ ;; since the link may point to a directory name that uses links.
+ ;; We can't safely use expand-file-name here
+ ;; since target might look like foo/../bar where foo
+ ;; is itself a link. Instead, we handle . and .. above.
+ (setq filename
+ (if (file-name-absolute-p target)
+ target
+ (concat dir target))
+ done nil)
+ ;; No, we are done!
+ (setq done t))))))))
+ filename))
(defun file-chase-links (filename)
"Chase links in FILENAME until a name that is not a link.
"Switch to buffer BUFFER in another frame."
(interactive "BSwitch to buffer in other frame: ")
(let ((pop-up-frames t))
- (pop-to-buffer buffer t)))
+ (pop-to-buffer buffer t)
+ (raise-frame (window-frame (selected-window)))))
(defun find-file (filename)
"Edit file FILENAME.
file-dir (file-name-directory file)))
(list (read-file-name
"Find alternate file: " file-dir nil nil file-name))))
- (and (buffer-modified-p)
+ (and (buffer-modified-p) (buffer-file-name)
;; (not buffer-read-only)
(not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
(buffer-name))))
;; If the home dir is just /, don't change it.
(not (and (= (match-end 0) 1)
(= (aref filename 0) ?/)))
- (not (and (eq system-type 'ms-dos)
+ (not (and (or (eq system-type 'ms-dos)
+ (eq system-type 'windows-nt))
(save-match-data
(string-match "^[a-zA-Z]:/$" filename)))))
(setq filename
(format
(if (buffer-modified-p buf)
"File %s changed on disk. Discard your edits? "
- "File %s changed on disk. Read the new version? ")
+ "File %s changed on disk. Reread from disk? ")
(file-name-nondirectory filename)))
(save-excursion
(set-buffer buf)
;;; (message "Symbolic link to file in buffer %s"
;;; (buffer-name linked-buf))))
(setq buf (create-file-buffer filename))
+ (set-buffer-major-mode buf)
(set-buffer buf)
(erase-buffer)
(condition-case ()
(insert-file-contents filename t)
(file-error
- (setq error t)
;; Run find-file-not-found-hooks until one returns non-nil.
- (let ((hooks find-file-not-found-hooks))
- (while (and hooks
- (not (and (funcall (car hooks))
- ;; If a hook succeeded, clear error.
- (progn (setq error nil)
- ;; Also exit the loop.
- t))))
- (setq hooks (cdr hooks))))))
+ (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
+ ;; If they fail too, set error.
+ (setq error t))))
;; Find the file's truename, and maybe use that as visited name.
(setq buffer-file-truename truename)
(setq buffer-file-number number)
(after-find-file error (not nowarn))))
buf)))
\f
-(defun after-find-file (&optional error warn noauto)
+(defvar after-find-file-from-revert-buffer nil)
+
+(defun after-find-file (&optional error warn noauto
+ after-find-file-from-revert-buffer)
"Called after finding a file and by the default revert function.
Sets buffer mode, parses local variables.
Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
error in reading the file. WARN non-nil means warn if there
exists an auto-save file more recent than the visited file.
NOAUTO means don't mess with auto-save mode.
+Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
+ means this call was from `revert-buffer'.
Finishes by calling the functions in `find-file-hooks'."
(setq buffer-read-only (not (file-writable-p buffer-file-name)))
(if noninteractive
(if (and auto-save-default (not noauto))
(auto-save-mode t)))
(normal-mode t)
- (mapcar 'funcall find-file-hooks))
+ (run-hooks 'find-file-hooks))
(defun normal-mode (&optional find-file)
"Choose the major mode for this buffer automatically.
'(("\\.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)
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
("\\.mss\\'" . scribe-mode)
+ ("\\.ada\\'" . ada-mode)
+ ("\\.icn\\'" . icon-mode)
("\\.pl\\'" . prolog-mode)
("\\.cc\\'" . c++-mode)
("\\.hh\\'" . c++-mode)
;; 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)
("\\.ml\\'" . lisp-mode)))
"\
Alist of filename patterns vs corresponding major mode functions.
-Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION).
-Visiting a file whose name matches REGEXP causes FUNCTION to be called.
-If the element has the form (REGEXP FUNCTION), then after calling
-FUNCTION, we delete the suffix that matched REGEXP and search the list
-again for another match.")
+Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
+\(NON-NIL stands for anything that is not nil; the value does not matter.)
+Visiting a file whose name matches REGEXP specifies FUNCTION as the
+mode function to use. FUNCTION will be called, unless it is nil.
+
+If the element has the form (REGEXP FUNCTION NON-NIL), then after
+calling FUNCTION (if it's not nil), we delete the suffix that matched
+REGEXP and search the list again for another match.")
(defconst interpreter-mode-alist
'(("perl" . perl-mode)
(and enable-local-variables
;; Don't look for -*- if this file name matches any
;; of the regexps in inhibit-first-line-modes-regexps.
- (let ((temp inhibit-first-line-modes-regexps))
+ (let ((temp inhibit-first-line-modes-regexps)
+ (name (file-name-sans-versions buffer-file-name)))
(while (and temp
(not (string-match (car temp)
- buffer-file-name)))
+ name)))
(setq temp (cdr temp)))
(not temp))
(search-forward "-*-" (save-excursion
;; Find all specifications for the `mode:' variable
;; and execute them left to right.
(while (let ((case-fold-search t))
- (search-forward "mode:" end t))
+ (or (and (looking-at "mode:")
+ (goto-char (match-end 0)))
+ (re-search-forward "[ \t;]mode:" end t)))
(skip-chars-forward " \t")
(setq beg (point))
(if (search-forward ";" end t)
;; If we didn't find a mode from a -*- line, try using the file name.
(if (and (not done) buffer-file-name)
(let ((name buffer-file-name)
- (case-fold-search (eq system-type 'vax-vms))
(keep-going t))
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
(let ((alist auto-mode-alist)
(mode nil))
;; Find first matching alist entry.
- (while (and (not mode) alist)
- (if (string-match (car (car alist)) name)
- (if (and (consp (cdr (car alist)))
- (nth 2 (car alist)))
- (progn
- (setq mode (car (cdr (car alist)))
- name (substring name 0 (match-beginning 0))
- keep-going t))
- (setq mode (cdr (car alist))
- keep-going nil)))
- (setq alist (cdr alist)))
+ (let ((case-fold-search (eq system-type 'vax-vms)))
+ (while (and (not mode) alist)
+ (if (string-match (car (car alist)) name)
+ (if (and (consp (cdr (car alist)))
+ (nth 2 (car alist)))
+ (progn
+ (setq mode (car (cdr (car alist)))
+ name (substring name 0 (match-beginning 0))
+ keep-going t))
+ (setq mode (cdr (car alist))
+ keep-going nil)))
+ (setq alist (cdr alist))))
(if mode
(funcall mode)
;; If we can't deduce a mode from the file name,
(hack-one-local-variable (car (car result)) (cdr (car result)))
(setq result (cdr result)))))))
+(defvar hack-local-variables-hook nil
+ "Normal hook run after processing a file's local variables specs.
+Major modes can use this to examine user-specified local variables
+in order to initialize other data structure based on them.")
+
(defun hack-local-variables ()
"Parse and put into effect this buffer's local variables spec."
(hack-local-variables-prop-line)
(or (if suffix (looking-at suffix) (eolp))
(error "Local variables entry is terminated incorrectly"))
;; Set the variable. "Variables" mode and eval are funny.
- (hack-one-local-variable var val))))))))
+ (hack-one-local-variable var val)))))))
+ (run-hooks 'hack-local-variables-hook))
(defconst ignored-local-variables
'(enable-local-eval)
"Variables to be ignored in a file's local variable spec.")
;; Get confirmation before setting these variables as locals in a file.
+(put 'debugger 'risky-local-variable t)
(put 'enable-local-eval 'risky-local-variable t)
+(put 'ignored-local-variables 'risky-local-variable t)
(put 'eval 'risky-local-variable t)
(put 'file-name-handler-alist 'risky-local-variable t)
(put 'minor-mode-map-alist 'risky-local-variable t)
(put 'buffer-file-name 'risky-local-variable t)
(put 'buffer-auto-save-file-name 'risky-local-variable t)
(put 'buffer-file-truename 'risky-local-variable t)
+(put 'exec-path 'risky-local-variable t)
+(put 'load-path 'risky-local-variable t)
+(put 'exec-directory 'risky-local-variable t)
+(put 'process-environment 'risky-local-variable t)
+;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode.
+(put 'outline-level 'risky-local-variable t)
+(put 'rmail-output-file-alist 'risky-local-variable t)
+
+;; This one is safe because the user gets to check it before it is used.
+(put 'compile-command 'safe-local-variable t)
(defun hack-one-local-variable-quotep (exp)
(and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
;; "Setting" eval means either eval it or do nothing.
;; Likewise for setting hook variables.
((or (get var 'risky-local-variable)
- (string-match "-hooks?$\\|-functions?$\\|-forms?$"
- (symbol-name var)))
+ (and
+ (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$"
+ (symbol-name var))
+ (not (get var 'safe-local-variable))))
;; Permit evaling a put of a harmless property
;; if the args do nothing tricky.
(if (or (and (eq var 'eval)
(memq (nth 1 (nth 2 val))
'(lisp-indent-hook)))
;; Permit eval if not root and user says ok.
- (and (not (string= (user-login-name) "root"))
+ (and (not (zerop (user-uid)))
(or (eq enable-local-eval t)
(and enable-local-eval
(save-window-excursion
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 filename
- (setq filename
- (if (string-equal filename "")
- nil
- (expand-file-name filename))))
- (or (equal filename buffer-file-name)
- (progn
- (and filename (lock-buffer filename))
- (unlock-buffer)))
- (setq buffer-file-name filename)
- (if filename ; make buffer name reflect filename.
- (let ((new-name (file-name-nondirectory buffer-file-name)))
- (if (string= new-name "")
- (error "Empty file name"))
- (if (eq system-type 'vax-vms)
- (setq new-name (downcase new-name)))
- (setq default-directory (file-name-directory buffer-file-name))
- (or (string= new-name (buffer-name))
- (rename-buffer new-name t))))
- (setq buffer-backed-up nil)
- (clear-visited-file-modtime)
- (if filename
- (progn
- (setq buffer-file-truename
- (abbreviate-file-name (file-truename buffer-file-name)))
- (if find-file-visit-truename
- (setq buffer-file-name buffer-file-truename))
- (setq buffer-file-number (nth 10 (file-attributes buffer-file-name))))
- (setq buffer-file-truename nil buffer-file-number nil))
+ (if (buffer-base-buffer)
+ (error "An indirect buffer cannot visit a file"))
+ (let (truename)
+ (if filename
+ (setq filename
+ (if (string-equal filename "")
+ nil
+ (expand-file-name filename))))
+ (if filename
+ (progn
+ (setq truename (file-truename filename))
+ (if find-file-visit-truename
+ ;; Do not use the abbreviated filename, because
+ ;; write-region will reset it to the expanded filename
+ (setq filename truename))))
+ (or (equal filename buffer-file-name)
+ (progn
+ (and filename (lock-buffer filename))
+ (unlock-buffer)))
+ (setq buffer-file-name filename)
+ (if filename ; make buffer name reflect filename.
+ (let ((new-name (file-name-nondirectory buffer-file-name)))
+ (if (string= new-name "")
+ (error "Empty file name"))
+ (if (eq system-type 'vax-vms)
+ (setq new-name (downcase new-name)))
+ (setq default-directory (file-name-directory buffer-file-name))
+ (or (string= new-name (buffer-name))
+ (rename-buffer new-name t))))
+ (setq buffer-backed-up nil)
+ (clear-visited-file-modtime)
+ (if truename
+ (setq buffer-file-truename (abbreviate-file-name truename)))
+ (setq buffer-file-number
+ (if filename
+ (nth 10 (file-attributes buffer-file-name))
+ nil)))
;; write-file-hooks is normally used for things like ftp-find-file
;; that visit things that are not local files as if they were files.
;; Changing to visit an ordinary local file instead should flush the hook.
;; ask the user to confirm now, before doing anything.
;; But don't actually delete til later.
(and targets
- (or (eq trim-versions-without-asking t) (eq trim-versions-without-asking nil))
- (or trim-versions-without-asking
+ (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.
(and backup-by-copying-when-mismatch
(let ((attr (file-attributes real-file-name)))
(or (nth 9 attr)
- (/= (nth 2 attr) (user-uid))))))
+ (not (file-ownership-preserved-p real-file-name))))))
(condition-case ()
(copy-file real-file-name backupname t t)
(file-error
(string-match "~\\'" name)
(length name))))))))
+(defun file-ownership-preserved-p (file)
+ "Returns t if deleting FILE and rewriting it would preserve the owner."
+ (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
+ (if handler
+ (funcall handler 'file-ownership-preserved-p file)
+ (= (nth 2 (file-attributes file)) (user-uid)))))
+
+(defun file-name-sans-extension (filename)
+ "Return FILENAME sans final \"extension\".
+The extension, in a file name, is the part that follows the last `.'."
+ (save-match-data
+ (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
+ directory)
+ (if (string-match "\\.[^.]*\\'" file)
+ (if (setq directory (file-name-directory filename))
+ (expand-file-name (substring file 0 (match-beginning 0))
+ directory)
+ (substring file 0 (match-beginning 0)))
+ filename))))
+
(defun make-backup-file-name (file)
"Create the non-numeric backup file name for FILE.
This is a separate function so you can redefine it for customization."
and `kept-new-versions', which tells how many newest versions to keep.
Defaults are 2 old versions and 2 new.
`dired-kept-versions' controls dired's clean-directory (.) command.
-If `trim-versions-without-asking' is nil, system will query user
+If `delete-old-versions' is nil, system will query user
before trimming versions. Otherwise it does it silently."
(interactive "p")
(let ((modp (buffer-modified-p))
(large (> (buffer-size) 50000))
- (make-backup-files (and make-backup-files (not (eq args 0)))))
+ (make-backup-files (or (and make-backup-files (not (eq args 0)))
+ (memq args '(16 64)))))
(and modp (memq args '(16 64)) (setq buffer-backed-up nil))
(if (and modp large) (message "Saving file %s..." (buffer-file-name)))
(basic-save-buffer)
(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)))
- (let ((hooks (append write-contents-hooks local-write-file-hooks
- write-file-hooks))
- (done nil))
- (while (and hooks
- (not (setq done (funcall (car hooks)))))
- (setq hooks (cdr hooks)))
- ;; If a hook returned t, file is already "written".
- (cond ((not done)
- (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
(error "Attempt to save to a file which you aren't allowed to write"))))))
(or buffer-backed-up
(setq setmodes (backup-buffer)))
- (if file-precious-flag
- ;; If file is precious, write temp name, then rename it.
- (let ((dir (file-name-directory buffer-file-name))
- (realname buffer-file-name)
- tempname temp nogood i succeed)
- (setq i 0)
- (setq nogood t)
- ;; Find the temporary name to write under.
- (while nogood
- (setq tempname (format "%s#tmp#%d" dir i))
- (setq nogood (file-exists-p tempname))
- (setq i (1+ i)))
- (unwind-protect
- (progn (clear-visited-file-modtime)
- (write-region (point-min) (point-max)
- tempname nil realname)
- (setq succeed t))
- ;; If writing the temp file fails,
- ;; delete the temp file.
- (or succeed (delete-file tempname)))
- ;; Since we have created an entirely new file
- ;; and renamed it, make sure it gets the
- ;; right permission bits set.
- (setq setmodes (file-modes buffer-file-name))
- ;; We succeeded in writing the temp file,
- ;; so rename it.
- (rename-file tempname buffer-file-name t))
- ;; If file not writable, see if we can make it writable
- ;; temporarily while we write it.
- ;; But no need to do so if we have just backed it up
- ;; (setmodes is set) because that says we're superseding.
- (cond ((and tempsetmodes (not setmodes))
- ;; Change the mode back, after writing.
- (setq setmodes (file-modes buffer-file-name))
- (set-file-modes buffer-file-name 511)))
- (write-region (point-min) (point-max)
- buffer-file-name nil t))
+ (let ((dir (file-name-directory buffer-file-name)))
+ (if (and file-precious-flag
+ (file-writable-p dir))
+ ;; If file is precious, write temp name, then rename it.
+ ;; This requires write access to the containing dir,
+ ;; which is why we don't try it if we don't have that access.
+ (let ((realname buffer-file-name)
+ tempname temp nogood i succeed
+ (old-modtime (visited-file-modtime)))
+ (setq i 0)
+ (setq nogood t)
+ ;; Find the temporary name to write under.
+ (while nogood
+ (setq tempname (format "%s#tmp#%d" dir i))
+ (setq nogood (file-exists-p tempname))
+ (setq i (1+ i)))
+ (unwind-protect
+ (progn (clear-visited-file-modtime)
+ (write-region (point-min) (point-max)
+ tempname nil realname)
+ (setq succeed t))
+ ;; If writing the temp file fails,
+ ;; delete the temp file.
+ (or succeed
+ (progn
+ (delete-file tempname)
+ (set-visited-file-modtime old-modtime))))
+ ;; Since we have created an entirely new file
+ ;; and renamed it, make sure it gets the
+ ;; right permission bits set.
+ (setq setmodes (file-modes buffer-file-name))
+ ;; We succeeded in writing the temp file,
+ ;; so rename it.
+ (rename-file tempname buffer-file-name t))
+ ;; If file not writable, see if we can make it writable
+ ;; temporarily while we write it.
+ ;; But no need to do so if we have just backed it up
+ ;; (setmodes is set) because that says we're superseding.
+ (cond ((and tempsetmodes (not setmodes))
+ ;; Change the mode back, after writing.
+ (setq setmodes (file-modes buffer-file-name))
+ (set-file-modes buffer-file-name 511)))
+ (write-region (point-min) (point-max)
+ buffer-file-name nil t)))
setmodes))
(defun save-some-buffers (&optional arg exiting)
(function
(lambda (buffer)
(and (buffer-modified-p buffer)
+ (not (buffer-base-buffer buffer))
(or
(buffer-file-name buffer)
(and exiting
\f
(put 'revert-buffer-function 'permanent-local t)
(defvar revert-buffer-function nil
- "Function to use to revert this buffer, or nil to do the default.")
+ "Function to use to revert this buffer, or nil to do the default.
+The function receives two arguments IGNORE-AUTO and NOCONFIRM,
+which are the arguments that `revert-buffer' received.")
(put 'revert-buffer-insert-file-contents-function 'permanent-local t)
(defvar revert-buffer-insert-file-contents-function nil
(insert-file-contents file-name (not auto-save-p)
nil nil t)))
(goto-char (min opoint (point-max)))
- (after-find-file nil nil t)
+ (after-find-file nil nil t t)
(run-hooks 'after-revert-hook)
t)))))
(interactive "P")
(setq buffer-auto-save-file-name
(and (if (null arg)
- (not buffer-auto-save-file-name)
+ (or (not buffer-auto-save-file-name)
+ ;; If autosave is off because buffer has shrunk,
+ ;; then toggling should turn it on.
+ (< buffer-saved-size 0))
(or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
(if (and buffer-file-name auto-save-visited-file-name
(not buffer-read-only))
(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.
+SWITCHES may be a string of options, or a list of strings.
Optional third arg WILDCARD means treat FILE as shell wildcard.
Optional fourth arg FULL-DIRECTORY-P means file is a directory and
switches do not contain `d', so that a full listing is expected.
;; We also currently don't quote the quoting characters
;; in case people want to use them explicitly to quote
;; wildcard characters.
- (while (string-match "[ \t\n;<>&|{}()#$]" pattern beg)
+ (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
(setq pattern
(concat (substring pattern 0 (match-beginning 0))
"\\"
beg (1+ (match-end 0))))
(call-process shell-file-name nil t nil
"-c" (concat insert-directory-program
- " -d " switches " "
+ " -d "
+ (if (stringp switches)
+ switches
+ (mapconcat 'identity switches " "))
+ " "
pattern)))
;; SunOS 4.1.3, SVr4 and others need the "." to list the
;; directory if FILE is a symbolic link.
- (call-process insert-directory-program nil t nil switches
- (if full-directory-p
- (concat (file-name-as-directory file) ".")
- file)))))))
+ (apply 'call-process
+ insert-directory-program nil t nil
+ (let (list)
+ (if (listp switches)
+ (setq list switches)
+ (if (not (equal switches ""))
+ (progn
+ ;; Split the switches at any spaces
+ ;; so we can pass separate options as separate args.
+ (while (string-match " " switches)
+ (setq list (cons (substring switches 0 (match-beginning 0))
+ list)
+ switches (substring switches (match-end 0))))
+ (setq list (cons switches list)))))
+ (append list
+ (list
+ (if full-directory-p
+ (concat (file-name-as-directory file) ".")
+ file))))))))))
(defvar kill-emacs-query-functions nil
"Functions to call with no arguments to query about killing Emacs.
(or (not active)
(yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
;; Query the user for other things, perhaps.
- (let ((functions kill-emacs-query-functions)
- (yes t))
- (while (and functions yes)
- (setq yes (and yes (funcall (car functions))))
- (setq functions (cdr functions)))
- yes)
+ (run-hook-with-args-until-failure 'kill-emacs-query-functions)
(kill-emacs)))
\f
(define-key ctl-x-map "\C-f" 'find-file)