]> code.delx.au - gnu-emacs/blobdiff - lisp/files.el
(recover-file): Call auto-save-file-name-p correctly.
[gnu-emacs] / lisp / files.el
index 55cc671e8f19273475f6fc4313636c4184a627e4..5673aeac8b593b4d7426854f46407ee887216d5c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; files.el --- file input and output commands for Emacs
 
-;; Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 92, 93, 94 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 
@@ -545,7 +545,10 @@ Type \\[describe-variable] directory-abbrev-alist RET for more information."
                                                  
     ;; If FILENAME starts with the abbreviated homedir,
     ;; make it start with `~' instead.
-    (if (string-match abbreviated-home-dir filename)
+    (if (and (string-match abbreviated-home-dir filename)
+            ;; If the home dir is just /, don't change it.
+            (not (and (= (match-end 0) 1)
+                      (= (aref filename 0) ?/))))
        (setq filename
              (concat "~"
                      ;; If abbreviated-home-dir ends with a slash,
@@ -774,6 +777,8 @@ run `normal-mode' explicitly."
                                  ("\\.lisp\\'" . lisp-mode)
                                  ("\\.f\\'" . fortran-mode)
                                  ("\\.for\\'" . fortran-mode)
+                                 ("\\.p\\'" . pascal-mode)
+                                 ("\\.pas\\'" . pascal-mode)
                                  ("\\.mss\\'" . scribe-mode)
                                  ("\\.pl\\'" . prolog-mode)
                                  ("\\.cc\\'" . c++-mode)
@@ -784,8 +789,12 @@ run `normal-mode' explicitly."
 ;;;                              ("[Mm]akefile" . makefile-mode)
 ;;; Less common extensions come here
 ;;; so more common ones above are found faster.
+                                 ("\\.texinfo\\'" . texinfo-mode)
+                                 ("\\.texi\\'" . texinfo-mode)
                                  ("\\.s\\'" . asm-mode)
                                  ("ChangeLog\\'" . change-log-mode)
+                                 ("change.log\\'" . change-log-mode)
+                                 ("changelo\\'" . change-log-mode)
                                  ("ChangeLog.[0-9]+\\'" . change-log-mode)
                                  ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
 ;; The following should come after the ChangeLog pattern
@@ -797,8 +806,7 @@ run `normal-mode' explicitly."
                                  ("\\.bib\\'" . bibtex-mode)
                                  ("\\.article\\'" . text-mode)
                                  ("\\.letter\\'" . text-mode)
-                                 ("\\.texinfo\\'" . texinfo-mode)
-                                 ("\\.texi\\'" . texinfo-mode)
+                                 ("\\.tcl\\'" . tcl-mode)
                                  ("\\.lsp\\'" . lisp-mode)
                                  ("\\.awk\\'" . awk-mode)
                                  ("\\.prolog\\'" . prolog-mode)
@@ -819,19 +827,43 @@ run `normal-mode' explicitly."
                                  ;; .emacs following a directory delimiter
                                  ;; in either Unix or VMS syntax.
                                  ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode)
+                                 ;; _emacs following a directory delimiter
+                                 ;; in MsDos 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.")
+Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION).
+Visiting a file whose name matches REGEXP causes FUNCTION to be called.
+If the element has the form (REGEXP FUNCTION), then after calling
+FUNCTION, we delete the suffix that matched REGEXP and search the list
+again for another match.")
+
+(defconst interpreter-mode-alist
+  '(("perl" . perl-mode)
+    ("scope" . tcl-mode)
+    ("wish" . tcl-mode)
+    ("shell" . tcl-mode)
+    ("form" . tcl-mode)
+    ("tcl" . tcl-mode))
+  "Alist mapping interpreter names to major modes.
+This alist applies to files whose first line starts with `#!'.
+Each element looks like (INTERPRETER . MODE).
+The car of each element is compared with
+the name of the interpreter specified in the first line.
+If it matches, mode MODE is selected.")
 
 (defconst inhibit-local-variables-regexps '("\\.tar$")
   "List of regexps; if one matches a file name, don't look for local vars.")
 
+(defvar user-init-file
+  "" ; set by command-line
+  "File name including directory of user's initialization file.")
+
 (defun set-auto-mode ()
   "Select major mode appropriate for current buffer.
 This checks for a -*- mode tag in the buffer's text, or
-compares the filename against the entries in auto-mode-alist.  It does
+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'.
 
@@ -889,18 +921,46 @@ If `enable-local-variables' is nil, this function does not check for a
             (setq done t)))
       ;; If we didn't find a mode from a -*- line, try using the file name.
       (if (and (not done) buffer-file-name)
-         (let ((alist auto-mode-alist)
-               (name buffer-file-name)
-               mode)
-           (let ((case-fold-search (eq system-type 'vax-vms)))
-             ;; Remove backup-suffixes from file name.
-             (setq name (file-name-sans-versions name))
-             ;; Find first matching alist entry.
-             (while (and (not mode) alist)
-               (if (string-match (car (car alist)) name)
-                   (setq mode (cdr (car alist))))
-               (setq alist (cdr alist))))
-           (if mode (funcall mode)))))))
+         (let ((name buffer-file-name)
+               (case-fold-search (eq system-type 'vax-vms))
+               (keep-going t))
+           ;; Remove backup-suffixes from file name.
+           (setq name (file-name-sans-versions name))
+           (while keep-going
+             (setq keep-going nil)
+             (let ((alist auto-mode-alist)
+                   (mode nil))
+               ;; Find first matching alist entry.
+               (while (and (not mode) alist)
+                 (if (string-match (car (car alist)) name)
+                     (if (and (consp (cdr (car alist)))
+                              (nth 2 (car alist)))
+                         (progn
+                           (setq mode (car (cdr (car alist)))
+                                 name (substring name 0 (match-beginning 0))
+                                 keep-going t))
+                       (setq mode (cdr (car alist))
+                             keep-going nil)))
+                 (setq alist (cdr alist)))
+               (if mode
+                   (funcall mode)
+                 ;; If we can't deduce a mode from the file name,
+                 ;; look for an interpreter specified in the first line.
+                 (let ((interpreter
+                        (save-excursion
+                          (goto-char (point-min))
+                          (if (looking-at "#! *")
+                              (progn
+                                (goto-char (match-end 0))
+                                (buffer-substring (point)
+                                                  (progn (end-of-line) (point))))
+                            "")))
+                       elt)
+                   ;; Map interpreter name to a mode.
+                   (setq elt (assoc (file-name-nondirectory interpreter)
+                                    interpreter-mode-alist))
+                   (if elt
+                       (funcall (cdr elt))))))))))))
 
 (defun hack-local-variables-prop-line ()
   ;; Set local variables specified in the -*- line.
@@ -1052,7 +1112,7 @@ If `enable-local-variables' is nil, this function does not check for a
         nil)
        ;; "Setting" eval means either eval it or do nothing.
        ;; Likewise for setting hook variables.
-       ((or (eq var 'eval)
+       ((or (memq var '(eval file-name-handler-alist after-load-alist))
             (string-match "-hooks?$\\|-functions?$" (symbol-name var)))
         (if (and (not (string= (user-login-name) "root"))
                  (or (eq enable-local-eval t)
@@ -1279,13 +1339,21 @@ we do not remove backup version numbers, only true file version numbers."
 (defun make-backup-file-name (file)
   "Create the non-numeric backup file name for FILE.
 This is a separate function so you can redefine it for customization."
-  (concat file "~"))
+  (if (eq system-type 'ms-dos)
+      (let ((fn (file-name-nondirectory file)))
+       (concat (file-name-directory file)
+               (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
+                   (substring fn 0 (match-end 1)))
+               ".bak"))
+    (concat file "~")))
 
 (defun backup-file-name-p (file)
   "Return non-nil if FILE is a backup file name (numeric or not).
 This is a separate function so you can redefine it for customization.
 You may need to redefine `file-name-sans-versions' as well."
-  (string-match "~$" file))
+  (if (eq system-type 'ms-dos)
+      (string-match "\\.bak$" file)
+    (string-match "~$" file)))
 
 ;; This is used in various files.
 ;; The usage of bv-length is not very clean,
@@ -1347,22 +1415,16 @@ Value is a list whose car is the name for the backup file
   "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 (expand-file-name
                                           (or directory default-directory))))
-  (file-relative-name-1 directory))
+  (let ((ancestor ""))
+    (while (not (string-match (concat "^" (regexp-quote directory)) filename))
+      (setq directory (file-name-directory (substring directory 0 -1))
+           ancestor (concat "../" ancestor)))
+    (concat ancestor (substring filename (match-end 0)))))
 \f
 (defun save-buffer (&optional args)
   "Save current buffer in visited file if modified.  Versions described below.
@@ -1527,40 +1589,50 @@ Optional second argument EXITING means ask about certain non-file buffers
  as well as about file buffers."
   (interactive "P")
   (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")
-               (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)"))))
+    (let ((files-done
+          (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")
+           (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"))))
+         (abbrevs-done
+          (and save-abbrevs abbrevs-changed
+               (progn
+                 (if (or arg
+                         (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name)))
+                     (write-abbrev-file nil))
+                 ;; Don't keep bothering user if he says no.
+                 (setq abbrevs-changed nil)
+                 t))))
+      (or (> files-done 0) abbrevs-done
+         (message "(No files need saving)")))))
 \f
 (defun not-modified (&optional arg)
   "Mark current buffer as unmodified, not needing to be saved.
@@ -1671,7 +1743,7 @@ This undoes all changes since the file was visited or saved.
 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, the first argument is IGNORE-AUTO; only offer
+When called from lisp, The first argument is IGNORE-AUTO; only offer
 to revert from the auto-save file when this is nil.  Note that the
 sense of this argument is the reverse of the prefix argument, for the
 sake of backward compatibility.  IGNORE-AUTO is optional, defaulting
@@ -1681,7 +1753,10 @@ Optional second argument NOCONFIRM means don't ask for confirmation at
 all.
 
 If the value of `revert-buffer-function' is non-nil, it is called to
-do the work."
+do the work.
+
+The default revert function runs the hook `before-revert-hook' at the
+beginning and `after-revert-hook' at the end."
   ;; I admit it's odd to reverse the sense of the prefix argument, but
   ;; there is a lot of code out there which assumes that the first
   ;; argument should be t to avoid consulting the auto-save file, and
@@ -1706,6 +1781,7 @@ do the work."
            ((or noconfirm
                 (yes-or-no-p (format "Revert buffer from file %s? "
                                      file-name)))
+            (run-hooks 'before-revert-hook)
             ;; If file was backed up but has changed since,
             ;; we shd make another backup.
             (and (not auto-save-p)
@@ -1731,6 +1807,7 @@ do the work."
                 (insert-file-contents file-name (not auto-save-p))))
             (goto-char (min opoint (point-max)))
             (after-find-file nil nil t)
+            (run-hooks 'after-revert-hook)
             t)))))
 
 (defun recover-file (file)
@@ -1745,7 +1822,8 @@ do the work."
      (list (read-file-name "Recover file: "
                               file-dir nil nil file-name))))
   (setq file (expand-file-name file))
-  (if (auto-save-file-name-p file) (error "%s is an auto-save file" file))
+  (if (auto-save-file-name-p (file-name-nondirectory file))
+      (error "%s is an auto-save file" file))
   (let ((file-name (let ((buffer-file-name file))
                     (make-auto-save-file-name))))
     (cond ((not (file-newer-than-file-p file-name file))