;;; files.el --- file input and output commands for Emacs
-;; Copyright (C) 1985, 86, 87, 92, 93, 94, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 92, 93,
+;; 94, 95, 1996 Free Software Foundation, Inc.
;; Maintainer: FSF
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
and the rest are not called.
These hooks are considered to pertain to the visited file.
So this list is cleared if you change the visited file name.
-See also `write-contents-hooks'.
-Don't make this variable buffer-local; instead, use `local-write-file-hooks'.")
+
+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'.")
+`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.")
(make-variable-buffer-local 'local-write-file-hooks)
(put 'local-write-file-hooks 'permanent-local t)
"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 buffer's contents,
-not to the particular visited file; thus, `set-visited-file-name' does
-not clear this variable, but changing the major mode does clear it.
+
+This variable is meant to be used for hooks that pertain to the
+buffer's contents, not to the particular visited file; thus,
+`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-hooks' to add elements to the list, use nil for the
+LOCAL argument.
+
See also `write-file-hooks'.")
+(make-variable-buffer-local 'write-contents-hooks)
(defconst enable-local-variables t
"*Control use of local-variables lists in files you visit.
inhibit-file-name-handlers)))
(inhibit-file-name-operation op))
(apply op args))))
+
+(defun convert-standard-filename (filename)
+ "Convert a standard file's name to something suitable for the current OS.
+This function's standard definition is trivial; it just returns the argument.
+However, on some systems, the function is redefined
+with a definition that really does change some file names."
+ filename)
\f
(defun pwd ()
"Show the current default directory."
;; If the home dir is just /, don't change it.
(not (and (= (match-end 0) 1)
(= (aref filename 0) ?/)))
+ ;; MS-DOS root directories can come with a drive letter;
+ ;; Novell Netware allows drive letters beyond `Z:'.
(not (and (or (eq system-type 'ms-dos)
(eq system-type 'windows-nt))
(save-match-data
- (string-match "^[a-zA-Z]:/$" filename)))))
+ (string-match "^[a-zA-`]:/$" filename)))))
(setq filename
(concat "~"
(substring filename (match-beginning 1) (match-end 1))
(dired-noselect (if find-file-visit-truename
(abbreviate-file-name (file-truename filename))
filename))
- (error "%s is a directory." filename))
+ (error "%s is a directory" filename))
(let* ((buf (get-file-buffer filename))
(truename (abbreviate-file-name (file-truename filename)))
(number (nthcdr 10 (file-attributes truename)))
(setq backup-inhibited t)))
(if rawfile
nil
- (after-find-file error (not nowarn)))))
+ (after-find-file error (not nowarn))
+ (setq buf (current-buffer)))))
buf)))
\f
(defvar after-find-file-from-revert-buffer nil)
(defun after-find-file (&optional error warn noauto
- after-find-file-from-revert-buffer)
+ after-find-file-from-revert-buffer
+ nomodes)
"Called after finding a file and by the default revert function.
Sets buffer mode, parses local variables.
Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
NOAUTO means don't mess with auto-save mode.
Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
means this call was from `revert-buffer'.
-Finishes by calling the functions in `find-file-hooks'."
+Fifth arg NOMODES non-nil means don't alter the file's modes.
+Finishes by calling the functions in `find-file-hooks'
+unless NOMODES is non-nil."
(setq buffer-read-only (not (file-writable-p buffer-file-name)))
(if noninteractive
nil
(if (and warn
(file-newer-than-file-p (make-auto-save-file-name)
buffer-file-name))
- "Auto save file is newer; consider M-x recover-file"
+ (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)
(or not-serious (sit-for 1 nil t)))))
(if (and auto-save-default (not noauto))
(auto-save-mode t)))
- (normal-mode t)
- (run-hooks 'find-file-hooks))
+ (if nomodes
+ nil
+ (normal-mode t)
+ (run-hooks 'find-file-hooks)))
(defun normal-mode (&optional find-file)
"Choose the major mode for this buffer automatically.
(prin1-to-string err)))))
(defvar auto-mode-alist
- '(("\\.text\\'" . text-mode)
+ '(("\\.te?xt\\'" . text-mode)
("\\.c\\'" . c-mode)
("\\.h\\'" . c-mode)
("\\.tex\\'" . tex-mode)
("\\.l\\'" . lisp-mode)
("\\.lisp\\'" . lisp-mode)
("\\.f\\'" . fortran-mode)
+ ("\\.F\\'" . fortran-mode)
("\\.for\\'" . fortran-mode)
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
("\\.hxx\\'" . c++-mode)
("\\.c\\+\\+\\'" . c++-mode)
("\\.h\\+\\+\\'" . c++-mode)
+ ("\\.java\\'" . java-mode)
("\\.mk\\'" . makefile-mode)
- ("[Mm]akefile\\(.in\\)?\\'" . makefile-mode)
+ ("\\(M\\|m\\|GNUm\\)akefile\\(.in\\)?\\'" . makefile-mode)
;;; Less common extensions come here
;;; so more common ones above are found faster.
("\\.texinfo\\'" . texinfo-mode)
- ("\\.texi\\'" . texinfo-mode)
+ ("\\.te?xi\\'" . texinfo-mode)
("\\.s\\'" . asm-mode)
("\\.S\\'" . asm-mode)
("\\.asm\\'" . asm-mode)
("ChangeLog.[0-9]+\\'" . change-log-mode)
("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
("\\.scm\\.[0-9]*\\'" . scheme-mode)
+ ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
+ ("/\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode)
+ ("/\\.\\(bash_logout\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
+ ("/\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
;;; The following should come after the ChangeLog pattern
;;; for the sake of ChangeLog.1, etc.
;;; and after the .scm.[0-9] pattern too.
("\\.article\\'" . text-mode)
("\\.letter\\'" . text-mode)
("\\.tcl\\'" . tcl-mode)
+ ("\\.exp\\'" . tcl-mode)
+ ("\\.itcl\\'" . tcl-mode)
+ ("\\.itk\\'" . tcl-mode)
("\\.f90\\'" . f90-mode)
("\\.lsp\\'" . lisp-mode)
("\\.awk\\'" . awk-mode)
("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode)
;; Mailer puts message to be edited in
;; /tmp/Re.... or Message
- ("^/tmp/Re" . text-mode)
+ ("\\`/tmp/Re" . text-mode)
("/Message[0-9]*\\'" . text-mode)
("/drafts/[0-9]+\\'" . mh-letter-mode)
;; some news reader is reported to use this
- ("^/tmp/fol/" . text-mode)
+ ("\\`/tmp/fol/" . text-mode)
("\\.y\\'" . c-mode)
("\\.lex\\'" . c-mode)
("\\.oak\\'" . scheme-mode)
- ("\\.sgm\\'" . sgml-mode)
- ("\\.sgml\\'" . sgml-mode)
+ ("\\.sgml?\\'" . sgml-mode)
("\\.dtd\\'" . sgml-mode)
+ ("\\.s?html?\\'" . html-mode)
;; .emacs following a directory delimiter
;; in either Unix or VMS syntax.
("[]>:/]\\..*emacs\\'" . emacs-lisp-mode)
(defconst interpreter-mode-alist
'(("perl" . perl-mode)
+ ("perl5" . perl-mode)
("wish" . tcl-mode)
("wishx" . tcl-mode)
("tcl" . tcl-mode)
("tclsh" . tcl-mode)
("awk" . awk-mode)
+ ("mawk" . awk-mode)
("nawk" . awk-mode)
("gawk" . awk-mode)
- ("scm" . scheme-mode))
+ ("scm" . scheme-mode)
+ ("ash" . sh-mode)
+ ("bash" . sh-mode)
+ ("csh" . sh-mode)
+ ("dtksh" . sh-mode)
+ ("es" . sh-mode)
+ ("itcsh" . sh-mode)
+ ("jsh" . sh-mode)
+ ("ksh" . sh-mode)
+ ("oash" . sh-mode)
+ ("pdksh" . sh-mode)
+ ("rc" . sh-mode)
+ ("sh" . sh-mode)
+ ("sh5" . sh-mode)
+ ("tcsh" . sh-mode)
+ ("wksh" . sh-mode)
+ ("wsh" . sh-mode)
+ ("zsh" . sh-mode)
+ ("tail" . text-mode)
+ ("more" . text-mode)
+ ("less" . text-mode)
+ ("pg" . text-mode))
"Alist mapping interpreter names to major modes.
This alist applies to files whose first line starts with `#!'.
Each element looks like (INTERPRETER . MODE).
(let ((interpreter
(save-excursion
(goto-char (point-min))
- (if (looking-at "#! *\\([^ \t\n]*/bin/env +\\)?\\([^ \t\n]+\\)")
+ (if (looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)")
(buffer-substring (match-beginning 2)
(match-end 2))
"")))
(string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$"
(symbol-name var))
(not (get var 'safe-local-variable))))
- ;; Permit evaling a put of a harmless property
+ ;; Permit evalling a put of a harmless property.
;; if the args do nothing tricky.
(if (or (and (eq var 'eval)
(consp val)
(setq truename (file-truename filename))
(if find-file-visit-truename
(setq filename truename))))
+ (let ((buffer (and filename (find-buffer-visiting filename))))
+ (and buffer (not (eq buffer (current-buffer)))
+ (not (y-or-n-p (message "A buffer is visiting %s; proceed? "
+ filename)))
+ (error "Aborted")))
(or (equal filename buffer-file-name)
(progn
(and filename (lock-buffer filename))
If the buffer is already visiting a file, you can specify
a directory name as FILENAME, to write a file of the same
old name in that directory.
+
If optional second arg CONFIRM is non-nil,
-ask for confirmation for overwriting an existing file."
+ask for confirmation for overwriting an existing file.
+Interactively, confirmation is required unless you supply a prefix argument."
;; (interactive "FWrite file: ")
(interactive
(list (if buffer-file-name
(cdr (assq 'default-directory
(buffer-local-variables)))
nil nil (buffer-name)))
- t))
+ (not current-prefix-arg)))
(or (null filename) (string-equal filename "")
(progn
;; If arg is just a directory,
(setq setmodes (file-modes backupname)))
(file-error
;; If trouble writing the backup, write it in ~.
- (setq backupname (expand-file-name "~/%backup%~"))
- (message "Cannot write backup file; backing up in ~/%%backup%%~")
+ (setq backupname (expand-file-name
+ (convert-standard-filename
+ "~/%backup%~")))
+ (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)
(setq nogood t)
;; Find the temporary name to write under.
(while nogood
- (setq tempname (format "%s#tmp#%d" dir i))
+ (setq tempname (format
+ (if (eq system-type 'ms-dos)
+ "%s#%d.tm#" ; MSDOS limits files to 8+3
+ "%s#tmp#%d")
+ dir i))
(setq nogood (file-exists-p tempname))
(setq i (1+ i)))
(unwind-protect
(file (file-name-nondirectory filename))
(dir (file-name-directory filename))
(comp (file-name-all-completions file dir))
- newest)
+ (newest nil)
+ tem)
(while comp
- (setq file (concat dir (car comp))
+ (setq tem (car comp)
comp (cdr comp))
- (if (and (backup-file-name-p file)
- (or (null newest) (file-newer-than-file-p file newest)))
- (setq newest file)))
+ (cond ((and (backup-file-name-p tem)
+ (string= (file-name-sans-versions tem) file))
+ (setq tem (concat dir tem))
+ (if (or (null newest)
+ (file-newer-than-file-p tem newest))
+ (setq newest tem)))))
newest))
(defun rename-uniquely ()
"Create the directory DIR and any nonexistent parent dirs.
Interactively, the default choice of directory to create
is the current default directory for file names.
-That is useful when you have visited a file in a nonexistint directory.
+That is useful when you have visited a file in a nonexistent directory.
Noninteractively, the second (optional) argument PARENTS says whether
to create parent directories if they don't exist."
If `revert-buffer-function' is used to override the normal revert
mechanism, this hook is not used.")
-(defun revert-buffer (&optional ignore-auto noconfirm)
+(defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
"Replace the buffer text with the text of the visited file on disk.
This undoes all changes since the file was visited or saved.
With a prefix argument, offer to revert from latest auto-save file, if
;; have changed the truename.
(setq buffer-file-truename
(abbreviate-file-name (file-truename buffer-file-name)))
- (after-find-file nil nil t t)
+ (after-find-file nil nil t t preserve-modes)
;; Run after-revert-hook as it was before we reverted.
(setq-default revert-buffer-internal-hook global-hook)
(if local-hook-p
To choose one, move point to the proper line and then type C-c C-c.
Then you'll be asked about a number of files to recover."
(interactive)
- (dired (concat auto-save-list-file-prefix "*"))
+ (let ((ls-lisp-support-shell-wildcards t))
+ (dired (concat auto-save-list-file-prefix "*")))
(goto-char (point-min))
(or (looking-at "Move to the session you want to recover,")
(let ((inhibit-read-only t))
before calling this function. You can redefine this for customization.
See also `auto-save-file-name-p'."
(if buffer-file-name
- (concat (file-name-directory buffer-file-name)
- "#"
- (file-name-nondirectory buffer-file-name)
- "#")
+ (if (eq system-type 'ms-dos)
+ (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 buffer-file-name)
+ "#"
+ (file-name-nondirectory buffer-file-name)
+ "#"))
;; Deal with buffers that don't have any associated files. (Mail
;; mode tends to create a good number of these.)
FILENAME should lack slashes. You can redefine this for customization."
(string-match "^#.*#$" filename))
\f
+(defun wildcard-to-regexp (wildcard)
+ "Given a shell file name pattern WILDCARD, return an equivalent regexp.
+The generated regexp will match a filename iff the filename
+matches that wildcard according to shell rules. Only wildcards known
+by `sh' are supported."
+ (let* ((i (string-match "[[.*+\\^$?]" wildcard))
+ ;; Copy the initial run of non-special characters.
+ (result (substring wildcard 0 i))
+ (len (length wildcard)))
+ ;; If no special characters, we're almost done.
+ (if i
+ (while (< i len)
+ (let ((ch (aref wildcard i))
+ j)
+ (setq
+ result
+ (concat result
+ (cond
+ ((eq ch ?\[) ; [...] maps to regexp char class
+ (progn
+ (setq i (1+ i))
+ (concat
+ (cond
+ ((eq (aref wildcard i) ?!) ; [!...] -> [^...]
+ (progn
+ (setq i (1+ i))
+ (if (eq (aref wildcard i) ?\])
+ (progn
+ (setq i (1+ i))
+ "[^]")
+ "[^")))
+ ((eq (aref wildcard i) ?^)
+ ;; Found "[^". Insert a `\0' character
+ ;; (which cannot happen in a filename)
+ ;; into the character class, so that `^'
+ ;; is not the first character after `[',
+ ;; and thus non-special in a regexp.
+ (progn
+ (setq i (1+ i))
+ "[\000^"))
+ ((eq (aref wildcard i) ?\])
+ ;; I don't think `]' can appear in a
+ ;; character class in a wildcard, but
+ ;; let's be general here.
+ (progn
+ (setq i (1+ i))
+ "[]"))
+ (t "["))
+ (prog1 ; copy everything upto next `]'.
+ (substring wildcard
+ i
+ (setq j (string-match
+ "]" wildcard i)))
+ (setq i (if j (1- j) (1- len)))))))
+ ((eq ch ?.) "\\.")
+ ((eq ch ?*) "[^\000]*")
+ ((eq ch ?+) "\\+")
+ ((eq ch ?^) "\\^")
+ ((eq ch ?$) "\\$")
+ ((eq ch ?\\) "\\\\") ; probably cannot happen...
+ ((eq ch ??) "[^\000]")
+ (t (char-to-string ch)))))
+ (setq i (1+ i)))))
+ ;; Shell wildcards should match the entire filename,
+ ;; not its part. Make the regexp say so.
+ (concat "\\`" result "\\'")))
+\f
(defconst list-directory-brief-switches
(if (eq system-type 'vax-vms) "" "-CF")
"*Switches for list-directory to pass to `ls' for brief listing,")
(terpri)
(save-excursion
(set-buffer "*Directory*")
- (setq default-directory (file-name-directory dirname))
+ (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)))))))