(U-000278B8): Apply new conventions for glyph granularity.
[chise/xemacs-chise.git.1] / lisp / files.el
index 8116b07..18ce0ae 100644 (file)
@@ -198,7 +198,7 @@ nil means make them for files that have some already.
 ;(defvar dired-kept-versions 2
 ;  "*When cleaning directory, number of versions to keep.")
 
-(defcustom delete-old-versions nil
+(defcustom delete-old-versions (when noninteractive 'leave)
   "*If t, delete excess backup versions silently.
 If nil, ask confirmation.  Any other value prevents any trimming."
   :type '(choice (const :tag "Delete" t)
@@ -376,7 +376,8 @@ and ignores this variable."
       (let ((name (copy-sequence filename))
            (start 0))
        ;; leave ':' if part of drive specifier
-       (if (eq (aref name 1) ?:)
+       (if (and (> (length name) 1)
+                (eq (aref name 1) ?:))
            (setq start 2))
        ;; destructively replace invalid filename characters with !
        (while (string-match "[?*:<>|\"\000-\037]" name start)
@@ -898,6 +899,7 @@ conversion, find-file-hooks, automatic uncompression, etc.
            (after-insert-file-functions nil)
            (coding-system-for-read 'binary)
            (coding-system-for-write 'binary)
+           (jka-compr-compression-info-list nil)
            (find-buffer-file-type-function
             (if (fboundp 'find-buffer-file-type)
                 (symbol-function 'find-buffer-file-type)
@@ -1146,9 +1148,11 @@ run `normal-mode' explicitly."
                  "File local-variables error: %s"
                  (error-message-string err))))))
 
-;; #### This variable sucks in the package model.  There should be a
-;; way for new packages to add their entries to auto-mode-alist in a
-;; clean way.  Per Abrahamsen suggested splitting auto-mode-alist to
+;; `auto-mode-alist' used to contain entries for modes in core and in packages.
+;; The applicable entries are now located in the corresponding modes in
+;; packages, the ones here are for core modes.  Ditto for
+;; `interpreter-mode-alist' below.
+;; Per Abrahamsen suggested splitting auto-mode-alist to
 ;; several distinct variables such as, in order of precedence,
 ;; `user-auto-mode-alist' for users, `package-auto-mode-alist' for
 ;; packages and `auto-mode-alist' (which might also be called
@@ -1157,82 +1161,20 @@ run `normal-mode' explicitly."
 
 (defvar auto-mode-alist
   '(("\\.te?xt\\'" . text-mode)
-    ("\\.[chi]\\'" . c-mode)
     ("\\.el\\'" . emacs-lisp-mode)
-    ("\\.\\(?:[CH]\\|cc\\|hh\\)\\'" . c++-mode)
-    ("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode)
-    ("\\.java\\'" . java-mode)
-    ("\\.idl\\'" . idl-mode)
-    ("\\.f\\(?:or\\)?\\'" . fortran-mode)
-    ("\\.F\\(?:OR\\)?\\'" . fortran-mode)
-    ("\\.[fF]90\\'" . f90-mode)
-;;; Less common extensions come here
-;;; so more common ones above are found faster.
-    ("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode)
-    ("\\.py\\'" . python-mode)
-    ("\\.texi\\(?:nfo\\)?\\'" . texinfo-mode)
-    ("\\.ad[abs]\\'" . ada-mode)
     ("\\.c?l\\(?:i?sp\\)?\\'" . lisp-mode)
-    ("\\.p\\(?:as\\)?\\'" . pascal-mode)
-    ("\\.ltx\\'" . latex-mode)
-    ("\\.[sS]\\'" . asm-mode)
-    ("[Cc]hange.?[Ll]og?\\(?:.[0-9]+\\)?\\'" . change-log-mode)
-    ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
-    ("\\.scm?\\(?:\\.[0-9]*\\)?\\'" . scheme-mode)
-    ("\\.e\\'" . eiffel-mode)
-    ("\\.mss\\'" . scribe-mode)
-    ("\\.m\\(?:[mes]\\|an\\)\\'" . nroff-mode)
-    ("\\.icn\\'" . icon-mode)
-    ("\\.\\(?:[ckz]?sh\\|shar\\)\\'" . sh-mode)
-    ("\\.[Pp][Rr][Oo]\\'" . idlwave-mode)
-    ("\\.si\\(v\\|eve\\)\\'" . sieve-mode)
-    ;; #### Unix-specific!
-    ("/\\.\\(?:bash_\\|z\\)?\\(profile\\|login\\|logout\\)\\'" . sh-mode)
-    ("/\\.\\(?:[ckz]sh\\|bash\\|tcsh\\|es\\|xinit\\|startx\\)rc\\'" . sh-mode)
-    ("/\\.\\(?:[kz]shenv\\|xsession\\)\\'" . sh-mode)
-    ("\\.m?spec$" .sh-mode)
-    ;; The following come after the ChangeLog pattern for the sake of
-    ;; ChangeLog.1, etc. and after the .scm.[0-9] pattern too.
-    ("\\.[123456789]\\'" . nroff-mode)
-    ("\\.[tT]e[xX]\\'" . tex-mode)
-    ("\\.\\(?:sty\\|cls\\|bbl\\)\\'" . latex-mode)
-    ("\\.bib\\'" . bibtex-mode)
     ("\\.article\\'" . text-mode)
     ("\\.letter\\'" . text-mode)
-    ("\\.\\(?:tcl\\|exp\\)\\'" . tcl-mode)
-    ("\\.wrl\\'" . vrml-mode)
-    ("\\.awk\\'" . awk-mode)
-    ("\\.prolog\\'" . prolog-mode)
-    ("\\.\\(?:arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode)
     ;; Mailer puts message to be edited in /tmp/Re.... or Message
     ;; #### Unix-specific!
     ("\\`/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)
-    ("\\.y\\'" . c-mode)
-    ("\\.lex\\'" . c-mode)
-    ("\\.m\\'" . objc-mode)
-    ("\\.oak\\'" . scheme-mode)
-    ("\\.[sj]?html?\\'" . html-mode)
-    ("\\.jsp\\'" . html-mode)
-    ("\\.xml\\'" . xml-mode)
-    ("\\.\\(?:sgml?\\|dtd\\)\\'" . sgml-mode)
-    ("\\.c?ps\\'" . postscript-mode)
     ;; .emacs following a directory delimiter in either Unix or
     ;; Windows syntax.
     ("[/\\][._].*emacs\\'" . emacs-lisp-mode)
-    ("\\.m4\\'" . autoconf-mode)
-    ("configure\\(\\.in\\|\\.ac\\)\\'" . autoconf-mode)
     ("\\.ml\\'" . lisp-mode)
-    ("\\.ma?ke?\\'" . makefile-mode)
-    ("\\(GNU\\)?[Mm]akefile\\(\\.\\|\\'\\)" . makefile-mode)
-    ("[./\\]X\\(defaults\\|environment\\|resources\\|modmap\\)\\'" . xrdb-mode)
-    ;; #### The following three are Unix-specific (but do we care?)
-    ("/app-defaults/" . xrdb-mode)
-    ("\\.[^/]*wm2?\\(?:rc\\)?\\'" . winmgr-mode)
-    ("\\.\\(?:jpe?g\\|JPE?G\\|png\\|PNG\\|gif\\|GIF\\|tiff?\\|TIFF?\\)\\'" . image-mode)
     )
 "Alist of filename patterns vs. corresponding major mode functions.
 Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
@@ -1245,17 +1187,7 @@ calling FUNCTION (if it's not nil), we delete the suffix that matched
 REGEXP and search the list again for another match.")
 
 (defvar interpreter-mode-alist
-  '(("^#!.*csh"          . sh-mode)
-    ("^#!.*\\b\\(scope\\|wish\\|tcl\\|tclsh\\|expect\\)" . tcl-mode)
-    ("^#!.*sh\\b" . sh-mode)
-    ("perl"   . perl-mode)
-    ("python" . python-mode)
-    ("awk\\b" . awk-mode)
-    ("rexx"   . rexx-mode)
-    ("scm\\|guile" . scheme-mode)
-    ("emacs" . emacs-lisp-mode)
-    ("make" . makefile-mode)
-    ("^:"     . sh-mode))
+  '(("emacs" . emacs-lisp-mode))
   "Alist mapping interpreter names to major modes.
 This alist is used to guess the major mode of a file based on the
 contents of the first line.  This line often contains something like:
@@ -1271,7 +1203,8 @@ with the name of the interpreter specified in the first line.
 If it matches, mode MODE is selected.")
 
 (defvar binary-file-regexps
-  '("\\.\\(?:bz2\\|elc\\|g\\(if\\|z\\)\\|jp\\(eg\\|g\\)\\|png\\|t\\(ar\\|gz\\|iff\\)\\|[Zo]\\)\\'")
+  (purecopy
+   '("\\.\\(?:bz2\\|elc\\|g\\(if\\|z\\)\\|jp\\(eg\\|g\\)\\|png\\|PNG\\|t\\(ar\\|gz\\|iff\\)\\|[Zo]\\)\\'"))
   "List of regexps of filenames containing binary (non-text) data.")
 
 ;   (eval-when-compile
@@ -2641,7 +2574,9 @@ which are the arguments that `revert-buffer' received.")
 (defvar revert-buffer-insert-file-contents-function nil
   "Function to use to insert contents when reverting this buffer.
 Gets two args, first the nominal file name to use,
-and second, t if reading the auto-save file.")
+and second, t if reading the auto-save file.
+If the current buffer contents are to be discarded, the function must do
+so itself.")
 
 (defvar before-revert-hook nil
   "Normal hook for `revert-buffer' to run before reverting.
@@ -2666,10 +2601,10 @@ 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.
 
-This command also works for special buffers that contain text which
-doesn't come from a file, but reflects some other data base instead:
-for example, Dired buffers and buffer-list buffers.  In these cases,
-it reconstructs the buffer contents from the appropriate data base.
+This command also refreshes certain special buffers that contain text
+which doesn't come from a file, but reflects some other data base
+instead: for example, Dired buffers and buffer-list buffers.  This is
+implemented by having the modes set `revert-buffer-function'.
 
 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
@@ -2681,13 +2616,17 @@ Optional second argument NOCONFIRM means don't ask for confirmation at
 all.
 
 Optional third argument PRESERVE-MODES non-nil means don't alter
-the files modes.  Normally we reinitialize them using `normal-mode'.
+the buffer's modes.  Otherwise, reinitialize them using `normal-mode'.
 
 If the value of `revert-buffer-function' is non-nil, it is called to
 do all the work for this command.  Otherwise, the hooks
 `before-revert-hook' and `after-revert-hook' are run at the beginning
 and the end, and if `revert-buffer-insert-file-contents-function' is
-non-nil, it is called instead of rereading visited file contents."
+non-nil, it is called instead of rereading visited file contents.
+
+If the buffer-modified flag is nil, and we are not reverting from an
+auto-save file, then compare the contents of the buffer and the file.
+Revert only if they differ."
 
   ;; 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
@@ -2699,6 +2638,9 @@ non-nil, it is called instead of rereading visited file contents."
   (if revert-buffer-function
       (funcall revert-buffer-function ignore-auto noconfirm)
     (let* ((opoint (point))
+          (newbuf nil)
+          (found nil)
+          (delay-prompt nil)
           (auto-save-p (and (not ignore-auto)
                              (recent-auto-save-p)
                             buffer-auto-save-file-name
@@ -2712,62 +2654,121 @@ non-nil, it is called instead of rereading visited file contents."
             (error "Buffer does not seem to be associated with any file"))
            ((or noconfirm
                 (and (not (buffer-modified-p))
-                     (let (found)
-                       (dolist (rx revert-without-query found)
-                         (when (string-match rx file-name)
-                           (setq found t)))))
+                     (dolist (rx revert-without-query found)
+                       (when (string-match rx file-name)
+                         (setq found t))))
+                ;; If we will call revert-buffer-internal, delay prompting
+                (and (not auto-save-p)
+                     (not (buffer-modified-p))
+                     (setq delay-prompt t))
                 (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 should make another backup.
-            (and (not auto-save-p)
-                 (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)
-                (setq buffer-undo-list nil))
-            ;; Effectively copy the after-revert-hook status,
-            ;; since after-find-file will clobber it.
-            (let ((global-hook (default-value 'after-revert-hook))
-                  (local-hook-p (local-variable-p 'after-revert-hook
-                                                  (current-buffer)))
-                  (local-hook (and (local-variable-p 'after-revert-hook
-                                                     (current-buffer))
-                                   after-revert-hook)))
-              (let (buffer-read-only
-                    ;; Don't make undo records for the reversion.
-                    (buffer-undo-list t))
-                (if revert-buffer-insert-file-contents-function
-                    (funcall revert-buffer-insert-file-contents-function
-                             file-name auto-save-p)
-                  (if (not (file-exists-p file-name))
-                      (error "File %s no longer exists!" file-name))
-                  ;; Bind buffer-file-name to nil
-                  ;; so that we don't try to lock the file.
-                  (let ((buffer-file-name nil))
-                    (or auto-save-p
-                        (unlock-buffer)))
-                  (widen)
-                  (insert-file-contents file-name (not auto-save-p)
-                                        nil nil t)))
-              (goto-char (min opoint (point-max)))
-              ;; Recompute the truename in case changes in symlinks
-              ;; have changed the truename.
-              ;XEmacs: already done by insert-file-contents
-              ;;(setq buffer-file-truename
-                    ;;(abbreviate-file-name (file-truename buffer-file-name)))
-              (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
-                  (progn
-                    (make-local-variable 'revert-buffer-internal-hook)
-                    (setq revert-buffer-internal-hook local-hook))
-                (kill-local-variable 'revert-buffer-internal-hook))
-              (run-hooks 'revert-buffer-internal-hook))
+            (cond ((or auto-save-p
+                       (buffer-modified-p)
+                       ;; Do we need to do expensive reversion?  Compare ...
+                       (and (setq newbuf (revert-buffer-internal
+                                          file-name))
+                            ;; ... and if different, prompt
+                            (or noconfirm found
+                                (and delay-prompt
+                                     (yes-or-no-p 
+                                      (format "Revert buffer from file %s? "
+                                              file-name))))))
+                   ;; If file was backed up but has changed since,
+                   ;; we should make another backup.
+                   (and (not auto-save-p)
+                        (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)
+                       (setq buffer-undo-list nil))
+                   ;; Effectively copy the after-revert-hook status,
+                   ;; since after-find-file will clobber it.
+                   (let ((global-hook (default-value 'after-revert-hook))
+                         (local-hook-p (local-variable-p 'after-revert-hook
+                                                         (current-buffer)))
+                         (local-hook (and (local-variable-p 'after-revert-hook
+                                                            (current-buffer))
+                                          after-revert-hook)))
+                     (let (buffer-read-only
+                           ;; Don't make undo records for the reversion.
+                           (buffer-undo-list t))
+                       (if revert-buffer-insert-file-contents-function
+                           (funcall revert-buffer-insert-file-contents-function
+                                    file-name auto-save-p)
+                         (if (not (file-exists-p file-name))
+                             (error "File %s no longer exists!" file-name))
+                         ;; Bind buffer-file-name to nil
+                         ;; so that we don't try to lock the file.
+                         (let ((buffer-file-name nil))
+                           (or auto-save-p
+                               (unlock-buffer)))
+                         (widen)
+                         (insert-file-contents file-name (not auto-save-p)
+                                               nil nil t)))
+                     (goto-char (min opoint (point-max)))
+                     ;; Recompute the truename in case changes in symlinks
+                     ;; have changed the truename.
+                     ;;XEmacs: already done by insert-file-contents
+                     ;;(setq buffer-file-truename
+                     ;;(abbreviate-file-name (file-truename buffer-file-name)))
+                     (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
+                         (progn
+                           (make-local-variable 'revert-buffer-internal-hook)
+                           (setq revert-buffer-internal-hook local-hook))
+                       (kill-local-variable 'revert-buffer-internal-hook))
+                     (run-hooks 'revert-buffer-internal-hook)))
+                  ((null newbuf)
+                   ;; The resultant buffer is identical, alter
+                   ;; modtime, update mods and exit
+                   (set-visited-file-modtime)
+                   (after-find-file nil nil t t t)
+                   ;; We preserved modes above so fixup the local
+                   ;; variables manually
+                   (condition-case err
+                       (hack-local-variables)
+                     (error (lwarn 'local-variables 'warning
+                              "File local-variables error: %s"
+                              (error-message-string err)))))
+                  (t t))
             t)))))
 
+;; #### something like `revert-buffer-compare-with-file' is a better name
+;; #### why is the argument optional?
+(defun revert-buffer-internal (&optional file-name)
+  "Read contents of FILE-NAME into a buffer, and compare to current buffer.
+Return nil if identical, and the new buffer if different."
+
+  (let* ((newbuf (get-buffer-create " *revert*"))
+        bmin bmax)
+    (save-excursion
+      (set-buffer newbuf)
+      (let (buffer-read-only
+           (buffer-undo-list t)
+           after-change-function
+           after-change-functions
+           before-change-function
+           before-change-functions)
+       (if revert-buffer-insert-file-contents-function
+           (funcall revert-buffer-insert-file-contents-function
+                    file-name nil)
+         (if (not (file-exists-p file-name))
+             (error "File %s no longer exists!" file-name))
+         (widen)
+         (insert-file-contents file-name nil nil nil t)
+         (setq bmin (point-min)
+               bmax (point-max)))))
+    (if (not (and (eq bmin (point-min))
+                 (eq bmax (point-max))
+                 (eq (compare-buffer-substrings 
+                      newbuf bmin bmax (current-buffer) bmin bmax) 0)))
+       newbuf
+      (and (kill-buffer newbuf) nil))))
+
 (defun recover-file (file)
   "Visit file FILE, but get contents from its last auto-save file."
   ;; Actually putting the file name in the minibuffer should be used