;;; files.el --- file input and output commands for Emacs
-;; Copyright (C) 1985, 86, 87, 92, 93,
-;; 94, 95, 96, 97, 98, 99, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001
+;;; Free Software Foundation, Inc.
;; Maintainer: FSF
:group 'abbrev
:group 'find-file)
-;;; Turn off backup files on VMS since it has version numbers.
+;; Turn off backup files on VMS since it has version numbers.
(defcustom make-backup-files (not (eq system-type 'vax-vms))
"*Non-nil means make a backup of a file the first time it is saved.
This can be done by renaming the file or by copying.
: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 '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"))
+ `(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)"
+ ,(expand-file-name "\\2" temporary-file-directory)))
"*Transforms to apply to buffer file name before making auto-save file name.
Each transform is a list (REGEXP REPLACEMENT):
REGEXP is a regular expression to match against the file name.
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."
:group 'auto-save
:type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")))
: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."
(defvar cd-path nil
"Value of the CDPATH environment variable, as a list.
-Not actually set up until the first time you you use it.")
+Not actually set up until the first time you use it.")
(defun parse-colon-path (cd-path)
"Explode a colon-separated search path into a list of directory names.
(defun load-file (file)
"Load the Lisp file named FILE."
- (interactive "fLoad file: ")
- (let ((completion-ignored-extensions
- (delete ".elc" completion-ignored-extensions)))
- (load (expand-file-name file) nil nil t)))
+ ;; This is a case where .elc makes a lot of sense.
+ (interactive (list (let ((completion-ignored-extensions
+ (remove ".elc" completion-ignored-extensions)))
+ (read-file-name "Load file: "))))
+ (load (expand-file-name file) nil nil t))
(defun load-library (library)
"Load the library named LIBRARY.
(defun switch-to-buffer-other-window (buffer &optional norecord)
"Select buffer BUFFER in another window.
Optional second arg NORECORD non-nil means
-do not put this buffer at the front of the list of recently selected ones."
+do not put this buffer at the front of the list of recently selected ones.
+
+This uses the function `display-buffer' as a subroutine; see its
+documentation for additional customization information."
(interactive "BSwitch to buffer in other window: ")
(let ((pop-up-windows t))
(pop-to-buffer buffer t norecord)))
(defun switch-to-buffer-other-frame (buffer &optional norecord)
"Switch to buffer BUFFER in another frame.
Optional second arg NORECORD non-nil means
-do not put this buffer at the front of the list of recently selected ones."
+do not put this buffer at the front of the list of recently selected ones.
+
+This uses the function `display-buffer' as a subroutine; see its
+documentation for additional customization information."
(interactive "BSwitch to buffer in other frame: ")
(let ((pop-up-frames t))
(pop-to-buffer buffer t norecord)
(setq found (car list))))
(setq list (cdr list)))
found)
- (let ((number (nthcdr 10 (file-attributes truename)))
- (list (buffer-list)) found)
+ (let* ((attributes (file-attributes truename))
+ (number (nthcdr 10 attributes))
+ (list (buffer-list)) found)
(and buffer-file-numbers-unique
number
(while (and (not found) list)
- (save-excursion
- (set-buffer (car list))
+ (with-current-buffer (car list)
(if (and buffer-file-name
(equal buffer-file-number number)
;; Verify this buffer's file number
;; still belongs to its file.
(file-exists-p buffer-file-name)
- (equal (nthcdr 10 (file-attributes buffer-file-name))
- number))
+ (equal (file-attributes buffer-file-name)
+ attributes))
(setq found (car list))))
(setq list (cdr list))))
found))))
:version "20.4"
:type 'boolean)
+(defcustom find-file-suppress-same-file-warnings nil
+ "*Non-nil means suppress warning messages for symlinked files.
+When nil, Emacs prints a warning when visiting a file that is already
+visited, but with a different name. Setting this option to t
+suppresses this warning."
+ :group 'files
+ :version "21.1"
+ :type 'boolean)
+
(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
"Read file FILENAME into a buffer and return the buffer.
If a buffer exists visiting FILENAME, return that one, but
(find-file-wildcards nil))
(if (null files)
(find-file-noselect filename)
- (car (mapcar #'find-file-noselect files))))
+ (mapcar #'find-file-noselect files)))
(let* ((buf (get-file-buffer filename))
(truename (abbreviate-file-name (file-truename filename)))
(number (nthcdr 10 (file-attributes truename)))
(if other
(progn
(or nowarn
+ find-file-suppress-same-file-warnings
(string-equal filename (buffer-file-name other))
(message "%s and %s are the same file"
filename (buffer-file-name other)))
(with-current-buffer buf
(revert-buffer t t)))))
(with-current-buffer buf
+
+ ;; 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 (not (eq (not (null rawfile))
(not (null find-file-literally))))
(if (buffer-modified-p)
"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-hooks', automatic uncompression, etc.
This function ensures that none of these modifications will take place."
(let ((format-alist nil)
(after-insert-file-functions nil)
(coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion)
- (jka-compr-compression-info-list nil)
(find-buffer-file-type-function
(if (fboundp 'find-buffer-file-type)
(symbol-function 'find-buffer-file-type)
- nil)))
+ nil))
+ (inhibit-file-name-handlers '(jka-compr-handler image-file-handler))
+ (inhibit-file-name-operation 'insert-file-contents))
(unwind-protect
(progn
(fset 'find-buffer-file-type (lambda (filename) t))
and multibyte characters are disabled in the resulting buffer.
The major mode used is Fundamental mode regardless of the file name,
and local variable specifications in the file are ignored.
-Automatic uncompression is also disabled.
+Automatic uncompression and adding a newline at the end of the
+file due to `require-final-newline' is also disabled.
You cannot absolutely rely on this function to result in
visiting the file literally. If Emacs already has a buffer
nil
(let* (not-serious
(msg
- (cond ((and error (file-attributes buffer-file-name))
- (setq buffer-read-only t)
- "File exists, but cannot be read")
- ((not buffer-read-only)
- (if (and warn
- ;; No need to warn if buffer is auto-saved
- ;; under the name of the visited file.
- (not (and buffer-file-name
- auto-save-visited-file-name))
- (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"
- (file-name-nondirectory buffer-file-name))
- (setq not-serious t)
- (if error "(New file)" nil)))
- ((not error)
- (setq not-serious t)
- "Note: file is write protected")
- ((file-attributes (directory-file-name default-directory))
- "File not found and directory write-protected")
- ((file-exists-p (file-name-directory buffer-file-name))
- (setq buffer-read-only nil))
- (t
- (setq buffer-read-only nil)
- (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name))))
- "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")))))
- (if msg
- (progn
- (message msg)
- (or not-serious (sit-for 1 nil t)))))
- (if (and auto-save-default (not noauto))
- (auto-save-mode t)))
+ (cond
+ ((not warn) nil)
+ ((and error (file-attributes buffer-file-name))
+ (setq buffer-read-only t)
+ "File exists, but cannot be read")
+ ((not buffer-read-only)
+ (if (and warn
+ ;; No need to warn if buffer is auto-saved
+ ;; under the name of the visited file.
+ (not (and buffer-file-name
+ auto-save-visited-file-name))
+ (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"
+ (file-name-nondirectory buffer-file-name))
+ (setq not-serious t)
+ (if error "(New file)" nil)))
+ ((not error)
+ (setq not-serious t)
+ "Note: file is write protected")
+ ((file-attributes (directory-file-name default-directory))
+ "File not found and directory write-protected")
+ ((file-exists-p (file-name-directory buffer-file-name))
+ (setq buffer-read-only nil))
+ (t
+ (setq buffer-read-only nil)
+ (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name))))
+ "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)
+ (or not-serious (sit-for 1 nil t))))
+ (when (and auto-save-default (not noauto))
+ (auto-save-mode t)))
;; Make people do a little extra work (C-x C-q)
;; before altering a backup file.
- (if (backup-file-name-p buffer-file-name)
- (setq buffer-read-only t))
- (if nomodes
- nil
- (and view-read-only view-mode
- (view-mode-disable))
+ (when (backup-file-name-p buffer-file-name)
+ (setq buffer-read-only t))
+ (unless nomodes
+ (when (and view-read-only view-mode)
+ (view-mode-disable))
(normal-mode t)
- (if (and buffer-read-only view-read-only
- (not (eq (get major-mode 'mode-class) 'special)))
- (view-mode-enter))
+ (when (and buffer-read-only
+ view-read-only
+ (not (eq (get major-mode 'mode-class) 'special)))
+ (view-mode-enter))
(run-hooks 'find-file-hooks)))
(defun normal-mode (&optional find-file)
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
("\\.ad[abs]\\'" . ada-mode)
- ("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode)
+ ("\\.\\([pP]\\([Llm]\\|erl\\)\\|al\\)\\'" . perl-mode)
("\\.s?html?\\'" . html-mode)
("\\.cc\\'" . c++-mode)
("\\.hh\\'" . c++-mode)
("\\.mk\\'" . makefile-mode)
("\\(M\\|m\\|GNUm\\)akefile\\(\\.in\\)?\\'" . makefile-mode)
("\\.am\\'" . makefile-mode) ;For Automake.
-;;; Less common extensions come here
-;;; so more common ones above are found faster.
+ ;; Less common extensions come here
+ ;; so more common ones above are found faster.
("\\.texinfo\\'" . texinfo-mode)
("\\.te?xi\\'" . texinfo-mode)
("\\.s\\'" . asm-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)
- ("\\.m?spec$" . sh-mode)
+ ("\\.m?spec\\'" . sh-mode)
("\\.mm\\'" . nroff-mode)
("\\.me\\'" . nroff-mode)
("\\.ms\\'" . nroff-mode)
("\\.man\\'" . nroff-mode)
("\\.\\(u?lpc\\|pike\\|pmod\\)\\'" . pike-mode)
-;;; The following should come after the ChangeLog pattern
-;;; for the sake of ChangeLog.1, etc.
-;;; and after the .scm.[0-9] pattern too.
- ("\\.[12345678]\\'" . nroff-mode)
("\\.TeX\\'" . tex-mode)
("\\.sty\\'" . latex-mode)
("\\.cls\\'" . latex-mode) ;LaTeX 2e class
("\\.sim\\'" . simula-mode)
("\\.mss\\'" . scribe-mode)
("\\.f90\\'" . f90-mode)
+ ("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
("\\.pro\\'" . idlwave-mode)
("\\.lsp\\'" . lisp-mode)
("\\.awk\\'" . awk-mode)
("[:/]_emacs\\'" . emacs-lisp-mode)
("/crontab\\.X*[0-9]+\\'" . shell-script-mode)
("\\.ml\\'" . lisp-mode)
- ("\\.asn$" . snmp-mode)
- ("\\.mib$" . snmp-mode)
- ("\\.smi$" . snmp-mode)
- ("\\.as2$" . snmpv2-mode)
- ("\\.mi2$" . snmpv2-mode)
- ("\\.sm2$" . snmpv2-mode)
+ ("\\.\\(asn\\|mib\\|smi\\)\\'" . snmp-mode)
+ ("\\.\\(as\\|mi\\|sm\\)2\\'" . snmpv2-mode)
("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode)
- ("\\.[eE]?[pP][sS]$" . ps-mode)
- ("configure\\.in\\'" . autoconf-mode)
+ ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MSDOG
+ ("\\.[eE]?[pP][sS]\\'" . ps-mode)
+ ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
("BROWSE\\'" . ebrowse-tree-mode)
- ("\\.ebrowse\\'" . ebrowse-tree-mode)))
+ ("\\.ebrowse\\'" . ebrowse-tree-mode)
+ ("#\\*mail\\*" . mail-mode)
+ ;; Get rid of any trailing .n.m and try again.
+ ;; This is for files saved by cvs-merge that look like .#<file>.<rev>
+ ;; or .#<file>.<rev>-<rev> or VC's <file>.~<rev>~.
+ ;; Using mode nil rather than `ignore' would let the search continue
+ ;; through this list (with the shortened name) rather than start over.
+ ("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" ignore t)
+ ;; 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.
+ ("\\.[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).
\(NON-NIL stands for anything that is not nil; the value does not matter.)
When checking `inhibit-first-line-modes-regexps', we first discard
from the end of the file name anything that matches one of these regexps.")
-(defvar auto-mode-interpreter-regexp
+(defvar auto-mode-interpreter-regexp
"#![ \t]?\\([^ \t\n]*\
/bin/env[ \t]\\)?\\([^ \t\n]+\\)"
"Regular expression matching interpreters, for file mode determination.
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")
- (setq modes (cons (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
- modes)))
- ;; Simple -*-MODE-*- case.
- (setq modes (cons (intern (concat (downcase (buffer-substring beg end))
- "-mode"))
- modes))))))
+ (push (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
+ 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.
- (when modes
- (unless just-from-file-name
- (mapc 'funcall (nreverse modes)))
- (setq done t))
+ (unless just-from-file-name
+ (dolist (mode (nreverse modes))
+ (if (not (functionp mode))
+ (message "Ignoring unknown mode `%s'" mode)
+ (setq done t)
+ (funcall mode))))
;; If we didn't find a mode from a -*- line, try using the file name.
(if (and (not done) buffer-file-name)
(let ((name buffer-file-name)
(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"))
;; 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)
;; This one is safe because the user gets to check it before it is used.
(put 'compile-command 'safe-local-variable t)
;; 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$"
(symbol-name var))
(not (get var 'safe-local-variable))))
;; Permit evalling a put of a harmless property.
(setq backup-info (find-backup-file-name real-file-name)
backupname (car backup-info)
targets (cdr backup-info))
-;;; (if (file-directory-p buffer-file-name)
-;;; (error "Cannot save buffer in directory %s" buffer-file-name))
+ ;; (if (file-directory-p buffer-file-name)
+ ;; (error "Cannot save buffer in directory %s" buffer-file-name))
(if backup-info
(condition-case ()
(let ((delete-old-versions
(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
"")))))
"A function to use instead of the default `make-backup-file-name'.
A value of nil gives the default `make-backup-file-name' behaviour.
-This could be buffer-local to do something special for for specific
+This could be buffer-local to do something special for specific
files. If you define it, you may need to change `backup-file-name-p'
and `file-name-sans-versions' too.
On MS-DOS filesystems without long names this variable is always
ignored."
:group 'backup
- :type '(repeat (cons (regexp :tag "Regexp macthing filename")
+ :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.
(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 (convert-standard-filename file))
+ (setq file (expand-file-name (convert-standard-filename file)))
(setq dir-sep-string (char-to-string directory-sep-char))
- (or (eq directory-sep-char ?/)
- (subst-char-in-string ?/ ?\\ file))
- (or (eq directory-sep-char ?\\)
- (subst-char-in-string ?\\ ?/ file))
(if (eq (aref file 1) ?:)
(setq file (concat dir-sep-string
"drive_"
;; Run a handler for this function so that ange-ftp can refuse to do it.
(if handler
(funcall handler 'find-backup-file-name fn)
- (if (eq version-control 'never)
+ (if (or (eq version-control 'never)
+ ;; We don't support numbered backups on plain MS-DOS
+ ;; when long file names are unavailable.
+ (and (eq system-type 'ms-dos)
+ (not (msdos-long-file-names))))
(list (make-backup-file-name fn))
(let* ((basic-name (make-backup-file-name-1 fn))
(base-versions (concat (file-name-nondirectory basic-name)
-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
(make-backup-files (or (and make-backup-files (not (eq args 0)))
(memq args '(16 64)))))
(and modp (memq args '(16 64)) (setq buffer-backed-up nil))
- (if (and modp large) (message "Saving file %s..." (buffer-file-name)))
+ (if (and modp large (buffer-file-name))
+ (message "Saving file %s..." (buffer-file-name)))
(basic-save-buffer)
(and modp (memq args '(4 64)) (setq buffer-backed-up nil))))
(widen)
(save-excursion
(and (> (point-max) 1)
+ (not find-file-literally)
(/= (char-after (1- (point-max))) ?\n)
(not (and (eq selective-display t)
(= (char-after (1- (point-max))) ?\r)))
(save-excursion
(goto-char (point-max))
(insert ?\n))))
+ ;; Support VC version backups.
+ (vc-before-save)
(or (run-hook-with-args-until-success 'write-contents-hooks)
(run-hook-with-args-until-success 'local-write-file-hooks)
(run-hook-with-args-until-success 'write-file-hooks)
(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))
;; `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 (file-name-sans-versions
- (make-backup-file-name filename)))
+ (let* ((filename (make-backup-file-name filename))
(file (file-name-nondirectory filename))
(dir (file-name-directory filename))
(comp (file-name-all-completions file dir))
(let ((coding-system-for-read
;; Auto-saved file shoule be read without
;; any code conversion.
- (if auto-save-p 'no-conversion
+ (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)
(not (file-exists-p file-name)))
(error "Auto-save file %s not current" file-name))
((save-window-excursion
- (if (not (memq system-type '(vax-vms windows-nt)))
- (with-output-to-temp-buffer "*Directory*"
- (buffer-disable-undo standard-output)
- (call-process "ls" nil standard-output nil
- (if (file-symlink-p file) "-lL" "-l")
- file file-name)))
+ (with-output-to-temp-buffer "*Directory*"
+ (buffer-disable-undo standard-output)
+ (save-excursion
+ (let ((switches dired-listing-switches))
+ (if (file-symlink-p file)
+ (setq switches (concat switches "L")))
+ (set-buffer standard-output)
+ ;; Use insert-directory-safely, not insert-directory,
+ ;; because these files might not exist. In particular,
+ ;; FILE might not exist if the auto-save file was for
+ ;; a buffer that didn't visit a file, such as "*mail*".
+ ;; The code in v20.x called `ls' directly, so we need
+ ;; to emulate what `ls' did in that case.
+ (insert-directory-safely file switches)
+ (insert-directory-safely file-name switches))))
(yes-or-no-p (format "Recover auto save file %s? " file-name)))
(switch-to-buffer (find-file-noselect file t))
(let ((buffer-read-only nil)
;; Keep the current buffer-file-coding-system.
(coding-system buffer-file-coding-system)
;; Auto-saved file shoule be read without any code conversion.
- (coding-system-for-read 'no-conversion))
+ (coding-system-for-read 'emacs-mule-unix))
(erase-buffer)
(insert-file-contents file-name nil)
(set-buffer-file-coding-system coding-system))
(if (and (eq system-type 'ms-dos)
(not (msdos-long-file-names)))
- (let ((fn (file-name-nondirectory buffer-file-name)))
+ ;; 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)
(substring pattern (match-beginning 0)))
beg (1+ (match-end 0)))))
pattern))))
-
+
(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.
whose name is in the variable `insert-directory-program'.
If WILDCARD, it also runs the shell specified by `shell-file-name'."
;; We need the directory in order to find the right handler.
- (let* ((file (expand-file-name file))
- (handler (find-file-name-handler file 'insert-directory)))
+ (let ((handler (find-file-name-handler (expand-file-name file)
+ 'insert-directory)))
(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 (file-name-directory 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
+ &optional wildcard full-directory-p)
+ "Insert directory listing for FILE, formatted according to SWITCHES.
+
+Like `insert-directory', but if FILE does not exist, it inserts a
+message to that effect instead of signaling an error."
+ (if (file-exists-p file)
+ (insert-directory file switches wildcard full-directory-p)
+ ;; Simulate the message printed by `ls'.
+ (insert (format "%s: No such file or directory\n" file))))
+
(defvar kill-emacs-query-functions nil
"Functions to call with no arguments to query about killing Emacs.
If any of these functions returns nil, killing Emacs is cancelled.
but `kill-emacs', the low level primitive, does not.
See also `kill-emacs-hook'.")
+(defcustom confirm-kill-emacs nil
+ "How to ask for confirmation when leaving Emacs.
+If nil, the default, don't ask at all. If the value is non-nil, it should
+be a predicate function such as `yes-or-no-p'."
+ :type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)
+ (const :tag "Ask with y-or-n-p" y-or-n-p)
+ (const :tag "Don't confirm" nil))
+ :group 'emacs
+ :version "21.1")
+
(defun save-buffers-kill-emacs (&optional arg)
"Offer to save each buffer, then kill this Emacs process.
With prefix arg, silently save all file-visiting buffers, then kill."
(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)
+ (or (null confirm-kill-emacs)
+ (funcall confirm-kill-emacs "Really exit Emacs? "))
(kill-emacs)))
\f
;; We use /: as a prefix to "quote" a file name
HCoop / bpt / emacs.git / blobdiff