If it matches, `replace-match' is used to replace the
matching part with REPLACEMENT.
If the optional element UNIQUIFY is non-nil, the auto-save file name is
-constructed by taking the directory part of the replaced file-name,
+constructed by taking the directory part of the replaced file-name,
concatenated with the buffer file name with all directory separators
changed to `!' to prevent clashes. This will not work
correctly if your filesystem truncates the resulting name.
;;;It is not useful to make this a local variable.
;;;(put 'find-file-not-found-hooks 'permanent-local t)
-(defvar find-file-not-found-hooks nil
+(defvar find-file-not-found-functions nil
"List of functions to be called for `find-file' on nonexistent file.
These functions are called as soon as the error is detected.
Variable `buffer-file-name' is already set up.
The functions are called in the order given until one of them returns non-nil.")
+(defvaralias 'find-file-not-found-hooks 'find-file-not-found-functions)
+(make-obsolete-variable
+ 'find-file-not-found-hooks 'find-file-not-found-functions "21.4")
;;;It is not useful to make this a local variable.
;;;(put 'find-file-hooks 'permanent-local t)
-(defvar find-file-hooks nil
+(defvar find-file-hook nil
"List of functions to be called after a buffer is loaded from a file.
The buffer's local variables (if any) will have been processed before the
functions are called.")
+(defvaralias 'find-file-hooks 'find-file-hook)
+(make-obsolete-variable 'find-file-hooks 'find-file-hook "21.4")
-(defvar write-file-hooks nil
+(defvar write-file-functions nil
"List of functions to be called before writing out a buffer to a file.
If one of them returns non-nil, the file is considered already written
and the rest are not called.
These hooks are considered to pertain to the visited file.
-So any buffer-local binding of `write-file-hooks' is
-discarded if you change the visited file name with \\[set-visited-file-name].
-
-Don't make this variable buffer-local; instead, use `local-write-file-hooks'.
-See also `write-contents-hooks'.")
-;;; However, in case someone does make it local...
-(put 'write-file-hooks 'permanent-local t)
-
-(defvar local-write-file-hooks nil
- "Just like `write-file-hooks', except intended for per-buffer use.
-The functions in this list are called before the ones in
-`write-file-hooks'.
-
-This variable is meant to be used for hooks that have to do with a
-particular visited file. Therefore, it is a permanent local, so that
-changing the major mode does not clear it. However, calling
-`set-visited-file-name' does clear it.")
+So any buffer-local binding of this variable is discarded if you change
+the visited file name with \\[set-visited-file-name], but not when you
+change the major mode.
+
+See also `write-contents-functions'.")
+(put 'write-file-functions 'permanent-local t)
+(defvaralias 'write-file-hooks 'write-file-functions)
+(make-obsolete-variable 'write-file-hooks 'write-file-functions "21.4")
+
+(defvar local-write-file-hooks nil)
(make-variable-buffer-local 'local-write-file-hooks)
(put 'local-write-file-hooks 'permanent-local t)
+(make-obsolete-variable 'local-write-file-hooks 'write-file-functions "21.4")
-(defvar write-contents-hooks nil
+(defvar write-contents-functions nil
"List of functions to be called before writing out a buffer to a file.
If one of them returns non-nil, the file is considered already written
and the rest are not called.
`set-visited-file-name' does not clear this variable; but changing the
major mode does clear it.
-This variable automatically becomes buffer-local whenever it is set.
-If you use `add-hook' to add elements to the list, use nil for the
-LOCAL argument.
-
-See also `write-file-hooks'.")
-(make-variable-buffer-local 'write-contents-hooks)
+See also `write-file-functions'.")
+(make-variable-buffer-local 'write-contents-functions)
+(defvaralias 'write-contents-hooks 'write-contents-functions)
+(make-obsolete-variable 'write-contents-hooks 'write-contents-functions "21.4")
(defcustom enable-local-variables t
"*Control use of local variables in files you visit.
(defvar view-read-only nil
"*Non-nil means buffers visiting files read-only, do it in view mode.")
+(put 'ange-ftp-completion-hook-function 'safe-magic t)
(defun ange-ftp-completion-hook-function (op &rest args)
"Provides support for ange-ftp host name completion.
Runs the usual ange-ftp hook, but only for completion operations."
(unless dir
(setq dir default-directory))
(unless default-dirname
- (setq default-dirname
+ (setq default-dirname
(if initial (concat dir initial) default-directory)))
(read-file-name prompt dir default-dirname mustmatch initial
'file-directory-p))
(when (string-match suffix file)
(setq file (substring file 0 (match-beginning 0)))
(push (if string-dir (concat string-dir file) file) names)))))
- (if action
- (all-completions string (mapcar 'list names))
- (try-completion string (mapcar 'list names))))))
+ (cond
+ ((eq action t) (all-completions string names))
+ ((null action) (try-completion string names))
+ (t (test-completion string names))))))
(defun load-library (library)
"Load the library named LIBRARY.
(cons load-path load-suffixes))))
(load library))
+(defun file-remote-p (file)
+ "Test whether FILE specifies a location on a remote system."
+ (let ((handler (find-file-name-handler file 'file-local-copy)))
+ (if handler
+ (get handler 'file-remote-p))))
+
(defun file-local-copy (file)
"Copy the file FILE into a temporary file on this machine.
Returns the name of the local copy, or nil, if FILE is directly
(pop-to-buffer buffer t norecord)
(raise-frame (window-frame (selected-window)))))
-(defun find-file-read-args (prompt)
+(defvar find-file-default nil
+ "Used within `find-file-read-args'.")
+
+(defun find-file-read-args (prompt mustmatch)
(list (let ((find-file-default
(and buffer-file-name
(abbreviate-file-name buffer-file-name)))
(minibuffer-setup-hook
minibuffer-setup-hook))
(add-hook 'minibuffer-setup-hook munge-default-fun)
- (read-file-name prompt nil default-directory))
+ (read-file-name prompt nil default-directory mustmatch))
current-prefix-arg))
(defun find-file (filename &optional wildcards)
expand wildcards (if any) and visit multiple files. Wildcard expansion
can be suppressed by setting `find-file-wildcards'."
(interactive
- (find-file-read-args "Find file: "))
+ (find-file-read-args "Find file: " nil))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(mapcar 'switch-to-buffer (nreverse value))
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
- (interactive (find-file-read-args "FFind file in other window: "))
+ (interactive (find-file-read-args "Find file in other window: " nil))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
- (interactive (find-file-read-args "FFind file in other frame: "))
+ (interactive (find-file-read-args "Find file in other frame: " nil))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
"Edit file FILENAME but don't allow changes.
Like \\[find-file] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive (find-file-read-args "fFind file read-only: "))
+ (interactive (find-file-read-args "Find file read-only: " t))
(find-file filename wildcards)
(toggle-read-only 1)
(current-buffer))
"Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive (find-file-read-args "fFind file read-only other window: "))
+ (interactive (find-file-read-args "Find file read-only other window: " t))
(find-file-other-window filename wildcards)
(toggle-read-only 1)
(current-buffer))
"Edit file FILENAME in another frame but don't allow changes.
Like \\[find-file-other-frame] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive (find-file-read-args "fFind file read-only other frame: "))
+ (interactive (find-file-read-args "Find file read-only other frame: " t))
(find-file-other-frame filename wildcards)
(toggle-read-only 1)
(current-buffer))
file-dir (file-name-directory file)))
(list (read-file-name
"Find alternate file: " file-dir nil nil file-name))))
- (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))))
- (error "Aborted"))
+ (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
+ (error "Aborted"))
+ (when (and (buffer-modified-p) (buffer-file-name))
+ (if (yes-or-no-p (format "Buffer %s is modified; save it first? "
+ (buffer-name)))
+ (save-buffer)
+ (unless (yes-or-no-p "Kill and replace the buffer without saving it? ")
+ (error "Aborted"))))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
(onum buffer-file-number)
(setq buffer-file-number nil)
(setq buffer-file-truename nil)
(find-file filename))
- (cond ((eq obuf (current-buffer))
- (setq buffer-file-name ofile)
- (setq buffer-file-number onum)
- (setq buffer-file-truename otrue)
- (lock-buffer)
- (rename-buffer oname))))
- (or (eq (current-buffer) obuf)
- (kill-buffer obuf))))
+ (when (eq obuf (current-buffer))
+ ;; This executes if find-file gets an error
+ ;; and does not really find anything.
+ ;; We put things back as they were.
+ ;; If find-file actually finds something, we kill obuf below.
+ (setq buffer-file-name ofile)
+ (setq buffer-file-number onum)
+ (setq buffer-file-truename otrue)
+ (lock-buffer)
+ (rename-buffer oname)))
+ (unless (eq (current-buffer) obuf)
+ (with-current-buffer obuf
+ ;; We already asked; don't ask again.
+ (let ((kill-buffer-query-functions))
+ (kill-buffer obuf))))))
\f
(defun create-file-buffer (filename)
"Create a suitably named buffer for visiting FILENAME, and return it.
;; Verify this buffer's file number
;; still belongs to its file.
(file-exists-p buffer-file-name)
- (equal (file-attributes buffer-file-name)
+ (equal (file-attributes buffer-file-truename)
attributes))
(setq found (car list))))
(setq list (cdr list))))
(unless (or (eq read-only buffer-file-read-only)
(eq read-only buffer-read-only))
(when (or nowarn
- (let ((question
+ (let ((question
(format "File %s is %s on disk. Change buffer mode? "
buffer-file-name
(if read-only "read-only" "writable"))))
(signal 'file-error (list "File is not readable"
filename)))
;; Run find-file-not-found-hooks until one returns non-nil.
- (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
+ (or (run-hook-with-args-until-success 'find-file-not-found-functions)
;; If they fail too, set error.
(setq error t)))))
;; Record the file's truename, and maybe use that as visited name.
"Like `insert-file-contents', but only reads in the file literally.
A buffer may be modified in several ways after reading into the buffer,
to Emacs features such as format decoding, character code
-conversion, `find-file-hooks', automatic uncompression, etc.
+conversion, `find-file-hook', automatic uncompression, etc.
This function ensures that none of these modifications will take place."
(let ((format-alist nil)
Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
means this call was from `revert-buffer'.
Fifth arg NOMODES non-nil means don't alter the file's modes.
-Finishes by calling the functions in `find-file-hooks'
+Finishes by calling the functions in `find-file-hook'
unless NOMODES is non-nil."
(setq buffer-read-only (not (file-writable-p buffer-file-name)))
(if noninteractive
(file-newer-than-file-p (or buffer-auto-save-file-name
(make-auto-save-file-name))
buffer-file-name))
- (format "%s has auto save data; consider M-x recover-file"
+ (format "%s has auto save data; consider M-x recover-this-file"
(file-name-nondirectory buffer-file-name))
(setq not-serious t)
(if error "(New file)" nil)))
;; before altering a backup file.
(when (backup-file-name-p buffer-file-name)
(setq buffer-read-only t))
+ ;; When a file is marked read-only,
+ ;; make the buffer read-only even if root is looking at it.
+ (when (and (file-modes (buffer-file-name))
+ (zerop (logand (file-modes (buffer-file-name)) #o222)))
+ (setq buffer-read-only t))
(unless nomodes
(when (and view-read-only view-mode)
(view-mode-disable))
view-read-only
(not (eq (get major-mode 'mode-class) 'special)))
(view-mode-enter))
- (run-hooks 'find-file-hooks)))
+ (run-hooks 'find-file-hook)))
(defun normal-mode (&optional find-file)
"Choose the major mode for this buffer automatically.
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
("\\.ad[abs]\\'" . ada-mode)
+ ("\\.ad[bs].dg\\'" . ada-mode)
("\\.\\([pP]\\([Llm]\\|erl\\)\\|al\\)\\'" . perl-mode)
("\\.s?html?\\'" . html-mode)
("\\.cc\\'" . c++-mode)
("\\.m\\'" . objc-mode)
("\\.java\\'" . java-mode)
("\\.mk\\'" . makefile-mode)
- ("\\(M\\|m\\|GNUm\\)akefile\\(\\.in\\)?\\'" . makefile-mode)
+ ("\\(M\\|m\\|GNUm\\)akefile\\'" . makefile-mode)
("\\.am\\'" . makefile-mode) ;For Automake.
;; Less common extensions come here
;; so more common ones above are found faster.
("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
("\\.scm\\.[0-9]*\\'" . scheme-mode)
("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
+ ("\\.bash\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(bash_logout\\|shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
("\\.awk\\'" . awk-mode)
("\\.prolog\\'" . prolog-mode)
("\\.tar\\'" . tar-mode)
- ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\)\\'" . archive-mode)
- ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|JAR\\)\\'" . archive-mode)
+ ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|ear\\|jar\\|war\\)\\'" . archive-mode)
+ ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|EAR\\|JAR\\|WAR\\)\\'" . archive-mode)
+ ("\\.sx[dmicw]\\'" . archive-mode) ; OpenOffice.org
;; Mailer puts message to be edited in
;; /tmp/Re.... or Message
("\\`/tmp/Re" . text-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
("\\.idl\\'" . idl-mode)
- ;; .emacs following a directory delimiter
- ;; in Unix, MSDOG or VMS syntax.
- ("[]>:/\\]\\..*emacs\\'" . emacs-lisp-mode)
+ ;; .emacs or .gnus or .viper following a directory delimiter in
+ ;; Unix, MSDOG or VMS syntax.
+ ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
("\\`\\..*emacs\\'" . emacs-lisp-mode)
;; _emacs following a directory delimiter
;; in MsDos syntax
;; for the sake of ChangeLog.1, etc.
;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
("\\.[1-9]\\'" . nroff-mode)
- ("\\.g\\'" . antlr-mode)))
+ ("\\.g\\'" . antlr-mode)
+ ("\\.ses\\'" . ses-mode)
+ ("\\.in\\'" nil t)))
"Alist of filename patterns vs corresponding major mode functions.
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.)
(put 'ignored-local-variables 'risky-local-variable t)
(put 'eval 'risky-local-variable t)
(put 'file-name-handler-alist 'risky-local-variable t)
+(put 'inhibit-quit 'risky-local-variable t)
(put 'minor-mode-alist 'risky-local-variable t)
(put 'minor-mode-map-alist 'risky-local-variable t)
(put 'minor-mode-overriding-map-alist 'risky-local-variable t)
(put 'mode-line-position 'risky-local-variable t)
(put 'display-time-string '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)
+;; This case is safe because the user gets to check it before it is used.
+(put 'compile-command 'safe-local-variable 'stringp)
+
+(defun risky-local-variable-p (sym val)
+ "Non-nil if SYM could be dangerous as a file-local variable with value VAL."
+ (let ((safep (get sym 'safe-local-variable)))
+ (or (memq sym ignored-local-variables)
+ (get sym 'risky-local-variable)
+ (and (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
+ (symbol-name sym))
+ (not safep))
+ ;; If the safe-local-variable property isn't t or nil,
+ ;; then it must return non-nil on the proposed value to be safe.
+ (and (not (memq safep '(t nil)))
+ (not (funcall safep val))))))
+
+(defcustom safe-local-eval-forms nil
+ "*Expressions that are considered \"safe\" in an `eval:' local variable.
+Add expressions to this list if you want Emacs to evaluate them, when
+they appear in an `eval' local variable specification, without first
+asking you for confirmation."
+ :group 'find-file
+ :version "21.4"
+ :type '(repeat sexp))
+
+(put 'c-set-style 'safe-local-eval-function t)
(defun hack-one-local-variable-quotep (exp)
(and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
+(defun hack-one-local-variable-constantp (exp)
+ (or (and (not (symbolp exp)) (not (consp exp)))
+ (memq exp '(t nil))
+ (keywordp exp)
+ (hack-one-local-variable-quotep exp)))
+
+(defun hack-one-local-variable-eval-safep (exp)
+ "Return t if it is safe to eval EXP when it is found in a file."
+ (or (not (consp exp))
+ ;; Detect certain `put' expressions.
+ (and (eq (car exp) 'put)
+ (hack-one-local-variable-quotep (nth 1 exp))
+ (hack-one-local-variable-quotep (nth 2 exp))
+ (memq (nth 1 (nth 2 exp))
+ '(lisp-indent-hook))
+ ;; Only allow safe values of lisp-indent-hook;
+ ;; not functions.
+ (or (numberp (nth 3 exp))
+ (equal (nth 3 exp) ''defun)))
+ ;; Allow expressions that the user requested.
+ (member exp safe-local-eval-forms)
+ ;; Certain functions can be allowed with safe arguments
+ ;; or can specify verification functions to try.
+ (and (symbolp (car exp))
+ (let ((prop (get (car exp) 'safe-local-eval-function)))
+ (cond ((eq prop t)
+ (let ((ok t))
+ (dolist (arg (cdr exp))
+ (unless (hack-one-local-variable-constantp arg)
+ (setq ok nil)))
+ ok))
+ ((functionp prop)
+ (funcall prop exp))
+ ((listp prop)
+ (let ((ok nil))
+ (dolist (function prop)
+ (if (funcall function exp)
+ (setq ok t)))
+ ok)))))))
+
(defun hack-one-local-variable (var val)
"\"Set\" one variable in a local variables spec.
A few patterns are specified so that any name which matches one
((eq var 'coding)
;; We have already handled coding: tag in set-auto-coding.
nil)
- ((memq var ignored-local-variables)
- nil)
;; "Setting" eval means either eval it or do nothing.
;; Likewise for setting hook variables.
- ((or (get var 'risky-local-variable)
- (and
- (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
- (symbol-name var))
- (not (get var 'safe-local-variable))))
+ ((risky-local-variable-p var val)
;; Permit evalling a put of a harmless property.
;; if the args do nothing tricky.
(if (or (and (eq var 'eval)
- (consp val)
- (eq (car val) 'put)
- (hack-one-local-variable-quotep (nth 1 val))
- (hack-one-local-variable-quotep (nth 2 val))
- ;; Only allow safe values of lisp-indent-hook;
- ;; not functions.
- (or (numberp (nth 3 val))
- (equal (nth 3 val) ''defun))
- (memq (nth 1 (nth 2 val))
- '(lisp-indent-hook)))
+ (hack-one-local-variable-eval-safep val))
;; Permit eval if not root and user says ok.
(and (not (zerop (user-uid)))
(or (eq enable-local-eval t)
(save-excursion (eval val))
(make-local-variable var)
(set var val))
- (message "Ignoring `eval:' in the local variables list")))
+ (message "Ignoring risky spec in the local variables list")))
;; Ordinary variable, really set it.
(t (make-local-variable var)
;; Make sure the string has no text properties.
(if filename
(nthcdr 10 (file-attributes buffer-file-name))
nil)))
- ;; write-file-hooks is normally used for things like ftp-find-file
+ ;; write-file-functions 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.
- (kill-local-variable 'write-file-hooks)
+ (kill-local-variable 'write-file-functions)
(kill-local-variable 'local-write-file-hooks)
(kill-local-variable 'revert-buffer-function)
(kill-local-variable 'backup-inhibited)
(defun backup-buffer ()
"Make a backup of the disk file visited by the current buffer, if appropriate.
This is normally done before saving the buffer the first time.
-If the value is non-nil, it is the result of `file-modes' on the original
-file; this means that the caller, after saving the buffer, should change
-the modes of the new file to agree with the old modes.
A backup may be done by renaming or by copying; see documentation of
variable `make-backup-files'. If it's done by renaming, then the file is
-no longer accessible under its old name."
+no longer accessible under its old name.
+
+The value is non-nil after a backup was made by renaming.
+It has the form (MODES . BACKUPNAME).
+MODES is the result of `file-modes' on the original
+file; this means that the caller, after saving the buffer, should change
+the modes of the new file to agree with the old modes.
+BACKUPNAME is the backup file name, which is the old file renamed."
(if (and make-backup-files (not backup-inhibited)
(not buffer-backed-up)
(file-exists-p buffer-file-name)
(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))))))
+ real-file-name)))))
+ (modes (file-modes buffer-file-name)))
;; Actually write the back up file.
(condition-case ()
(if (or file-precious-flag
; (file-symlink-p buffer-file-name)
backup-by-copying
+ ;; Don't rename a suid or sgid file.
+ (< 0 (logand modes #o6000))
(and backup-by-copying-when-linked
(> (file-nlinks real-file-name) 1))
(and (or backup-by-copying-when-mismatch
(<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
(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)))
+ (backup-buffer-copy real-file-name backupname modes)
;; rename-file should delete old backup.
(rename-file real-file-name backupname t)
- (setq setmodes (file-modes backupname)))
+ (setq setmodes (cons modes backupname)))
(file-error
;; If trouble writing the backup, write it in ~.
(setq backupname (expand-file-name
(message "Cannot write backup file; backing up in %s"
(file-name-nondirectory backupname))
(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)))))
+ (backup-buffer-copy real-file-name backupname modes)))
(setq buffer-backed-up t)
;; Now delete the old versions, if desired.
(if delete-old-versions
setmodes)
(file-error nil))))))
+(defun backup-buffer-copy (from-name to-name modes)
+ (condition-case ()
+ (copy-file from-name to-name t t)
+ (file-error
+ ;; If copying fails because file TO-NAME
+ ;; is not writable, delete that file and try again.
+ (if (and (file-exists-p to-name)
+ (not (file-writable-p to-name)))
+ (delete-file to-name))
+ (copy-file from-name to-name t t)))
+ (set-file-modes to-name (logand modes #o1777)))
+
(defun file-name-sans-versions (name &optional keep-backup-version)
"Return file NAME sans backup versions or strings.
This is a separate procedure so your site-init or startup file can
(if (and (string-match "\\.[^.]*\\'" file)
(not (eq 0 (match-beginning 0))))
(if (setq directory (file-name-directory filename))
- (expand-file-name (substring file 0 (match-beginning 0))
- directory)
+ ;; Don't use expand-file-name here; if DIRECTORY is relative,
+ ;; we don't want to expand it.
+ (concat directory (substring file 0 (match-beginning 0)))
(substring file 0 (match-beginning 0)))
filename))))
(defun make-backup-file-name-1 (file)
"Subroutine of `make-backup-file-name' and `find-backup-file-name'."
(let ((alist backup-directory-alist)
- elt backup-directory dir-sep-string)
+ elt backup-directory failed)
(while alist
(setq elt (pop alist))
(if (string-match (car elt) file)
(setq backup-directory (cdr elt)
alist nil)))
- (if (null backup-directory)
- file
- (unless (file-exists-p backup-directory)
+ (if (and backup-directory (not (file-exists-p backup-directory)))
(condition-case nil
(make-directory backup-directory 'parents)
- (file-error file)))
+ (file-error (setq backup-directory nil))))
+ (if (null backup-directory)
+ file
(if (file-name-absolute-p backup-directory)
(progn
(when (memq system-type '(windows-nt ms-dos))
- ;; Normalize DOSish file names: convert all slashes to
- ;; directory-sep-char, downcase the drive letter, if any,
- ;; and replace the leading "x:" with "/drive_x".
+ ;; Normalize DOSish file names: downcase the drive
+ ;; letter, if any, and replace the leading "x:" with
+ ;; "/drive_x".
(or (file-name-absolute-p file)
(setq file (expand-file-name file))) ; make defaults explicit
;; Replace any invalid file-name characters (for the
;; case of backing up remote files).
(setq file (expand-file-name (convert-standard-filename file)))
- (setq dir-sep-string (char-to-string directory-sep-char))
(if (eq (aref file 1) ?:)
- (setq file (concat dir-sep-string
+ (setq file (concat "/"
"drive_"
(char-to-string (downcase (aref file 0)))
- (if (eq (aref file 2) directory-sep-char)
+ (if (eq (aref file 2) ?/)
""
- dir-sep-string)
+ "/")
(substring file 2)))))
;; Make the name unique by substituting directory
;; separators. It may not really be worth bothering about
;; doubling `!'s in the original name...
(expand-file-name
(subst-char-in-string
- directory-sep-char ?!
+ ?/ ?!
(replace-regexp-in-string "!" "!!" file))
backup-directory))
(expand-file-name (file-name-nondirectory file)
(defun basic-save-buffer ()
"Save the current buffer in its visited file, if it has been modified.
-The hooks `write-contents-hooks', `local-write-file-hooks' and
-`write-file-hooks' get a chance to do the job of saving; if they do not,
-then the buffer is saved in the visited file file in the usual way.
+The hooks `write-contents-functions' and `write-file-functions' get a chance
+to do the job of saving; if they do not, then the buffer is saved in
+the visited file file in the usual way.
After saving the buffer, this function runs `after-save-hook'."
(interactive)
(save-current-buffer
(save-restriction
(widen)
(save-excursion
- (and (> (point-max) 1)
+ (and (> (point-max) (point-min))
(not find-file-literally)
(/= (char-after (1- (point-max))) ?\n)
(not (and (eq selective-display t)
(insert ?\n))))
;; Support VC version backups.
(vc-before-save)
- (or (run-hook-with-args-until-success 'write-contents-hooks)
+ (or (run-hook-with-args-until-success 'write-contents-functions)
(run-hook-with-args-until-success 'local-write-file-hooks)
- (run-hook-with-args-until-success 'write-file-hooks)
+ (run-hook-with-args-until-success 'write-file-functions)
;; If a hook returned t, file is already "written".
;; Otherwise, write it the usual way now.
(setq setmodes (basic-save-buffer-1)))
(nthcdr 10 (file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
- (set-file-modes buffer-file-name setmodes)
+ (set-file-modes buffer-file-name (car setmodes))
(error nil))))
;; If the auto-save file was recent before this command,
;; delete it now.
;; This does the "real job" of writing a buffer into its visited file
;; and making a backup file. This is what is normally done
-;; but inhibited if one of write-file-hooks returns non-nil.
-;; It returns a value to store in setmodes.
+;; but inhibited if one of write-file-functions returns non-nil.
+;; 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))
;; 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))
+ (setq setmodes (or setmodes (cons (file-modes buffer-file-name)
+ buffer-file-name)))
;; We succeeded in writing the temp file,
;; so rename it.
(rename-file tempname buffer-file-name t))
;; (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 (logior setmodes 128))))
- (write-region (point-min) (point-max)
- buffer-file-name nil t buffer-file-truename)))
+ (setq setmodes (cons (file-modes buffer-file-name) buffer-file-name))
+ (set-file-modes buffer-file-name (logior (car setmodes) 128))))
+ (let (success)
+ (unwind-protect
+ (progn
+ (write-region (point-min) (point-max)
+ buffer-file-name nil t buffer-file-truename)
+ (setq success t))
+ ;; If we get an error writing the new file, and we made
+ ;; the backup by renaming, undo the backing-up.
+ (and setmodes (not success)
+ (rename-file (cdr setmodes) buffer-file-name))))))
setmodes))
+(defun diff-buffer-with-file (&optional buffer)
+ "View the differences between BUFFER and its associated file.
+This requires the external program `diff' to be in your `exec-path'."
+ (interactive "bBuffer: ")
+ (with-current-buffer (get-buffer (or buffer (current-buffer)))
+ (if (and buffer-file-name
+ (file-exists-p buffer-file-name))
+ (let ((tempfile (make-temp-file "buffer-content-")))
+ (unwind-protect
+ (save-restriction
+ (widen)
+ (write-region (point-min) (point-max) tempfile nil 'nomessage)
+ (diff buffer-file-name tempfile nil t)
+ (sit-for 0))
+ (when (file-exists-p tempfile)
+ (delete-file tempfile))))
+ (message "Buffer %s has no associated file on disc" (buffer-name))
+ ;; Display that message for 1 second so that user can read it
+ ;; in the minibuffer.
+ (sit-for 1)))
+ ;; return always nil, so that save-buffers-kill-emacs will not move
+ ;; over to the next unsaved buffer when calling `d'.
+ nil)
+
+(defvar save-some-buffers-action-alist
+ '((?\C-r
+ (lambda (buf)
+ (view-buffer buf
+ (lambda (ignore)
+ (exit-recursive-edit)))
+ (recursive-edit)
+ ;; Return nil to ask about BUF again.
+ nil)
+ "display the current buffer")
+ (?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'.
+
Optional argument (the prefix) non-nil means save all with no questions.
Optional second argument PRED determines which buffers are considered:
If PRED is nil, all the file-visiting buffers are considered.
If PRED is t, then certain non-file buffers will also be considered.
If PRED is a zero-argument function, it indicates for each buffer whether
-to consider it or not when called with that buffer current."
+to consider it or not when called with that buffer current.
+
+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)
(save-buffer)))
(buffer-list)
'("buffer" "buffers" "save")
- (list (list ?\C-r (lambda (buf)
- (view-buffer buf
- (function
- (lambda (ignore)
- (exit-recursive-edit))))
- (recursive-edit)
- ;; Return nil to ask about BUF again.
- nil)
- "display the current buffer"))))
+ save-some-buffers-action-alist))
(abbrevs-done
(and save-abbrevs abbrevs-changed
(progn
With arg, set read-only iff arg is positive.
If visiting file read-only and `view-read-only' is non-nil, enter view mode."
(interactive "P")
- (cond
- ((and arg (if (> (prefix-numeric-value arg) 0) buffer-read-only
- (not buffer-read-only))) ; If buffer-read-only is set correctly,
- nil) ; do nothing.
- ;; Toggle.
- ((and buffer-read-only view-mode)
- (View-exit-and-edit)
- (make-local-variable 'view-read-only)
- (setq view-read-only t)) ; Must leave view mode.
- ((and (not buffer-read-only) view-read-only
- (not (eq (get major-mode 'mode-class) 'special)))
- (view-mode-enter))
- (t (setq buffer-read-only (not buffer-read-only))
- (force-mode-line-update))))
+ (if (and arg
+ (if (> (prefix-numeric-value arg) 0) buffer-read-only
+ (not buffer-read-only))) ; If buffer-read-only is set correctly,
+ nil ; do nothing.
+ ;; Toggle.
+ (cond
+ ((and buffer-read-only view-mode)
+ (View-exit-and-edit)
+ (make-local-variable 'view-read-only)
+ (setq view-read-only t)) ; Must leave view mode.
+ ((and (not buffer-read-only) view-read-only
+ (not (eq (get major-mode 'mode-class) 'special)))
+ (view-mode-enter))
+ (t (setq buffer-read-only (not buffer-read-only))
+ (force-mode-line-update)))
+ (if (vc-backend buffer-file-name)
+ (message (substitute-command-keys
+ (concat "File is under version-control; "
+ "use \\[vc-next-action] to check in/out"))))))
(defun insert-file (filename)
"Insert contents of file FILENAME into buffer after point.
(list (read-file-name "Make directory: " default-directory default-directory
nil nil)
t))
+ ;; If default-directory is a remote directory,
+ ;; make sure we find its make-directory handler.
+ (setq dir (expand-file-name dir))
(let ((handler (find-file-name-handler dir 'make-directory)))
(if handler
(funcall handler 'make-directory dir parents)
;; Auto-saved file shoule be read without
;; any code conversion.
(if auto-save-p 'emacs-mule-unix
- coding-system-for-read)))
+ (or coding-system-for-read
+ buffer-file-coding-system))))
+ ;; This force
+ ;; after-insert-file-set-buffer-file-coding-system
+ ;; (called from insert-file-contents) to set
+ ;; buffer-file-coding-system to a proper value.
+ (kill-local-variable 'buffer-file-coding-system)
+
;; Note that this preserves point in an intelligent way.
- (insert-file-contents file-name (not auto-save-p)
- nil nil t))))
+ (if preserve-modes
+ (let ((buffer-file-format buffer-file-format))
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t))
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t)))))
;; Recompute the truename in case changes in symlinks
;; have changed the truename.
(setq buffer-file-truename
(run-hooks 'revert-buffer-internal-hook))
t)))))
+(defun recover-this-file ()
+ "Recover the visited file--get contents from its last auto-save file."
+ (interactive)
+ (recover-file buffer-file-name))
+
(defun recover-file (file)
"Visit file FILE, but get contents from its last auto-save file."
;; Actually putting the file name in the minibuffer should be used
(setq filename (concat
(file-name-directory result)
(subst-char-in-string
- directory-sep-char ?!
+ ?/ ?!
(replace-regexp-in-string "!" "!!"
filename))))
(setq filename result)))
(let ((buffer-name (buffer-name))
(limit 0)
- filename)
+ file-name)
;; Eliminate all slashes and backslashes by
;; replacing them with sequences that start with %.
;; Quote % also, to keep distinct names distinct.
:type '(choice (string :tag "Program") (const :tag "None" nil))
:group 'dired)
-(defcustom directory-free-space-args "-Pk"
+(defcustom directory-free-space-args
+ (if (eq system-type 'darwin) "-k" "-Pk")
"*Options to use when running `directory-free-space-program'."
:type 'string
:group 'dired)
;; dired-insert-headerline
;; dired-after-subdir-garbage (defines what a "total" line is)
;; - variable dired-subdir-regexp
+;; - may be passed "--dired" as the first argument in SWITCHES.
+;; Filename handlers might have to remove this switch if their
+;; "ls" command does not support it.
(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.
wildcard full-directory-p)
(if (eq system-type 'vax-vms)
(vms-read-directory file switches (current-buffer))
- (let (result available)
+ (let (result available (beg (point)))
;; Read the actual directory using `insert-directory-program'.
;; RESULT gets the status code.
- (let ((coding-system-for-read
- (and enable-multibyte-characters
- (or file-name-coding-system
- default-file-name-coding-system)))
- ;; This is to control encoding the arguments in call-process.
- (coding-system-for-write coding-system-for-read))
+ (let* ((coding-system-for-read
+ (and enable-multibyte-characters
+ (or file-name-coding-system
+ default-file-name-coding-system)))
+ ;; This is to control encoding the arguments in call-process.
+ (coding-system-for-write coding-system-for-read))
(setq result
(if wildcard
;; Run ls in the directory part of the file pattern
(access-file file "Reading directory")
(error "Listing directory failed but `access-file' worked")))
+ (when (string-match "--dired\\>" switches)
+ (forward-line -2)
+ (when (looking-at "//SUBDIRED//")
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (forward-line -1))
+ (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)))))
+ (put-text-property start end 'dired-filename t)))
+ (goto-char end)
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 2) (point)))))
+
;; Try to insert the amount of free space.
(save-excursion
- (goto-char (point-min))
+ (goto-char beg)
;; First find the line to put it on.
- (when (re-search-forward "^total" nil t)
+ (when (re-search-forward "^ *\\(total\\)" nil t)
(let ((available (get-free-disk-space ".")))
(when available
;; Replace "total" with "used", to avoid confusion.
- (replace-match "total used in directory")
+ (replace-match "total used in directory" nil nil nil 1)
(end-of-line)
(insert " available " available))))))))))
(define-key esc-map "~" 'not-modified)
(define-key ctl-x-map "\C-d" 'list-directory)
(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs)
+(define-key ctl-x-map "\C-q" 'toggle-read-only)
(define-key ctl-x-4-map "f" 'find-file-other-window)
(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)