;;; files.el --- file input and output commands for Emacs
-;; Copyright (C) 1985, 86, 87, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1985, 86, 87, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002
;;; Free Software Foundation, Inc.
;; Maintainer: FSF
by programs that create small temporary files. This is for systems that
have fast storage with limited space, such as a RAM disk."
:group 'files
- :type 'directory)
+ :type '(choice (const nil) directory))
;; The system null device. (Should reference NULL_DEVICE from C.)
(defvar null-device "/dev/null" "The system null device.")
(defcustom auto-save-file-name-transforms
`(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)"
- ,(expand-file-name "\\2" temporary-file-directory)))
+ ;; Don't put "\\2" inside expand-file-name, since it will be
+ ;; transformed to "/2" on DOS/Windows.
+ ,(concat temporary-file-directory "\\2") t))
"*Transforms to apply to buffer file name before making auto-save file name.
-Each transform is a list (REGEXP REPLACEMENT):
+Each transform is a list (REGEXP REPLACEMENT UNIQUIFY):
REGEXP is a regular expression to match against the file name.
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,
+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.
+
All the transforms in the list are tried, in the order they are listed.
When one transform applies, its result is final;
no further transforms are tried.
The default value is set up to put the auto-save file into the
temporary directory (see the variable `temporary-file-directory') for
-editing a remote file."
+editing a remote file.
+
+On MS-DOS filesystems without long names this variable is always
+ignored."
:group 'auto-save
- :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")))
+ :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")
+ (boolean :tag "Uniquify")))
:version "21.1")
(defcustom save-abbrevs t
;;;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."
that really does change some file names to canonicalize certain
patterns and to guarantee valid names."
filename)
+
+(defun read-directory-name (prompt &optional dir default-dirname mustmatch initial)
+ "Read directory name, prompting with PROMPT and completing in directory DIR.
+Value is not expanded---you must call `expand-file-name' yourself.
+Default name to DEFAULT-DIRNAME if user enters a null string.
+ (If DEFAULT-DIRNAME is omitted, the current buffer's directory is used,
+ except that if INITIAL is specified, that combined with DIR is used.)
+Fourth arg MUSTMATCH non-nil means require existing directory's name.
+ Non-nil and non-t means also require confirmation after completion.
+Fifth arg INITIAL specifies text to start with.
+DIR defaults to current buffer's directory default."
+ (unless dir
+ (setq dir default-directory))
+ (unless default-dirname
+ (setq default-dirname
+ (if initial (concat dir initial) default-directory)))
+ (read-file-name prompt dir default-dirname mustmatch initial
+ 'file-directory-p))
+
\f
(defun pwd ()
"Show the current default directory."
If your environment includes a `CDPATH' variable, try each one of that
colon-separated list of directories when resolving a relative directory name."
(interactive
- (list (read-file-name "Change default directory: "
+ (list (read-directory-name "Change default directory: "
default-directory default-directory
(and (member cd-path '(nil ("./")))
(null (getenv "CDPATH"))))))
(read-file-name "Load file: "))))
(load (expand-file-name file) nil nil t))
+(defun locate-file (filename path &optional suffixes predicate)
+ "Search for FILENAME through PATH.
+If SUFFIXES is non-nil, it should be a list of suffixes to append to
+file name when searching. If SUFFIXES is nil, it is equivalent to '(\"\").
+If non-nil, PREDICATE is used instead of `file-readable-p'.
+PREDICATE can also be an integer to pass to the `access' system call,
+in which case file-name handlers are ignored. This usage is deprecated.
+
+For compatibility, PREDICATE can also be one of the symbols
+`executable', `readable', `writable', or `exists', or a list of
+one or more of those symbols."
+ (if (and predicate (symbolp predicate) (not (functionp predicate)))
+ (setq predicate (list predicate)))
+ (when (and (consp predicate) (not (functionp predicate)))
+ (setq predicate
+ (logior (if (memq 'executable predicate) 1 0)
+ (if (memq 'writable predicate) 2 0)
+ (if (memq 'readable predicate) 4 0))))
+ (locate-file-internal filename path suffixes predicate))
+
+(defun locate-file-completion (string path-and-suffixes action)
+ "Do completion for file names passed to `locate-file'.
+PATH-AND-SUFFIXES is a pair of lists (DIRECTORIES . SUFFIXES)."
+ (if (file-name-absolute-p string)
+ (read-file-name-internal string nil action)
+ (let ((names nil)
+ (suffix (concat (regexp-opt (cdr path-and-suffixes) t) "\\'"))
+ (string-dir (file-name-directory string)))
+ (dolist (dir (car path-and-suffixes))
+ (if string-dir (setq dir (expand-file-name string-dir dir)))
+ (when (file-directory-p dir)
+ (dolist (file (file-name-all-completions
+ (file-name-nondirectory string) dir))
+ (push (if string-dir (concat string-dir file) file) names)
+ (when (string-match suffix file)
+ (setq file (substring file 0 (match-beginning 0)))
+ (push (if string-dir (concat string-dir file) file) 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.
This is an interface to the function `load'."
- (interactive "sLoad library: ")
+ (interactive
+ (list (completing-read "Load library: "
+ 'locate-file-completion
+ (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)))))
+(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)))
+ (munge-default-fun
+ (lambda ()
+ (setq minibuffer-default find-file-default)
+ ;; Clear out this hook so it does not interfere
+ ;; with any recursive minibuffer usage.
+ (pop minibuffer-setup-hook)))
+ (minibuffer-setup-hook
+ minibuffer-setup-hook))
+ (add-hook 'minibuffer-setup-hook munge-default-fun)
+ (read-file-name prompt nil default-directory mustmatch))
+ current-prefix-arg))
+
(defun find-file (filename &optional wildcards)
"Edit file FILENAME.
Switch to a buffer visiting file FILENAME,
creating one if none already exists.
+Interactively, the default if you just type RET is the current directory,
+but the visited file name is available through the minibuffer history:
+type M-n to pull it into the minibuffer.
+
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files. Wildcard expansion
can be suppressed by setting `find-file-wildcards'."
- (interactive "FFind file: \np")
+ (interactive
+ (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))
"Edit file FILENAME, in another window.
May create a new window, or reuse an existing one.
See the function `display-buffer'.
+
+Interactively, the default if you just type RET is the current directory,
+but the visited file name is available through the minibuffer history:
+type M-n to pull it into the minibuffer.
+
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
- (interactive "FFind file in other window: \np")
+ (interactive (find-file-read-args "Find file in other window: " nil))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
"Edit file FILENAME, in another frame.
May create a new frame, or reuse an existing one.
See the function `display-buffer'.
+
+Interactively, the default if you just type RET is the current directory,
+but the visited file name is available through the minibuffer history:
+type M-n to pull it into the minibuffer.
+
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
- (interactive "FFind file in other frame: \np")
+ (interactive (find-file-read-args "Find file in other frame: " nil))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
(progn
(defun find-file-read-only (filename &optional wildcards)
"Edit file FILENAME but don't allow changes.
-Like `find-file' but marks buffer as read-only.
+Like \\[find-file] but marks buffer as read-only.
Use \\[toggle-read-only] to permit editing."
- (interactive "fFind file read-only: \np")
+ (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 "fFind file read-only other window: \np")
+ (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 "fFind file read-only other frame: \np")
+ (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"))))
(setq buffer-read-only read-only)))
(setq buffer-file-read-only read-only))
- (when (not (eq (not (null rawfile))
- (not (null find-file-literally))))
+ (when (and (not (eq (not (null rawfile))
+ (not (null find-file-literally))))
+ ;; It is confusing to ask whether to visit
+ ;; non-literally if they have the file in
+ ;; hexl-mode.
+ (not (eq major-mode 'hexl-mode)))
(if (buffer-modified-p)
(if (y-or-n-p (if rawfile
"Save file and revisit literally? "
(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)))
"Use M-x make-directory RET RET to create the directory"
"Use C-u M-x make-directory RET RET to create directory and its parents")))))
(when msg
- (message msg)
+ (message "%s" msg)
(or not-serious (sit-for 1 nil t))))
(when (and auto-save-default (not noauto))
(auto-save-mode t)))
;; 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)
("\\.sim\\'" . simula-mode)
("\\.mss\\'" . scribe-mode)
("\\.f90\\'" . f90-mode)
+ ("\\.f95\\'" . f90-mode)
("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
("\\.pro\\'" . idlwave-mode)
("\\.lsp\\'" . lisp-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 'overriding-local-map 'risky-local-variable t)
+(put 'overriding-terminal-local-map 'risky-local-variable t)
+(put 'auto-mode-alist 'risky-local-variable t)
(put 'after-load-alist 'risky-local-variable t)
(put 'buffer-file-name 'risky-local-variable t)
+(put 'buffer-undo-list 'risky-local-variable t)
(put 'buffer-auto-save-file-name 'risky-local-variable t)
(put 'buffer-file-truename 'risky-local-variable t)
+(put 'default-text-properties '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)
;; 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)
+(put 'font-lock-defaults 'risky-local-variable t)
+(put 'special-display-buffer-names 'risky-local-variable t)
+(put 'frame-title-format 'risky-local-variable t)
+(put 'global-mode-string 'risky-local-variable t)
+(put 'header-line-format 'risky-local-variable t)
+(put 'icon-title-format 'risky-local-variable t)
+(put 'input-method-alist 'risky-local-variable t)
+(put 'format-alist 'risky-local-variable t)
+(put 'vc-mode 'risky-local-variable t)
+(put 'imenu-generic-expression 'risky-local-variable t)
+(put 'imenu-index-alist 'risky-local-variable t)
+(put 'standard-input 'risky-local-variable t)
+(put 'standard-output 'risky-local-variable t)
+(put 'unread-command-events 'risky-local-variable t)
+(put 'max-lisp-eval-depth 'risky-local-variable t)
+(put 'max-specpdl-size 'risky-local-variable t)
+(put 'mode-line-format 'risky-local-variable t)
+(put 'mode-line-modified 'risky-local-variable t)
+(put 'mode-line-mule-info 'risky-local-variable t)
+(put 'mode-line-buffer-identification 'risky-local-variable t)
+(put 'mode-line-modes 'risky-local-variable t)
+(put 'mode-line-position 'risky-local-variable t)
+(put 'display-time-string 'risky-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 variable names are treated specially."
+A few patterns are specified so that any name which matches one
+is considered risky."
(cond ((eq var 'mode)
(funcall (intern (concat (downcase (symbol-name val))
"-mode"))))
((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$"
- (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.
+ ;; Some text properties can get evaluated in various ways,
+ ;; so it is risky to put them on with a local variable list.
+ (if (stringp val)
+ (set-text-properties 0 (length val) nil val))
(set var val))))
\f
(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))
;; delete the temp file.
(or succeed
(progn
- (delete-file tempname)
+ (condition-case nil
+ (delete-file tempname)
+ (file-error nil))
(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))
+ (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.
;; `make-backup-file-name' will get us the right directory for
;; ordinary or numeric backups. It might create a directory for
;; backups as a side-effect, according to `backup-directory-alist'.
- (let* ((filename (make-backup-file-name filename))
+ (let* ((filename (file-name-sans-versions
+ (make-backup-file-name filename)))
(file (file-name-nondirectory filename))
(dir (file-name-directory filename))
(comp (file-name-all-completions file dir))
(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
(if buffer-file-name
(let ((list auto-save-file-name-transforms)
(filename buffer-file-name)
- result)
+ result uniq)
;; Apply user-specified translations
;; to the file name.
(while (and list (not result))
(if (string-match (car (car list)) filename)
(setq result (replace-match (cadr (car list)) t nil
- filename)))
+ filename)
+ uniq (car (cddr (car list)))))
(setq list (cdr list)))
- (if result (setq filename result))
-
- (if (and (eq system-type 'ms-dos)
- (not (msdos-long-file-names)))
- ;; We truncate the file name to DOS 8+3 limits before
- ;; doing anything else, because the regexp passed to
- ;; string-match below cannot handle extensions longer than
- ;; 3 characters, multiple dots, and other atrocities.
- (let ((fn (dos-8+3-filename
- (file-name-nondirectory buffer-file-name))))
- (string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn)
- (concat (file-name-directory buffer-file-name)
- "#" (match-string 1 fn)
- "." (match-string 3 fn) "#"))
- (concat (file-name-directory filename)
- "#"
- (file-name-nondirectory filename)
- "#")))
+ (if result
+ (if uniq
+ (setq filename (concat
+ (file-name-directory result)
+ (subst-char-in-string
+ ?/ ?!
+ (replace-regexp-in-string "!" "!!"
+ filename))))
+ (setq filename result)))
+ (setq result
+ (if (and (eq system-type 'ms-dos)
+ (not (msdos-long-file-names)))
+ ;; We truncate the file name to DOS 8+3 limits
+ ;; before doing anything else, because the regexp
+ ;; passed to string-match below cannot handle
+ ;; extensions longer than 3 characters, multiple
+ ;; dots, and other atrocities.
+ (let ((fn (dos-8+3-filename
+ (file-name-nondirectory buffer-file-name))))
+ (string-match
+ "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
+ fn)
+ (concat (file-name-directory buffer-file-name)
+ "#" (match-string 1 fn)
+ "." (match-string 3 fn) "#"))
+ (concat (file-name-directory filename)
+ "#"
+ (file-name-nondirectory filename)
+ "#")))
+ ;; Make sure auto-save file names don't contain characters
+ ;; invalid for the underlying filesystem.
+ (if (and (memq system-type '(ms-dos windows-nt))
+ ;; Don't modify remote (ange-ftp) filenames
+ (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result)))
+ (convert-standard-filename result)
+ result))
;; Deal with buffers that don't have any associated files. (Mail
;; mode tends to create a good number of these.)
(let ((buffer-name (buffer-name))
- (limit 0))
+ (limit 0)
+ file-name)
;; Eliminate all slashes and backslashes by
;; replacing them with sequences that start with %.
;; Quote % also, to keep distinct names distinct.
(setq buffer-name (replace-match replacement t t buffer-name))
(setq limit (1+ (match-end 0)))))
;; Generate the file name.
- (expand-file-name
- (format "#%s#%s#" buffer-name (make-temp-name ""))
- ;; Try a few alternative directories, to get one we can write it.
- (cond
- ((file-writable-p default-directory) default-directory)
- ((file-writable-p "/var/tmp/") "/var/tmp/")
- ("~/"))))))
+ (setq file-name
+ (make-temp-file
+ (let ((fname
+ (expand-file-name
+ (format "#%s#" buffer-name)
+ ;; Try a few alternative directories, to get one we can
+ ;; write it.
+ (cond
+ ((file-writable-p default-directory) default-directory)
+ ((file-writable-p "/var/tmp/") "/var/tmp/")
+ ("~/")))))
+ (if (and (memq system-type '(ms-dos windows-nt))
+ ;; Don't modify remote (ange-ftp) filenames
+ (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" fname)))
+ ;; The call to convert-standard-filename is in case
+ ;; buffer-name includes characters not allowed by the
+ ;; DOS/Windows filesystems. make-temp-file writes to the
+ ;; file it creates, so we must fix the file name _before_
+ ;; make-temp-file is called.
+ (convert-standard-filename fname)
+ fname))
+ nil "#"))
+ ;; make-temp-file creates the file,
+ ;; but we don't want it to exist until we do an auto-save.
+ (condition-case ()
+ (delete-file file-name)
+ (file-error nil))
+ file-name)))
(defun auto-save-file-name-p (filename)
"Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
relative to the current default directory, `default-directory'.
The file names returned are normally also relative to the current
default directory. However, if FULL is non-nil, they are absolute."
- (let* ((nondir (file-name-nondirectory pattern))
- (dirpart (file-name-directory pattern))
- ;; A list of all dirs that DIRPART specifies.
- ;; This can be more than one dir
- ;; if DIRPART contains wildcards.
- (dirs (if (and dirpart (string-match "[[*?]" dirpart))
- (mapcar 'file-name-as-directory
- (file-expand-wildcards (directory-file-name dirpart)))
- (list dirpart)))
- contents)
- (while dirs
- (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
- (file-directory-p (directory-file-name (car dirs))))
- (let ((this-dir-contents
- ;; Filter out "." and ".."
- (delq nil
- (mapcar #'(lambda (name)
- (unless (string-match "\\`\\.\\.?\\'"
- (file-name-nondirectory name))
- name))
- (directory-files (or (car dirs) ".") full
- (wildcard-to-regexp nondir))))))
- (setq contents
- (nconc
- (if (and (car dirs) (not full))
- (mapcar (function (lambda (name) (concat (car dirs) name)))
- this-dir-contents)
- this-dir-contents)
- contents))))
- (setq dirs (cdr dirs)))
- contents))
+ (save-match-data
+ (let* ((nondir (file-name-nondirectory pattern))
+ (dirpart (file-name-directory pattern))
+ ;; A list of all dirs that DIRPART specifies.
+ ;; This can be more than one dir
+ ;; if DIRPART contains wildcards.
+ (dirs (if (and dirpart (string-match "[[*?]" dirpart))
+ (mapcar 'file-name-as-directory
+ (file-expand-wildcards (directory-file-name dirpart)))
+ (list dirpart)))
+ contents)
+ (while dirs
+ (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
+ (file-directory-p (directory-file-name (car dirs))))
+ (let ((this-dir-contents
+ ;; Filter out "." and ".."
+ (delq nil
+ (mapcar #'(lambda (name)
+ (unless (string-match "\\`\\.\\.?\\'"
+ (file-name-nondirectory name))
+ name))
+ (directory-files (or (car dirs) ".") full
+ (wildcard-to-regexp nondir))))))
+ (setq contents
+ (nconc
+ (if (and (car dirs) (not full))
+ (mapcar (function (lambda (name) (concat (car dirs) name)))
+ this-dir-contents)
+ this-dir-contents)
+ contents))))
+ (setq dirs (cdr dirs)))
+ contents)))
(defun list-directory (dirname &optional verbose)
"Display a list of files in or matching DIRNAME, a la `ls'.
nil default-directory nil)
pfx)))
(let ((switches (if verbose list-directory-verbose-switches
- list-directory-brief-switches)))
+ list-directory-brief-switches))
+ buffer)
(or dirname (setq dirname default-directory))
(setq dirname (expand-file-name dirname))
(with-output-to-temp-buffer "*Directory*"
+ (setq buffer standard-output)
(buffer-disable-undo standard-output)
(princ "Directory ")
(princ dirname)
(terpri)
(save-excursion
(set-buffer "*Directory*")
- (setq default-directory
- (if (file-directory-p dirname)
- (file-name-as-directory dirname)
- (file-name-directory dirname)))
(let ((wildcard (not (file-directory-p dirname))))
- (insert-directory dirname switches wildcard (not wildcard)))))))
+ (insert-directory dirname switches wildcard (not wildcard)))))
+ ;; Finishing with-output-to-temp-buffer seems to clobber default-directory.
+ (with-current-buffer buffer
+ (setq default-directory
+ (if (file-directory-p dirname)
+ (file-name-as-directory dirname)
+ (file-name-directory dirname))))))
(defun shell-quote-wildcard-pattern (pattern)
"Quote characters special to the shell in PATTERN, leave wildcards alone.
(defvar insert-directory-program "ls"
"Absolute or relative name of the `ls' program used by `insert-directory'.")
+(defcustom directory-free-space-program "df"
+ "*Program to get the amount of free space on a file system.
+We assume the output has the format of `df'.
+The value of this variable must be just a command name or file name;
+if you want to specify options, use `directory-free-space-args'.
+
+A value of nil disables this feature.
+
+If the function `file-system-info' is defined, it is always used in
+preference to the program given by this variable."
+ :type '(choice (string :tag "Program") (const :tag "None" nil))
+ :group 'dired)
+
+(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)
+
+(defun get-free-disk-space (dir)
+ "Return the mount of free space on directory DIR's file system.
+The result is a string that gives the number of free 1KB blocks,
+or nil if the system call or the program which retrieve the infornmation
+fail.
+
+This function calls `file-system-info' if it is available, or invokes the
+program specified by `directory-free-space-program' if that is non-nil."
+ ;; Try to find the number of free blocks. Non-Posix systems don't
+ ;; always have df, but might have an equivalent system call.
+ (if (fboundp 'file-system-info)
+ (let ((fsinfo (file-system-info dir)))
+ (if fsinfo
+ (format "%.0f" (/ (nth 2 fsinfo) 1024))))
+ (save-match-data
+ (with-temp-buffer
+ (when (and directory-free-space-program
+ (zerop (call-process directory-free-space-program
+ nil t nil
+ directory-free-space-args
+ dir)))
+ ;; Usual format is a header line followed by a line of
+ ;; numbers.
+ (goto-char (point-min))
+ (forward-line 1)
+ (if (not (eobp))
+ (progn
+ ;; Move to the end of the "available blocks" number.
+ (skip-chars-forward "^ \t")
+ (forward-word 3)
+ ;; Copy it into AVAILABLE.
+ (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.
;; 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)
- ;; Try to find the number of free blocks.
- (save-match-data
- (with-temp-buffer
- (call-process "df" nil t nil ".")
- ;; Usual format is a header line
- ;; followed by a line of numbers.
- (goto-char (point-min))
- (forward-line 1)
- (if (not (eobp))
- (progn
- ;; Move to the end of the "available blocks" number.
- (skip-chars-forward "^ \t")
- (forward-word 3)
- ;; Copy it into AVAILABLE.
- (let ((end (point)))
- (forward-word -1)
- (setq available (buffer-substring (point) end)))))))
- (when available
- ;; Replace "total" with "used", to avoid confusion.
- (replace-match "used")
- (end-of-line)
- (insert " available " available)))))))))
+ (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" nil nil nil 1)
+ (end-of-line)
+ (insert " available " available))))))))))
(defun insert-directory-safely (file switches
&optional wildcard full-directory-p)
(let ((processes (process-list))
active)
(while processes
- (and (memq (process-status (car processes)) '(run stop open))
- (let ((val (process-kill-without-query (car processes))))
- (process-kill-without-query (car processes) val)
- val)
+ (and (memq (process-status (car processes)) '(run stop open listen))
+ (process-query-on-exit-flag (car processes))
(setq active t))
(setq processes (cdr processes)))
(or (not active)
- (list-processes)
+ (list-processes t)
(yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
;; Get a list of the indices of the args which are file names.
(file-arg-indices
(cdr (or (assq operation
- ;; The first four are special because they
+ ;; The first five are special because they
;; return a file name. We want to include the /:
;; in the return value.
;; So just avoid stripping it in the first place.
'((expand-file-name . nil)
- ;; `identity' means just return the first arg
- ;; as stripped of its quoting.
- (substitute-in-file-name . identity)
(file-name-directory . nil)
(file-name-as-directory . nil)
(directory-file-name . nil)
- (file-name-completion 0 1)
- (file-name-all-completions 0 1)
+ (file-name-sans-versions . nil)
+ ;; `identity' means just return the first arg
+ ;; as stripped of its quoting.
+ (substitute-in-file-name . identity)
+ (file-name-completion 1)
+ (file-name-all-completions 1)
(rename-file 0 1)
(copy-file 0 1)
(make-symbolic-link 0 1)
(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)