-;; File input and output commands for Emacs
-;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+;;; files.el --- file input and output commands for Emacs
+
+;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 1, or (at your option)
+;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Code:
+
(defconst delete-auto-save-files t
"*Non-nil means delete a buffer's auto-save file when the buffer is saved.")
Automatically local in all buffers.")
(make-variable-buffer-local 'buffer-offer-save)
+(defconst find-file-existing-other-name nil
+ "*Non-nil means find a file under alternative names, in existing buffers.
+This means if any existing buffer is visiting the file you want
+under another name, you get the existing buffer instead of a new buffer.")
+
+(defconst find-file-visit-truename nil
+ "*Non-nil means visit a file under its truename.
+The truename of a file is found by chasing all links
+both at the file level and at the levels of the containing directories.")
+
+(defvar buffer-file-truename nil
+ "The truename of the file visited in the current buffer.
+This variable is automatically local in all buffers, when non-nil.")
+(make-variable-buffer-local 'buffer-file-truename)
+(put 'buffer-file-truename 'permanent-local t)
+
+(defvar buffer-file-number nil
+ "The device number and file number of the file visited in the current buffer.
+The value is a list of the form (FILENUM DEVNUM).
+This pair of numbers uniquely identifies the file.
+If the buffer is visiting a new file, the value is nil.")
+(make-variable-buffer-local 'buffer-file-number)
+(put 'buffer-file-number 'permanent-local t)
+
(defconst file-precious-flag nil
"*Non-nil means protect against I/O errors while saving files.
Some modes set this non-nil in particular buffers.")
"*When cleaning directory, number of versions to keep.")
(defvar trim-versions-without-asking nil
- "*If true, deletes excess backup versions silently.
-Otherwise asks confirmation.")
+ "*If t, deletes excess backup versions silently.
+If nil, asks confirmation. Any other value prevents any trimming.")
(defvar kept-old-versions 2
"*Number of oldest versions to keep when a new numbered backup is made.")
(defvar write-file-hooks nil
"List of functions to be called before writing out a buffer to a file.
If one of them returns non-nil, the file is considered already written
-and the rest are not called.")
+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'.")
+
+(defvar write-contents-hooks nil
+ "List of functions to be called before writing out a buffer to a file.
+If one of them returns non-nil, the file is considered already written
+and the rest are not called.
+These hooks are considered to pertain to the 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.
+See also `write-file-hooks'.")
(defconst enable-local-variables t
"*Control use of local-variables lists in files you visit.
The command \\[normal-mode] always obeys local-variables lists
and ignores this variable.")
-(defconst ignore-local-eval nil
- "*Non-nil means ignore the \"variable\" `eval' in a file's local variables.
-This applies when the local-variables list is scanned automatically
-after you find a file. If you explicitly request such a scan with
-\\[normal-mode], there is no query, regardless of this variable.")
+(defconst enable-local-eval 'maybe
+ "*Control processing of the \"variable\" `eval' in a file's local variables.
+The value can be t, nil or something else.
+A value of t means obey `eval' variables;
+nil means ignore them; anything else means query.
+
+The command \\[normal-mode] always obeys local-variables lists
+and ignores this variable.")
;; Avoid losing in versions where CLASH_DETECTION is disabled.
(or (fboundp 'lock-buffer)
(if (file-executable-p dir)
(setq default-directory dir)
(error "Cannot cd to %s: Permission denied" dir)))
- (pwd))
+ ;; We used to call pwd at this point. That's not terribly helpful
+ ;; when we're invoking cd interactively, and the new cmushell-based
+ ;; shell has its own (better) facilities for this.
+)
(defun load-file (file)
"Load the Lisp file named FILE."
This is an interface to the function `load'."
(interactive "sLoad library: ")
(load library))
+
+;; OTHER is the other file to be compared.
+(defun file-local-copy (file)
+ "Copy the file FILE into a temporary file on this machine.
+Returns the name of the local copy, or nil, if FILE is directly
+accessible."
+ (let ((handler (find-file-name-handler file)))
+ (if handler
+ (funcall handler 'file-local-copy file)
+ nil)))
+
+(defun file-truename (filename)
+ "Return the truename of FILENAME, which should be absolute.
+The truename of a file name is found by chasing symbolic links
+both at the level of the file and at the level of the directories
+containing it, until no links are left at any level."
+ (if (string= filename "~")
+ (setq filename (expand-file-name filename)))
+ (let ((handler (find-file-name-handler filename)))
+ ;; For file name that has a special handler, call handler.
+ ;; This is so that ange-ftp can save time by doing a no-op.
+ (if handler
+ (funcall handler 'file-truename filename)
+ (let ((dir (file-name-directory filename))
+ target dirfile)
+ ;; Get the truename of the directory.
+ (setq dirfile (directory-file-name dir))
+ ;; If these are equal, we have the (or a) root directory.
+ (or (string= dir dirfile)
+ (setq dir (file-name-as-directory (file-truename dirfile))))
+ ;; Put it back on the file name.
+ (setq filename (concat dir (file-name-nondirectory filename)))
+ ;; Is the file name the name of a link?
+ (setq target (file-symlink-p filename))
+ (if target
+ ;; Yes => chase that link, then start all over
+ ;; since the link may point to a directory name that uses links.
+ (file-truename (expand-file-name target dir))
+ ;; No, we are done!
+ filename)))))
+
\f
(defun switch-to-buffer-other-window (buffer)
"Select buffer BUFFER in another window."
(let ((pop-up-windows t))
(pop-to-buffer buffer t)))
+(defun switch-to-buffer-other-frame (buffer)
+ "Switch to buffer BUFFER in another frame."
+ (interactive "BSwitch to buffer in other frame: ")
+ (let ((pop-up-frames t))
+ (pop-to-buffer buffer)))
+
(defun find-file (filename)
"Edit file FILENAME.
Switch to a buffer visiting file FILENAME,
(interactive "FFind file in other window: ")
(switch-to-buffer-other-window (find-file-noselect filename)))
+(defun find-file-other-frame (filename)
+ "Edit file FILENAME, in another frame.
+May create a new frame, or reuse an existing one.
+See the function `display-buffer'."
+ (interactive "FFind file in other frame: ")
+ (switch-to-buffer-other-frame (find-file-noselect filename)))
+
(defun find-file-read-only (filename)
"Edit file FILENAME but don't allow changes.
Like \\[find-file] but marks buffer as read-only.
(find-file filename)
(setq buffer-read-only t))
+(defun find-file-read-only-other-frame (filename)
+ "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: ")
+ (find-file-other-frame filename)
+ (setq buffer-read-only t))
+
(defun find-alternate-file (filename)
"Find file FILENAME, select its buffer, kill previous buffer.
If the current buffer now contains an empty file that you just visited
(and file
(setq file-name (file-name-nondirectory file)
file-dir (file-name-directory file)))
- (list (read-file-name "Find alternate file: " file-dir nil nil file-name))))
+ (list (read-file-name
+ "Find alternate file: " file-dir nil nil file-name))))
(and (buffer-modified-p)
;; (not buffer-read-only)
(not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
(setq lastname filename))
(generate-new-buffer lastname)))
-(defun find-file-noselect (filename &optional nowarn)
- "Read file FILENAME into a buffer and return the buffer.
-If a buffer exists visiting FILENAME, return that one, but
-verify that the file has not changed since visited or saved.
-The buffer is not selected, just returned to the caller."
- (setq filename (expand-file-name filename))
+(defun generate-new-buffer (name)
+ "Create and return a buffer with a name based on NAME.
+Choose the buffer's name using `generate-new-buffer-name'."
+ (get-buffer-create (generate-new-buffer-name name)))
+
+(defconst automount-dir-prefix "^/tmp_mnt/"
+ "Regexp to match the automounter prefix in a directory name.")
+
+(defvar abbreviated-home-dir nil
+ "The the user's homedir abbreviated according to `directory-abbrev-list'.")
+
+(defun abbreviate-file-name (filename)
+ "Return a version of FILENAME shortened using `directory-abbrev-alist'.
+This also substitutes \"~\" for the user's home directory.
+Type \\[describe-variable] directory-abbrev-alist RET for more information."
;; Get rid of the prefixes added by the automounter.
- (if (and (string-match "^/tmp_mnt/" filename)
+ (if (and (string-match automount-dir-prefix filename)
(file-exists-p (file-name-directory
(substring filename (1- (match-end 0))))))
(setq filename (substring filename (1- (match-end 0)))))
- ;; Perform any appropriate abbreviations specified in directory-abbrev-alist.
(let ((tail directory-abbrev-alist))
+ ;; If any elt of directory-abbrev-alist matches this name,
+ ;; abbreviate accordingly.
(while tail
(if (string-match (car (car tail)) filename)
(setq filename
(concat (cdr (car tail)) (substring filename (match-end 0)))))
- (setq tail (cdr tail))))
+ (setq tail (cdr tail)))
+ ;; Compute and save the abbreviated homedir name.
+ ;; We defer computing this until the first time it's needed, to
+ ;; give time for directory-abbrev-alist to be set properly.
+ (or abbreviated-home-dir
+ (setq abbreviated-home-dir
+ (let ((abbreviated-home-dir "$foo"))
+ (concat "^" (abbreviate-file-name (expand-file-name "~"))))))
+ ;; If FILENAME starts with the abbreviated homedir,
+ ;; make it start with `~' instead.
+ (if (string-match abbreviated-home-dir filename)
+ (setq filename
+ (concat "~" (substring filename (match-end 0)))))
+ filename))
+
+(defun find-file-noselect (filename &optional nowarn)
+ "Read file FILENAME into a buffer and return the buffer.
+If a buffer exists visiting FILENAME, return that one, but
+verify that the file has not changed since visited or saved.
+The buffer is not selected, just returned to the caller."
+ (setq filename
+ (abbreviate-file-name
+ (expand-file-name filename)))
(if (file-directory-p filename)
(if find-file-run-dired
(dired-noselect filename)
(error "%s is a directory." filename))
- (let ((buf (get-file-buffer filename))
- error)
+ (let* ((buf (get-file-buffer filename))
+ (truename (abbreviate-file-name (file-truename filename)))
+ (number (nthcdr 10 (file-attributes truename)))
+ ;; Find any buffer for a file which has same truename.
+ (same-truename
+ (or buf ; Shortcut
+ (let (found
+ (list (buffer-list)))
+ (while (and (not found) list)
+ (save-excursion
+ (set-buffer (car list))
+ (if (string= buffer-file-truename truename)
+ (setq found (car list))))
+ (setq list (cdr list)))
+ found)))
+ (same-number
+ (or buf ; Shortcut
+ (and number
+ (let (found
+ (list (buffer-list)))
+ (while (and (not found) list)
+ (save-excursion
+ (set-buffer (car list))
+ (if (equal buffer-file-number number)
+ (setq found (car list))))
+ (setq list (cdr list)))
+ found))))
+ error)
+ ;; Let user know if there is a buffer with the same truename.
+ (if (and (not buf) same-truename (not nowarn))
+ (message "%s and %s are the same file (%s)"
+ filename (buffer-file-name same-truename)
+ truename)
+ (if (and (not buf) same-number (not nowarn))
+ (message "%s and %s are the same file"
+ filename (buffer-file-name same-number))))
+
+ ;; Optionally also find that buffer.
+ (if (or find-file-existing-other-name find-file-visit-truename)
+ (setq buf (or same-truename same-number)))
(if buf
(or nowarn
(verify-visited-file-modtime buf)
(set-buffer buf)
(revert-buffer t t)))))
(save-excursion
- (let* ((link-name (car (file-attributes filename)))
- (linked-buf (and (stringp link-name)
- (get-file-buffer link-name))))
- (if (bufferp linked-buf)
- (message "Symbolic link to file in buffer %s"
- (buffer-name linked-buf))))
+;;; The truename stuff makes this obsolete.
+;;; (let* ((link-name (car (file-attributes filename)))
+;;; (linked-buf (and (stringp link-name)
+;;; (get-file-buffer link-name))))
+;;; (if (bufferp linked-buf)
+;;; (message "Symbolic link to file in buffer %s"
+;;; (buffer-name linked-buf))))
(setq buf (create-file-buffer filename))
(set-buffer buf)
(erase-buffer)
(while (and hooks
(not (funcall (car hooks))))
(setq hooks (cdr hooks))))))
+ ;; Find the file's truename, and maybe use that as visited name.
+ (setq buffer-file-truename (abbreviate-file-name truename))
+ (setq buffer-file-number number)
+ (if find-file-visit-truename (setq filename buffer-file-truename))
;; Set buffer's default directory to that of the file.
(setq default-directory (file-name-directory filename))
;; Turn off backup files for certain file names. Since
(after-find-file error (not nowarn))))
buf)))
\f
-(defun after-find-file (&optional error warn)
+(defun after-find-file (&optional error warn noauto)
"Called after finding a file and by the default revert function.
Sets buffer mode, parses local variables.
-Optional args ERROR and WARN: ERROR non-nil means there was an
+Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
error in reading the file. WARN non-nil means warn if there
exists an auto-save file more recent than the visited file.
+NOAUTO means don't mess with auto-save mode.
Finishes by calling the functions in `find-file-hooks'."
(setq buffer-read-only (not (file-writable-p buffer-file-name)))
(if noninteractive
"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
- "File not found and directory doesn't exist"))))
+ (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-dir RET RET to create the directory"
+ "Use C-u M-x make-dir RET RET to create directory and its parents")))))
(if msg
(progn
(message msg)
(or not-serious (sit-for 1 nil t)))))
- (if auto-save-default
+ (if (and auto-save-default (not noauto))
(auto-save-mode t)))
(normal-mode t)
(mapcar 'funcall find-file-hooks))
(error (message "File mode specification error: %s"
(prin1-to-string err))))
(condition-case err
- (hack-local-variables (not find-file))
+ (let ((enable-local-variables (or (not find-file)
+ enable-local-variables)))
+ (hack-local-variables))
(error (message "File local-variables error: %s"
(prin1-to-string err)))))
-;(defvar auto-mode-alist ...) now in loaddefs.el
+(defvar auto-mode-alist (mapcar 'purecopy
+ '(("\\.text\\'" . text-mode)
+ ("\\.c\\'" . c-mode)
+ ("\\.h\\'" . c-mode)
+ ("\\.tex\\'" . TeX-mode)
+ ("\\.ltx\\'" . LaTeX-mode)
+ ("\\.el\\'" . emacs-lisp-mode)
+ ("\\.mm\\'" . nroff-mode)
+ ("\\.me\\'" . nroff-mode)
+ ("\\.scm\\'" . scheme-mode)
+ ("\\.l\\'" . lisp-mode)
+ ("\\.lisp\\'" . lisp-mode)
+ ("\\.f\\'" . fortran-mode)
+ ("\\.for\\'" . fortran-mode)
+ ("\\.mss\\'" . scribe-mode)
+ ("\\.pl\\'" . prolog-mode)
+ ("\\.cc\\'" . c++-mode)
+ ("\\.C\\'" . c++-mode)
+;;; Less common extensions come here
+;;; so more common ones above are found faster.
+ ("\\.s\\'" . asm-mode)
+ ("ChangeLog\\'" . change-log-mode)
+ ("ChangeLog.[0-9]+\\'" . change-log-mode)
+ ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
+;; The following should come after the ChangeLog pattern
+;; for the sake of ChangeLog.1, etc.
+ ("\\.[12345678]\\'" . nroff-mode)
+ ("\\.TeX\\'" . TeX-mode)
+ ("\\.sty\\'" . LaTeX-mode)
+ ("\\.bbl\\'" . LaTeX-mode)
+ ("\\.bib\\'" . bibtex-mode)
+ ("\\.article\\'" . text-mode)
+ ("\\.letter\\'" . text-mode)
+ ("\\.texinfo\\'" . texinfo-mode)
+ ("\\.texi\\'" . texinfo-mode)
+ ("\\.lsp\\'" . lisp-mode)
+ ("\\.awk\\'" . awk-mode)
+ ("\\.prolog\\'" . prolog-mode)
+ ;; Mailer puts message to be edited in
+ ;; /tmp/Re.... or Message
+ ("^/tmp/Re" . text-mode)
+ ("/Message[0-9]*\\'" . text-mode)
+ ;; some news reader is reported to use this
+ ("^/tmp/fol/" . text-mode)
+ ("\\.y\\'" . c-mode)
+ ("\\.oak\\'" . scheme-mode)
+ ("\\.scm.[0-9]*\\'" . scheme-mode)
+ ;; .emacs following a directory delimiter
+ ;; in either Unix or VMS syntax.
+ ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode)
+ ("\\.ml\\'" . lisp-mode)))
+ "\
+Alist of filename patterns vs corresponding major mode functions.
+Each element looks like (REGEXP . FUNCTION).
+Visiting a file whose name matches REGEXP causes FUNCTION to be called.")
+
(defun set-auto-mode ()
"Select major mode appropriate for current buffer.
-May base decision on visited file name (see variable `auto-mode-alist')
-or on buffer contents (-*- line or local variables spec), but does not look
-for the \"mode:\" local variable. For that, use `hack-local-variables'."
+This checks for a -*- mode tag in the buffer's text, or
+compares the filename against the entries in auto-mode-alist. It does
+not check for the \"mode:\" local variable in the Local Variables
+section of the file; for that, use `hack-local-variables'.
+
+If `enable-local-variables' is nil, this function does not check for a
+-*- mode tag."
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
(let (beg end mode)
(save-excursion
(goto-char (point-min))
(skip-chars-forward " \t\n")
- (if (and (search-forward "-*-" (save-excursion (end-of-line) (point)) t)
+ (if (and enable-local-variables
+ (search-forward "-*-" (save-excursion (end-of-line) (point)) t)
(progn
(skip-chars-forward " \t")
(setq beg (point))
- (search-forward "-*-" (save-excursion (end-of-line) (point)) t))
+ (search-forward "-*-"
+ (save-excursion (end-of-line) (point))
+ t))
(progn
(forward-char -3)
(skip-chars-backward " \t")
(setq alist (cdr alist)))))))
(if mode (funcall mode))))
-(defun hack-local-variables (&optional force)
- "Parse (and bind or evaluate as appropriate) any local variables
-for current buffer."
+(defun hack-local-variables-prop-line ()
+ ;; Set local variables specified in the -*- line.
+ ;; Returns t if mode was set.
+ (save-excursion
+ (goto-char (point-min))
+ (skip-chars-forward " \t\n\r")
+ (let ((result '())
+ (end (save-excursion (end-of-line) (point)))
+ mode-p)
+ ;; Parse the -*- line into the `result' alist.
+ (cond ((not (search-forward "-*-" end t))
+ ;; doesn't have one.
+ nil)
+ ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
+ ;; Simple form: "-*- MODENAME -*-".
+ (setq result
+ (list (cons 'mode
+ (intern (buffer-substring
+ (match-beginning 1)
+ (match-end 1)))))))
+ (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"))
+ (goto-char (match-end 0))
+ (let ((key (intern (downcase (buffer-substring
+ (match-beginning 1)
+ (match-end 1)))))
+ (val (save-restriction
+ (narrow-to-region (point) end)
+ (read (current-buffer)))))
+ (setq result (cons (cons key val) result))
+ (skip-chars-forward " \t;")))
+ (setq result (nreverse result))))
+
+ ;; Mode is magic.
+ (let (mode)
+ (while (setq mode (assq 'mode result))
+ (setq mode-p t result (delq mode result))
+ (funcall (intern (concat (downcase (symbol-name (cdr mode)))
+ "-mode")))))
+
+ (if (and result
+ (or (eq enable-local-variables t)
+ (and enable-local-variables
+ (save-window-excursion
+ (switch-to-buffer (current-buffer))
+ (y-or-n-p (format "Set local variables as specified in -*- line of %s? "
+ (file-name-nondirectory buffer-file-name)))))))
+ (while result
+ (let ((key (car (car result)))
+ (val (cdr (car result))))
+ ;; 'mode has already been removed from this list.
+ (hack-one-local-variable key val))
+ (setq result (cdr result))))
+ mode-p)))
+
+(defun hack-local-variables ()
+ "Parse and put into effect this buffer's local variables spec."
+ (hack-local-variables-prop-line)
;; Look for "Local variables:" line in last page.
(save-excursion
(goto-char (point-max))
(search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
(if (let ((case-fold-search t))
(and (search-forward "Local Variables:" nil t)
- (or force (eq enable-local-variables t)
+ (or (eq enable-local-variables t)
(and enable-local-variables
(save-window-excursion
(switch-to-buffer (current-buffer))
(y-or-n-p (format "Set local variables as specified at end of %s? "
(file-name-nondirectory buffer-file-name))))))))
(let ((continue t)
- prefix prefixlen suffix beg)
+ prefix prefixlen suffix beg
+ (enable-local-eval enable-local-eval))
;; The prefix is what comes before "local variables:" in its line.
;; The suffix is what comes after "local variables:" in its line.
(skip-chars-forward " \t")
(setq prefix
(buffer-substring (point)
(progn (beginning-of-line) (point)))))
+
(if prefix (setq prefixlen (length prefix)
prefix (regexp-quote prefix)))
(if suffix (setq suffix (concat (regexp-quote suffix) "$")))
(or (if suffix (looking-at suffix) (eolp))
(error "Local variables entry is terminated incorrectly"))
;; Set the variable. "Variables" mode and eval are funny.
- (cond ((eq var 'mode)
- (funcall (intern (concat (downcase (symbol-name val))
- "-mode"))))
- ((eq var 'eval)
- (if (or (and ignore-local-eval (not force))
- (string= (user-login-name) "root"))
- (message "Ignoring `eval:' in file's local variables")
- (save-excursion (eval val))))
- (t (make-local-variable var)
- (set var val))))))))))
+ (hack-one-local-variable var val))))))))
+
+(defconst ignored-local-variables
+ '(enable-local-eval)
+ "Variables to be ignored in a file's local variable spec.")
+
+;; "Set" one variable in a local variables spec.
+;; A few variable names are treated specially.
+(defun hack-one-local-variable (var val)
+ (cond ((eq var 'mode)
+ (funcall (intern (concat (downcase (symbol-name val))
+ "-mode"))))
+ ((memq var ignored-local-variables)
+ nil)
+ ;; "Setting" eval means either eval it or do nothing.
+ ((eq var 'eval)
+ (if (and (not (string= (user-login-name) "root"))
+ (or (eq enable-local-eval t)
+ (and enable-local-eval
+ (save-window-excursion
+ (switch-to-buffer (current-buffer))
+ (save-excursion
+ (beginning-of-line)
+ (set-window-start (selected-window) (point)))
+ (setq enable-local-eval
+ (y-or-n-p (format "Process `eval' local variable in file %s? "
+ (file-name-nondirectory buffer-file-name))))))))
+ (save-excursion (eval val))
+ (message "Ignoring `eval:' in file's local variables")))
+ ;; Ordinary variable, really set it.
+ (t (make-local-variable var)
+ (set var val))))
+
\f
(defun set-visited-file-name (filename)
"Change name of file visited in current buffer to FILENAME.
(unlock-buffer)))
(setq buffer-file-name filename)
(if filename ; make buffer name reflect filename.
- (let ((new-name (file-name-nondirectory buffer-file-name))
- (old-name (buffer-name (current-buffer))))
+ (let ((new-name (file-name-nondirectory buffer-file-name)))
(if (string= new-name "")
(error "Empty file name"))
(if (eq system-type 'vax-vms)
(setq new-name (downcase new-name)))
(setq default-directory (file-name-directory buffer-file-name))
- (and (get-buffer new-name)
- (setq new-name
- (buffer-name (create-file-buffer buffer-file-name)))
- (kill-buffer new-name))
- (rename-buffer new-name)
- (if (string= (prog1 (setq new-name (buffer-name (create-file-buffer
- buffer-file-name)))
- (kill-buffer new-name))
- old-name)
- (rename-buffer old-name))))
+ (rename-buffer new-name t)))
(setq buffer-backed-up nil)
(clear-visited-file-modtime)
+ (if filename
+ (progn
+ (setq buffer-file-truename
+ (abbreviate-file-name (file-truename buffer-file-name)))
+ (if find-file-visit-truename
+ (setq buffer-file-name buffer-file-truename))
+ (setq buffer-file-number (nth 10 (file-attributes buffer-file-name))))
+ (setq buffer-file-truename nil buffer-file-number nil))
;; write-file-hooks is normally used for things like ftp-find-file
;; that visit things that are not local files as if they were files.
;; Changing to visit an ordinary local file instead should flush the hook.
(setq backup-inhibited t)))
;; If auto-save was not already on, turn it on if appropriate.
(if (not buffer-auto-save-file-name)
- (auto-save-mode (and buffer-file-name auto-save-default)))
+ (auto-save-mode (and buffer-file-name auto-save-default))
+ ;; If auto save is on, start using a new name.
+ ;; We deliberately don't rename or delete the old auto save
+ ;; for the old visited file name. This is because perhaps
+ ;; the user wants to save the new state and then compare with the
+ ;; previous state from the auto save file.
+ (setq buffer-auto-save-file-name
+ (make-auto-save-file-name)))
(if buffer-file-name
(set-buffer-modified-p t)))
;; ask the user to confirm now, before doing anything.
;; But don't actually delete til later.
(and targets
+ (or (eq trim-versions-without-asking t) (eq trim-versions-without-asking nil))
(or trim-versions-without-asking
(y-or-n-p (format "Delete excess backup versions of %s? "
real-file-name))))))
(let ((attr (file-attributes real-file-name)))
(or (nth 9 attr)
(/= (nth 2 attr) (user-uid))))))
- (copy-file real-file-name backupname t t)
-; rename-file should delete old backup.
-; (condition-case ()
-; (delete-file backupname)
-; (file-error nil))
+ (condition-case ()
+ (copy-file real-file-name backupname t t)
+ (file-error
+ ;; If copying fails because file BACKUPNAME
+ ;; is not writable, delete that file and try again.
+ (if (and (file-exists-p backupname)
+ (not (file-writable-p backupname)))
+ (delete-file backupname))
+ (copy-file real-file-name backupname t t)))
+ ;; rename-file should delete old backup.
(rename-file real-file-name backupname t)
(setq setmodes (file-modes backupname)))
(file-error
(setq backupname (expand-file-name "~/%backup%~"))
(message "Cannot write backup file; backing up in ~/%%backup%%~")
(sleep-for 1)
- (copy-file real-file-name backupname t t)))
+ (condition-case ()
+ (copy-file real-file-name backupname t t)
+ (file-error
+ ;; If copying fails because file BACKUPNAME
+ ;; is not writable, delete that file and try again.
+ (if (and (file-exists-p backupname)
+ (not (file-writable-p backupname)))
+ (delete-file backupname))
+ (copy-file real-file-name backupname t t)))))
(setq buffer-backed-up t)
;; Now delete the old versions, if desired.
(if delete-old-versions
setmodes)
(file-error nil)))))
-(defun file-name-sans-versions (name)
+(defun file-name-sans-versions (name &optional keep-backup-version)
"Return FILENAME sans backup versions or strings.
This is a separate procedure so your site-init or startup file can
-redefine it."
- (substring name 0
- (if (eq system-type 'vax-vms)
- ;; VMS version number is (a) semicolon, optional
- ;; sign, zero or more digits or (b) period, option
- ;; sign, zero or more digits, provided this is the
- ;; second period encountered outside of the
- ;; device/directory part of the file name.
- (or (string-match ";[---+]?[0-9]*\\'" name)
- (if (string-match "\\.[^]>:]*\\(\\.[---+]?[0-9]*\\)\\'"
- name)
- (match-beginning 1))
- (length name))
- (or (string-match "\\.~[0-9]+~\\'" name)
- (string-match "~\\'" name)
- (length name)))))
+redefine it.
+If the optional argument KEEP-BACKUP-VERSION is non-nil,
+we do not remove backup version numbers, only true file version numbers."
+ (let ((handler (find-file-name-handler name)))
+ (if handler
+ (funcall handler 'file-name-sans-versions name keep-backup-version)
+ (substring name 0
+ (if (eq system-type 'vax-vms)
+ ;; VMS version number is (a) semicolon, optional
+ ;; sign, zero or more digits or (b) period, option
+ ;; sign, zero or more digits, provided this is the
+ ;; second period encountered outside of the
+ ;; device/directory part of the file name.
+ (or (string-match ";[---+]?[0-9]*\\'" name)
+ (if (string-match "\\.[^]>:]*\\(\\.[---+]?[0-9]*\\)\\'"
+ name)
+ (match-beginning 1))
+ (length name))
+ (if keep-backup-version
+ (length name)
+ (or (string-match "\\.~[0-9]+~\\'" name)
+ (string-match "~\\'" name)
+ (length name))))))))
(defun make-backup-file-name (file)
"Create the non-numeric backup file name for FILE.
You may need to redefine `file-name-sans-versions' as well."
(string-match "~$" file))
+;; This is used in various files.
+;; The usage of bv-length is not very clean,
+;; but I can't see a good alternative,
+;; so as of now I am leaving it alone.
+(defun backup-extract-version (fn)
+ "Given the name of a numeric backup file, return the backup number.
+Uses the free variable `bv-length', whose value should be
+the index in the name where the version number begins."
+ (if (and (string-match "[0-9]+~$" fn bv-length)
+ (= (match-beginning 0) bv-length))
+ (string-to-int (substring fn bv-length -1))
+ 0))
+
;; I believe there is no need to alter this behavior for VMS;
;; since backup files are not made on VMS, it should not get called.
(defun find-backup-file-name (fn)
(possibilities (file-name-all-completions
base-versions
(file-name-directory fn)))
- (versions (sort (mapcar 'backup-extract-version possibilities)
+ (versions (sort (mapcar
+ (function backup-extract-version)
+ possibilities)
'<))
- (high-water-mark (apply 'max (cons 0 versions)))
+ (high-water-mark (apply 'max 0 versions))
(deserve-versions-p
(or version-control
(> high-water-mark 0)))
(rplacd (nthcdr (1- number-to-delete) v) ())
v))))))))
-(defun backup-extract-version (fn)
- (if (and (string-match "[0-9]+~$" fn bv-length)
- (= (match-beginning 0) bv-length))
- (string-to-int (substring fn bv-length -1))
- 0))
-
(defun file-nlinks (filename)
"Return number of names file FILENAME has."
(car (cdr (file-attributes filename))))
+
+(defun file-relative-name-1 (directory)
+ (cond ((string= directory "/")
+ filename)
+ ((string-match (concat "^" (regexp-quote directory))
+ filename)
+ (substring filename (match-end 0)))
+ (t
+ (file-relative-name-1
+ (file-name-directory (substring directory 0 -1))))))
+
+(defun file-relative-name (filename &optional directory)
+ "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
+ (setq filename (expand-file-name filename)
+ directory (file-name-as-directory (if directory
+ (expand-file-name directory)
+ default-directory)))
+ (file-relative-name-1 directory))
\f
(defun save-buffer (&optional args)
"Save current buffer in visited file if modified. Versions described below.
(save-excursion
(goto-char (point-max))
(insert ?\n)))
- (let ((hooks write-file-hooks)
+ (let ((hooks (append write-contents-hooks write-file-hooks))
(done nil))
(while (and hooks
(not (setq done (funcall (car hooks)))))
(or buffer-backed-up
(setq setmodes (backup-buffer)))
(if file-precious-flag
- ;; If file is precious, rename it away before
- ;; overwriting it.
- (let ((rename t)
- realname tempname temp)
- ;; Chase symlinks; rename the ultimate actual file.
- (setq realname buffer-file-name)
- (while (setq temp (file-symlink-p realname))
- (setq realname temp))
- (setq tempname (concat realname "#"))
- (condition-case ()
- (progn (rename-file realname tempname t)
- (setq setmodes (file-modes tempname)))
- (file-error (setq rename nil tempname nil)))
- (if (file-directory-p realname)
- (error "%s is a directory" realname))
+ ;; If file is precious, write temp name, then rename it.
+ (let ((dir (file-name-directory buffer-file-name))
+ (realname buffer-file-name)
+ tempname temp nogood i succeed)
+ (setq i 0)
+ (setq nogood t)
+ ;; Find the temporary name to write under.
+ (while nogood
+ (setq tempname (format "%s#tmp#%d" dir i))
+ (setq nogood (file-exists-p tempname))
+ (setq i (1+ i)))
(unwind-protect
(progn (clear-visited-file-modtime)
(write-region (point-min) (point-max)
- realname nil t)
- (setq rename nil))
- ;; If rename is still t, writing failed.
- ;; So rename the old file back to original name,
- (if rename
- (progn
- (rename-file tempname realname t)
- (clear-visited-file-modtime))
- ;; Otherwise we don't need the original file,
- ;; so flush it, if we still have it.
- ;; If rename failed due to name length restriction
- ;; then TEMPNAME is now nil.
- (if tempname
- (condition-case ()
- (delete-file tempname)
- (error nil))))))
+ tempname nil realname)
+ (setq succeed t))
+ ;; If writing the temp file fails,
+ ;; delete the temp file.
+ (or succeed (delete-file tempname)))
+ ;; We succeeded in writing the temp file,
+ ;; so rename it.
+ (rename-file tempname buffer-file-name t))
;; If file not writable, see if we can make it writable
;; temporarily while we write it.
;; But no need to do so if we have just backed it up
(set-file-modes buffer-file-name 511)))
(write-region (point-min) (point-max)
buffer-file-name nil t)))))
+ (setq buffer-file-number (nth 10 (file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
- (set-file-modes buffer-file-name setmodes)
+ (set-file-modes buffer-file-name setmodes)
(error nil))))
;; If the auto-save file was recent before this command,
;; delete it now.
(run-hooks 'after-save-hooks))
(message "(No changes need to be saved)")))
-
-(require 'map-ynp)
-
(defun save-some-buffers (&optional arg exiting)
"Save some modified file-visiting buffers. Asks user about each one.
-With argument, saves all with no questions."
+Optional argument (the prefix) non-nil means save all with no questions.
+Optional second argument EXITING means ask about certain non-file buffers
+ as well as about file buffers."
(interactive "P")
- (if (zerop (map-y-or-n-p
- (function
- (lambda (buffer)
- (and (buffer-modified-p buffer)
- (or
- (buffer-file-name buffer)
- (and exiting
- (save-excursion
- (set-buffer buffer)
- buffer-offer-save (> (buffer-size) 0))))
- (if arg
- t
- (if (buffer-file-name buffer)
- (format "Save file %s? "
- (buffer-file-name buffer))
- (format "Save buffer %s? "
- (buffer-name buffer)))))))
- (function
- (lambda (buffer)
- (save-excursion
+ (save-window-excursion
+ (if (zerop (map-y-or-n-p
+ (function
+ (lambda (buffer)
+ (and (buffer-modified-p buffer)
+ (or
+ (buffer-file-name buffer)
+ (and exiting
+ (progn
+ (set-buffer buffer)
+ (and buffer-offer-save (> (buffer-size) 0)))))
+ (if arg
+ t
+ (if (buffer-file-name buffer)
+ (format "Save file %s? "
+ (buffer-file-name buffer))
+ (format "Save buffer %s? "
+ (buffer-name buffer)))))))
+ (function
+ (lambda (buffer)
(set-buffer buffer)
- (save-buffer))))
- (buffer-list)
- '("buffer" "buffers" "save")))
- (message "(No files need saving)")))
+ (save-buffer)))
+ (buffer-list)
+ '("buffer" "buffers" "save")
+ (list (list ?\C-r (lambda (buf)
+ (view-buffer buf)
+ (setq view-exit-action
+ '(lambda (ignore)
+ (exit-recursive-edit)))
+ (recursive-edit)
+ ;; Return nil to ask about BUF again.
+ nil)
+ "display the current buffer"))
+ ))
+ (message "(No files need saving)"))))
\f
(defun not-modified (&optional arg)
"Mark current buffer as unmodified, not needing to be saved.
(kill-buffer new-buf)
(rename-buffer name)
(set-buffer-modified-p (buffer-modified-p)))) ; force mode line update
+
+(defun make-directory (dir &optional parents)
+ "Create the directory DIR and any nonexistent parent dirs."
+ (interactive "FMake directory: \nP")
+ (let ((handler (find-file-name-handler dir)))
+ (if handler
+ (funcall handler 'make-directory dir parents)
+ (if (not parents)
+ (make-directory-internal dir)
+ (let ((dir (directory-file-name (expand-file-name dir)))
+ create-list)
+ (while (not (file-exists-p dir))
+ (setq create-list (cons dir create-list)
+ dir (directory-file-name (file-name-directory dir))))
+ (while create-list
+ (make-directory-internal (car create-list))
+ (setq create-list (cdr create-list))))))))
\f
(put 'revert-buffer-function 'permanent-local t)
(defvar revert-buffer-function nil
Gets two args, first the nominal file name to use,
and second, t if reading the auto-save file.")
-(defun revert-buffer (&optional arg noconfirm)
+(defun revert-buffer (&optional check-auto noconfirm)
"Replace the buffer text with the text of the visited file on disk.
This undoes all changes since the file was visited or saved.
-If latest auto-save file is more recent than the visited file,
-asks user whether to use that instead.
-
-Optional first argument ARG means don't offer to use auto-save file.
-This is the prefix arg when called interactively.
+With a prefix argument, offer to revert from latest auto-save file, if
+that is more recent than the visited file.
+When called from lisp, this is the first argument, CHECK-AUTO; it is optional.
Optional second argument NOCONFIRM means don't ask for confirmation at all.
-If `revert-buffer-function' value is non-nil, it is called to do the work."
+If the value of `revert-buffer-function' is non-nil, it is called to
+do the work."
(interactive "P")
(if revert-buffer-function
- (funcall revert-buffer-function arg noconfirm)
+ (funcall revert-buffer-function (not check-auto) noconfirm)
(let* ((opoint (point))
- (auto-save-p (and (null arg) (recent-auto-save-p)
+ (auto-save-p (and check-auto (recent-auto-save-p)
buffer-auto-save-file-name
(file-readable-p buffer-auto-save-file-name)
(y-or-n-p
;; If file was backed up but has changed since,
;; we shd make another backup.
(and (not auto-save-p)
- (not (verify-visited-file-modtime))
+ (not (verify-visited-file-modtime (current-buffer)))
(setq buffer-backed-up nil))
;; Get rid of all undo records for this buffer.
(or (eq buffer-undo-list t)
(erase-buffer))
(insert-file-contents file-name (not auto-save-p))))
(goto-char (min opoint (point-max)))
- (after-find-file nil)
+ (after-find-file nil nil t)
t)))))
(defun recover-file (file)
(with-output-to-temp-buffer "*Directory*"
(buffer-disable-undo standard-output)
(call-process "ls" nil standard-output nil
- "-l" file file-name)))
+ (if (file-symlink-p file) "-lL" "-l")
+ file file-name)))
(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))
(erase-buffer)
(insert-file-contents file-name nil))
- (after-find-file nil))
+ (after-find-file nil nil t))
(t (error "Recover-file cancelled.")))))
(defun kill-some-buffers ()
\f
(defun auto-save-mode (arg)
"Toggle auto-saving of contents of current buffer.
-With ARG, turn auto-saving on if positive, else off."
+With prefix argument ARG, turn auto-saving on if positive, else off."
(interactive "P")
(setq buffer-auto-save-file-name
(and (if (null arg)
(princ "Directory ")
(princ dirname)
(terpri)
+ (save-excursion
+ (set-buffer "*Directory*")
+ (let ((wildcard (not (file-directory-p dirname))))
+ (insert-directory dirname switches wildcard (not wildcard)))))))
+
+(defvar insert-directory-program "ls"
+ "Absolute or relative name of the `ls' program used by `insert-directory'.")
+
+;; insert-directory
+;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
+;; FULL-DIRECTORY-P is nil.
+;; The single line of output must display FILE's name as it was
+;; given, namely, an absolute path name.
+;; - must insert exactly one line for each file if WILDCARD or
+;; FULL-DIRECTORY-P is t, plus one optional "total" line
+;; before the file lines, plus optional text after the file lines.
+;; Lines are delimited by "\n", so filenames containing "\n" are not
+;; allowed.
+;; File lines should display the basename.
+;; - must be consistent with
+;; - functions dired-move-to-filename, (these two define what a file line is)
+;; dired-move-to-end-of-filename,
+;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
+;; dired-insert-headerline
+;; dired-after-subdir-garbage (defines what a "total" line is)
+;; - variable dired-subdir-regexp
+(defun insert-directory (file switches &optional wildcard full-directory-p)
+ "Insert directory listing for of FILE, formatted according to SWITCHES.
+Leaves point after the inserted text.
+Optional third arg WILDCARD means treat FILE as shell wildcard.
+Optional fourth arg FULL-DIRECTORY-P means file is a directory and
+switches do not contain `d', so that a full listing is expected.
+
+This works by running a directory listing program
+whose name is in the variable `ls-program'.
+If WILDCARD, it also runs the shell specified by `shell-file-name'."
+ (let ((handler (find-file-name-handler file)))
+ (if handler
+ (funcall handler 'insert-directory file switches
+ wildcard full-directory-p)
(if (eq system-type 'vax-vms)
- (vms-read-directory dirname switches standard-output)
- (if (file-directory-p dirname)
- (save-excursion
- (set-buffer "*Directory*")
- (call-process "ls" nil standard-output nil switches
- (setq default-directory
- (file-name-as-directory dirname))))
- (let ((default-directory (file-name-directory dirname)))
- (if (file-exists-p default-directory)
- (call-process shell-file-name nil standard-output nil
- "-c" (concat "exec ls "
- switches " "
- (file-name-nondirectory dirname)))
- (princ "No such directory: ")
- (princ dirname)
- (terpri))))))))
+ (vms-read-directory file switches (current-buffer))
+ (if wildcard
+ (let ((default-directory (file-name-directory file)))
+ (call-process shell-file-name nil t nil
+ "-c" (concat insert-directory-program
+ " -d " switches " "
+ (file-name-nondirectory file))))
+;;; ;; Chase links till we reach a non-link.
+;;; (let (symlink)
+;;; (while (setq symlink (file-symlink-p file))
+;;; (setq file symlink)))
+ (call-process insert-directory-program nil t nil switches file))))))
(defun save-buffers-kill-emacs (&optional arg)
"Offer to save each buffer, then kill this Emacs process.
(let ((processes (process-list))
active)
(while processes
- (and (memq (process-status (car processes)) '(run stop))
+ (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)
(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
(define-key ctl-x-4-map "\C-f" 'find-file-other-window)
(define-key ctl-x-4-map "b" 'switch-to-buffer-other-window)
+(define-key ctl-x-4-map "\C-o" 'display-buffer)
+
+(define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame)
+(define-key ctl-x-5-map "f" 'find-file-other-frame)
+(define-key ctl-x-5-map "\C-f" 'find-file-other-frame)
+(define-key ctl-x-5-map "r" 'find-file-read-only-other-frame)
+
+;;; files.el ends here
HCoop / bpt / emacs.git / blobdiff