;;; 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
:type '(choice (const nil) integer)
:group 'backup)
-(defun normal-backup-enable-predicate (name)
- "Default `backup-enable-predicate' function.
-Checks for files in `temporary-file-directory' or
-`small-temporary-file-directory'."
- (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
- name 0 nil)))
- ;; Directory is under temporary-file-directory.
- (and (not (eq comp t))
- (< comp (- (length temporary-file-directory)))))
- (if small-temporary-file-directory
- (let ((comp (compare-strings small-temporary-file-directory
- 0 nil
- name 0 nil)))
- ;; Directory is under small-temporary-file-directory.
- (and (not (eq comp t))
- (< comp (- (length small-temporary-file-directory)))))))))
-
(defvar backup-enable-predicate 'normal-backup-enable-predicate
"Predicate that looks at a file name and decides whether to make backups.
Called with an absolute file name as argument, it returns t to enable backup.")
(defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
"Non-nil means that buffer-file-number uniquely identifies files.")
+(defvar buffer-file-read-only nil
+ "Non-nil if visited file was read-only when visited.")
+(make-variable-buffer-local 'buffer-file-read-only)
+
+(defcustom temporary-file-directory
+ (file-name-as-directory
+ (cond ((memq system-type '(ms-dos windows-nt))
+ (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
+ ((memq system-type '(vax-vms axp-vms))
+ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
+ (t
+ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
+ "The directory for writing temporary files."
+ :group 'files
+ :type 'directory)
+
+(defcustom small-temporary-file-directory
+ (if (eq system-type 'ms-dos) (getenv "TMPDIR"))
+ "The directory for writing small temporary files.
+If non-nil, this directory is used instead of `temporary-file-directory'
+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 '(choice (const nil) directory))
+
+;; The system null device. (Should reference NULL_DEVICE from C.)
+(defvar null-device "/dev/null" "The system null device.")
+
(defvar file-name-invalid-regexp
(cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
(concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive
:group 'auto-save)
(defcustom auto-save-file-name-transforms
- '(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)" "/tmp/\\2"))
+ `(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)"
+ ;; 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 `/tmp'
-for editing a remote file."
+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.
+
+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 nil
+(defcustom save-abbrevs t
"*Non-nil means save word abbrevs too when files are saved.
-Loading an abbrev file sets this to t."
- :type 'boolean
+If `silently', don't ask the user before saving."
+ :type '(choice (const t) (const nil) (const silently))
:group 'abbrev)
(defcustom find-file-run-dired t
(defvar view-read-only nil
"*Non-nil means buffers visiting files read-only, do it in view mode.")
-(defvar temporary-file-directory
- (file-name-as-directory
- (cond ((memq system-type '(ms-dos windows-nt))
- (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
- ((memq system-type '(vax-vms axp-vms))
- (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
- (t
- (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
- "The directory for writing temporary files.")
-
-(defvar small-temporary-file-directory
- (if (eq system-type 'ms-dos) (getenv "TMPDIR"))
- "The directory for writing small temporary files.
-If non-nil, this directory is used instead of `temporary-file-directory'
-by programs that create small temporary files. This is for systems that
-have fast storage with limited space, such as a RAM disk.")
-
-;; The system null device. (Should reference NULL_DEVICE from C.)
-(defvar null-device "/dev/null" "The system null device.")
-
(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)))))
+ (if action
+ (all-completions string (mapcar 'list names))
+ (try-completion string (mapcar 'list 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-local-copy (file)
(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)
+ (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))
+ 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: "))
(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 "FFind file in other window: "))
(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 "FFind file in other frame: "))
(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 "fFind file read-only: "))
(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 "fFind file read-only other window: "))
(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 "fFind file read-only other frame: "))
(find-file-other-frame filename wildcards)
(toggle-read-only 1)
(current-buffer))
(with-current-buffer buf
(revert-buffer t t)))))
(with-current-buffer buf
- (when (not (eq (not (null rawfile))
- (not (null find-file-literally))))
+
+ ;; Check if a formerly read-only file has become
+ ;; writable and vice versa, but if the buffer agrees
+ ;; with the new state of the file, that is ok too.
+ (let ((read-only (not (file-writable-p buffer-file-name))))
+ (unless (or (eq read-only buffer-file-read-only)
+ (eq read-only buffer-read-only))
+ (when (or nowarn
+ (let ((question
+ (format "File %s is %s on disk. Change buffer mode? "
+ buffer-file-name
+ (if read-only "read-only" "writable"))))
+ (y-or-n-p question)))
+ (setq buffer-read-only read-only)))
+ (setq buffer-file-read-only read-only))
+
+ (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? "
"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)))
(mapc
(lambda (elt)
(cons (purecopy (car elt)) (cdr elt)))
- '(("\\.te?xt\\'" . text-mode)
+ '(("\\.in\\'" nil t)
+ ("\\.te?xt\\'" . text-mode)
("\\.c\\'" . c-mode)
("\\.h\\'" . c-mode)
("\\.tex\\'" . tex-mode)
("\\.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.
("\\.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)
;; The following should come after the ChangeLog pattern
;; for the sake of ChangeLog.1, etc.
;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
- ("\\.[12345678]\\'" . nroff-mode)
+ ("\\.[1-9]\\'" . nroff-mode)
("\\.g\\'" . antlr-mode)))
"Alist of filename patterns vs corresponding major mode functions.
Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
then we do not set anything but the major mode,
and we don't even do that unless it would come from the file name."
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
- (let (beg end done modes)
+ (let (end done modes)
(save-excursion
(goto-char (point-min))
(skip-chars-forward " \t\n")
(and enable-local-variables
- ;; Don't look for -*- if this file name matches any
- ;; of the regexps in inhibit-first-line-modes-regexps.
- (let ((temp inhibit-first-line-modes-regexps)
- (name (if buffer-file-name
- (file-name-sans-versions buffer-file-name)
- (buffer-name))))
- (while (let ((sufs inhibit-first-line-modes-suffixes))
- (while (and sufs (not (string-match (car sufs) name)))
- (setq sufs (cdr sufs)))
- sufs)
- (setq name (substring name 0 (match-beginning 0))))
- (while (and temp
- (not (string-match (car temp) name)))
- (setq temp (cdr temp)))
- (not temp))
- (search-forward "-*-" (save-excursion
- ;; If the file begins with "#!"
- ;; (exec interpreter magic), look
- ;; for mode frobs in the first two
- ;; lines. You cannot necessarily
- ;; put them in the first line of
- ;; such a file without screwing up
- ;; the interpreter invocation.
- (end-of-line (and (looking-at "^#!") 2))
- (point)) t)
- (progn
- (skip-chars-forward " \t")
- (setq beg (point))
- (search-forward "-*-"
- (save-excursion (end-of-line) (point))
- t))
- (progn
- (forward-char -3)
- (skip-chars-backward " \t")
- (setq end (point))
- (goto-char beg)
- (if (save-excursion (search-forward ":" end t))
- ;; Find all specifications for the `mode:' variable
- ;; and execute them left to right.
- (while (let ((case-fold-search t))
- (or (and (looking-at "mode:")
- (goto-char (match-end 0)))
- (re-search-forward "[ \t;]mode:" end t)))
- (skip-chars-forward " \t")
- (setq beg (point))
+ (setq end (set-auto-mode-1))
+ (if (save-excursion (search-forward ":" end t))
+ ;; Find all specifications for the `mode:' variable
+ ;; and execute them left to right.
+ (while (let ((case-fold-search t))
+ (or (and (looking-at "mode:")
+ (goto-char (match-end 0)))
+ (re-search-forward "[ \t;]mode:" end t)))
+ (skip-chars-forward " \t")
+ (let ((beg (point)))
(if (search-forward ";" end t)
(forward-char -1)
(goto-char end))
(skip-chars-backward " \t")
(push (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
- modes))
- ;; Simple -*-MODE-*- case.
- (push (intern (concat (downcase (buffer-substring beg end))
- "-mode"))
- modes)))))
+ modes)))
+ ;; Simple -*-MODE-*- case.
+ (push (intern (concat (downcase (buffer-substring (point) end))
+ "-mode"))
+ modes))))
;; If we found modes to use, invoke them now,
;; outside the save-excursion.
(unless just-from-file-name
(if elt
(funcall (cdr elt))))))))))))
+
+(defun set-auto-mode-1 ()
+ "Find the -*- spec in the buffer.
+Call with point at the place to start searching from.
+If one is found, set point to the beginning
+and return the position of the end.
+Otherwise, return nil; point may be changed."
+ (let (beg end)
+ (and
+ ;; Don't look for -*- if this file name matches any
+ ;; of the regexps in inhibit-first-line-modes-regexps.
+ (let ((temp inhibit-first-line-modes-regexps)
+ (name (if buffer-file-name
+ (file-name-sans-versions buffer-file-name)
+ (buffer-name))))
+ (while (let ((sufs inhibit-first-line-modes-suffixes))
+ (while (and sufs (not (string-match (car sufs) name)))
+ (setq sufs (cdr sufs)))
+ sufs)
+ (setq name (substring name 0 (match-beginning 0))))
+ (while (and temp
+ (not (string-match (car temp) name)))
+ (setq temp (cdr temp)))
+ (not temp))
+
+ (search-forward "-*-" (save-excursion
+ ;; If the file begins with "#!"
+ ;; (exec interpreter magic), look
+ ;; for mode frobs in the first two
+ ;; lines. You cannot necessarily
+ ;; put them in the first line of
+ ;; such a file without screwing up
+ ;; the interpreter invocation.
+ (end-of-line (and (looking-at "^#!") 2))
+ (point)) t)
+ (progn
+ (skip-chars-forward " \t")
+ (setq beg (point))
+ (search-forward "-*-"
+ (save-excursion (end-of-line) (point))
+ t))
+ (progn
+ (forward-char -3)
+ (skip-chars-backward " \t")
+ (setq end (point))
+ (goto-char beg)
+ end))))
+
(defun hack-local-variables-prop-line ()
"Set local variables specified in the -*- line.
Ignore any specification for `mode:' and `coding:';
(save-excursion
(goto-char (point-min))
(let ((result nil)
- (end (save-excursion (end-of-line (and (looking-at "^#!") 2)) (point)))
+ (end (set-auto-mode-1))
(enable-local-variables
(and local-enable-local-variables enable-local-variables)))
;; Parse the -*- line into the `result' alist.
- (cond ((not (search-forward "-*-" end t))
- ;; doesn't have one.
+ (cond ((not end)
nil)
((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
;; Simple form: "-*- MODENAME -*-". Already handled.
(t
;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
;; (last ";" is optional).
- (save-excursion
- (if (search-forward "-*-" end t)
- (setq end (- (point) 3))
- (error "-*- not terminated before end of line")))
(while (< (point) end)
(or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
(error "Malformed -*- line"))
(put 'ignored-local-variables 'risky-local-variable t)
(put 'eval 'risky-local-variable t)
(put 'file-name-handler-alist 'risky-local-variable t)
+(put 'minor-mode-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)
+(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 one is safe because the user gets to check it before it is used.
(put 'compile-command 'safe-local-variable t)
(defun hack-one-local-variable (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"))))
;; Likewise for setting hook variables.
((or (get var 'risky-local-variable)
(and
- (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$"
+ (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))))
;; Permit evalling a put of a harmless property.
(message "Ignoring `eval:' 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
(defun file-name-sans-extension (filename)
"Return FILENAME sans final \"extension\".
-The extension, in a file name, is the part that follows the last `.'."
+The extension, in a file name, is the part that follows the last `.',
+except that a leading `.', if any, doesn't count."
(save-match-data
(let ((file (file-name-sans-versions (file-name-nondirectory filename)))
directory)
- (if (string-match "\\.[^.]*\\'" file)
+ (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)
(defun file-name-extension (filename &optional period)
"Return FILENAME's final \"extension\".
-The extension, in a file name, is the part that follows the last `.'.
+The extension, in a file name, is the part that follows the last `.',
+except that a leading `.', if any, doesn't count.
Return nil for extensionless file names such as `foo'.
Return the empty string for file names such as `foo.'.
the value is \"\"."
(save-match-data
(let ((file (file-name-sans-versions (file-name-nondirectory filename))))
- (if (string-match "\\.[^.]*\\'" file)
+ (if (and (string-match "\\.[^.]*\\'" file)
+ (not (eq 0 (match-beginning 0))))
(substring file (+ (match-beginning 0) (if period 0 1)))
(if period
"")))))
:type '(repeat (cons (regexp :tag "Regexp matching filename")
(directory :tag "Backup directory name"))))
+(defun normal-backup-enable-predicate (name)
+ "Default `backup-enable-predicate' function.
+Checks for files in `temporary-file-directory' or
+`small-temporary-file-directory'."
+ (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
+ name 0 nil)))
+ ;; Directory is under temporary-file-directory.
+ (and (not (eq comp t))
+ (< comp (- (length temporary-file-directory)))))
+ (if small-temporary-file-directory
+ (let ((comp (compare-strings small-temporary-file-directory
+ 0 nil
+ name 0 nil)))
+ ;; Directory is under small-temporary-file-directory.
+ (and (not (eq comp t))
+ (< comp (- (length small-temporary-file-directory)))))))))
+
(defun make-backup-file-name (file)
"Create the non-numeric backup file name for FILE.
Normally this will just be the file's name with `~' appended.
-1))
(file-error (setq possibilities nil)))
(if (not deserve-versions-p)
- (list (concat basic-name "~"))
+ (list (make-backup-file-name fn))
(cons (format "%s.~%d~" basic-name (1+ high-water-mark))
(if (and (> number-to-delete 0)
;; Delete nothing if there is overflow
;; 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
(and save-abbrevs abbrevs-changed
(progn
(if (or arg
+ (eq save-abbrevs 'silently)
(y-or-n-p (format "Save abbrevs in %s? "
abbrev-file-name)))
(write-abbrev-file nil))
(if auto-save-p 'emacs-mule-unix
coding-system-for-read)))
;; 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-formats buffer-file-formats))
+ (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
(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)))
- (let ((fn (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
+ directory-sep-char ?!
+ (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)
+ filename)
;; 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 "-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.
;; We need the directory in order to find the right handler.
(let ((handler (find-file-name-handler (expand-file-name file)
'insert-directory)))
- (if handler
+ (if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
(if (eq system-type 'vax-vms)
(vms-read-directory file switches (current-buffer))
- (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)
- (result
- (if wildcard
- ;; Run ls in the directory of the file pattern we asked for
- (let ((default-directory
- (if (file-name-absolute-p file)
- (file-name-directory file)
- (file-name-directory (expand-file-name file))))
- (pattern (file-name-nondirectory file)))
- (call-process
- shell-file-name nil t nil
- "-c" (concat (if (memq system-type '(ms-dos windows-nt))
- ""
- "\\") ; Disregard Unix shell aliases!
- insert-directory-program
- " -d "
- (if (stringp switches)
- switches
- (mapconcat 'identity switches " "))
- " -- "
- ;; Quote some characters that have
- ;; special meanings in shells; but
- ;; don't quote the wildcards--we
- ;; want them to be special. We
- ;; also currently don't quote the
- ;; quoting characters in case
- ;; people want to use them
- ;; explicitly to quote wildcard
- ;; characters.
- (shell-quote-wildcard-pattern pattern))))
- ;; SunOS 4.1.3, SVr4 and others need the "." to list the
- ;; directory if FILE is a symbolic link.
- (apply 'call-process
- insert-directory-program nil t nil
- (append
- (if (listp switches) switches
- (unless (equal switches "")
- ;; Split the switches at any spaces so we can
- ;; pass separate options as separate args.
- (split-string switches)))
- ;; Avoid lossage if FILE starts with `-'.
- '("--")
- (progn
- (if (string-match "\\`~" file)
- (setq file (expand-file-name file)))
- (list
- (if full-directory-p
- (concat (file-name-as-directory file) ".")
- file))))))))
+ (let (result available)
+
+ ;; 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))
+ (setq result
+ (if wildcard
+ ;; Run ls in the directory part of the file pattern
+ ;; using the last component as argument.
+ (let ((default-directory
+ (if (file-name-absolute-p file)
+ (file-name-directory file)
+ (file-name-directory (expand-file-name file))))
+ (pattern (file-name-nondirectory file)))
+ (call-process
+ shell-file-name nil t nil
+ "-c"
+ (concat (if (memq system-type '(ms-dos windows-nt))
+ ""
+ "\\") ; Disregard Unix shell aliases!
+ insert-directory-program
+ " -d "
+ (if (stringp switches)
+ switches
+ (mapconcat 'identity switches " "))
+ " -- "
+ ;; Quote some characters that have
+ ;; special meanings in shells; but
+ ;; don't quote the wildcards--we want
+ ;; them to be special. We also
+ ;; currently don't quote the quoting
+ ;; characters in case people want to
+ ;; use them explicitly to quote
+ ;; wildcard characters.
+ (shell-quote-wildcard-pattern pattern))))
+ ;; SunOS 4.1.3, SVr4 and others need the "." to list the
+ ;; directory if FILE is a symbolic link.
+ (apply 'call-process
+ insert-directory-program nil t nil
+ (append
+ (if (listp switches) switches
+ (unless (equal switches "")
+ ;; Split the switches at any spaces so we can
+ ;; pass separate options as separate args.
+ (split-string switches)))
+ ;; Avoid lossage if FILE starts with `-'.
+ '("--")
+ (progn
+ (if (string-match "\\`~" file)
+ (setq file (expand-file-name file)))
+ (list
+ (if full-directory-p
+ (concat (file-name-as-directory file) ".")
+ file))))))))
+
+ ;; If `insert-directory-program' failed, signal an error.
(if (/= result 0)
- ;; We get here if `insert-directory-program' failed.
;; On non-Posix systems, we cannot open a directory, so
;; don't even try, because that will always result in
- ;; the ubiquitous "Access denied". Instead, show them
- ;; the `ls' command line and let them guess what went
- ;; wrong.
+ ;; the ubiquitous "Access denied". Instead, show the
+ ;; command line so the user can try to guess what went wrong.
(if (and (file-directory-p file)
(memq system-type '(ms-dos windows-nt)))
(error
(if (listp switches) (concat switches) switches)
file result)
;; Unix. Access the file to get a suitable error.
- (access-file file "Reading directory"))
- ;; Replace "total" with "used", to avoid confusion.
- ;; Add in the amount of free space.
- (save-excursion
- (goto-char (point-min))
- (when (re-search-forward "^total" nil t)
- (replace-match "used")
- (end-of-line)
- (let (available)
- (with-temp-buffer
- (call-process "df" nil t nil ".")
- (goto-char (point-min))
- (forward-line 1)
- (skip-chars-forward "^ \t")
- (forward-word 3)
- (let ((end (point)))
- (forward-word -1)
- (setq available (buffer-substring (point) end))))
+ (access-file file "Reading directory")
+ (error "Listing directory failed but `access-file' worked")))
+
+ ;; Try to insert the amount of free space.
+ (save-excursion
+ (goto-char (point-min))
+ ;; First find the line to put it on.
+ (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")
+ (end-of-line)
(insert " available " available))))))))))
(defun insert-directory-safely (file switches
(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)
HCoop / bpt / emacs.git / blobdiff