X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Ffiles.el;h=18ce0ae17004913e22994f551a895128841bd017;hb=51cad40f88331f276c7a04b0c917af622276d32f;hp=8116b071106d1e1b54e1c5c9c942b06d60080f70;hpb=d8654f7c5ad0c04060008c6fbbd90add1f4537e3;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/files.el b/lisp/files.el index 8116b07..18ce0ae 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -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