Mercurial > hg > xemacs-beta

comparison lisp/files.el @ 819:6504113e7c2d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-04-25 18:03:23 by andyp] sync up windows branch from 21.4
author andyp
date Thu, 25 Apr 2002 18:04:24 +0000
parents 2b676dc88c66
children 6728e641994e
comparison
equal deleted inserted replaced
818:accc481aef34 819:6504113e7c2d
375 "Convert a standard file's name to something suitable for the current OS." 375 "Convert a standard file's name to something suitable for the current OS."
376 (if (eq system-type 'windows-nt) 376 (if (eq system-type 'windows-nt)
377 (let ((name (copy-sequence filename)) 377 (let ((name (copy-sequence filename))
378 (start 0)) 378 (start 0))
379 ;; leave ':' if part of drive specifier 379 ;; leave ':' if part of drive specifier
380 (if (eq (aref name 1) ?:) 380 (if (and (> (length name) 1)
381 (eq (aref name 1) ?:))
381 (setq start 2)) 382 (setq start 2))
382 ;; destructively replace invalid filename characters with ! 383 ;; destructively replace invalid filename characters with !
383 (while (string-match "[?*:<>|\"\000-\037]" name start) 384 (while (string-match "[?*:<>|\"\000-\037]" name start)
384 (aset name (match-beginning 0) ?!) 385 (aset name (match-beginning 0) ?!)
385 (setq start (match-end 0))) 386 (setq start (match-end 0)))
2807 2808
2808 If the value of `revert-buffer-function' is non-nil, it is called to 2809 If the value of `revert-buffer-function' is non-nil, it is called to
2809 do all the work for this command. Otherwise, the hooks 2810 do all the work for this command. Otherwise, the hooks
2810 `before-revert-hook' and `after-revert-hook' are run at the beginning 2811 `before-revert-hook' and `after-revert-hook' are run at the beginning
2811 and the end, and if `revert-buffer-insert-file-contents-function' is 2812 and the end, and if `revert-buffer-insert-file-contents-function' is
2812 non-nil, it is called instead of rereading visited file contents." 2813 non-nil, it is called instead of rereading visited file contents.
2814
2815 If the buffer has not been obviously modified, and no auto-save file
2816 exists, then `revert-buffer-internal' is
2817 called. `revert-buffer-internal' will not actually change the buffer
2818 at all if reversion would not cause any user-visible changes."
2813 2819
2814 ;; I admit it's odd to reverse the sense of the prefix argument, but 2820 ;; I admit it's odd to reverse the sense of the prefix argument, but
2815 ;; there is a lot of code out there which assumes that the first 2821 ;; there is a lot of code out there which assumes that the first
2816 ;; argument should be t to avoid consulting the auto-save file, and 2822 ;; argument should be t to avoid consulting the auto-save file, and
2817 ;; there's no straightforward way to encourage authors to notice a 2823 ;; there's no straightforward way to encourage authors to notice a
2819 ;; interface, but leaving the programmatic interface the same. 2825 ;; interface, but leaving the programmatic interface the same.
2820 (interactive (list (not current-prefix-arg))) 2826 (interactive (list (not current-prefix-arg)))
2821 (if revert-buffer-function 2827 (if revert-buffer-function
2822 (funcall revert-buffer-function ignore-auto noconfirm) 2828 (funcall revert-buffer-function ignore-auto noconfirm)
2823 (let* ((opoint (point)) 2829 (let* ((opoint (point))
2830 (newbuf nil)
2831 (delay-prompt nil)
2824 (auto-save-p (and (not ignore-auto) 2832 (auto-save-p (and (not ignore-auto)
2825 (recent-auto-save-p) 2833 (recent-auto-save-p)
2826 buffer-auto-save-file-name 2834 buffer-auto-save-file-name
2827 (file-readable-p buffer-auto-save-file-name) 2835 (file-readable-p buffer-auto-save-file-name)
2828 (y-or-n-p 2836 (y-or-n-p
2836 (and (not (buffer-modified-p)) 2844 (and (not (buffer-modified-p))
2837 (let (found) 2845 (let (found)
2838 (dolist (rx revert-without-query found) 2846 (dolist (rx revert-without-query found)
2839 (when (string-match rx file-name) 2847 (when (string-match rx file-name)
2840 (setq found t))))) 2848 (setq found t)))))
2849 ;; If we might perform an optimized revert then we
2850 ;; want to delay prompting in case we don't need to
2851 ;; do it at all
2852 (and (not auto-save-p)
2853 (not (buffer-modified-p))
2854 (setq delay-prompt t))
2841 (yes-or-no-p (format "Revert buffer from file %s? " 2855 (yes-or-no-p (format "Revert buffer from file %s? "
2842 file-name))) 2856 file-name)))
2843 (run-hooks 'before-revert-hook) 2857 (run-hooks 'before-revert-hook)
2844 ;; If file was backed up but has changed since, 2858 ;; Only perform our optimized revert if nothing obvious
2845 ;; we should make another backup. 2859 ;; has changed.
2846 (and (not auto-save-p) 2860 (cond ((or auto-save-p
2847 (not (verify-visited-file-modtime (current-buffer))) 2861 (buffer-modified-p)
2848 (setq buffer-backed-up nil)) 2862 (and (setq newbuf (revert-buffer-internal
2849 ;; Get rid of all undo records for this buffer. 2863 file-name))
2850 (or (eq buffer-undo-list t) 2864 (and delay-prompt
2851 (setq buffer-undo-list nil)) 2865 (yes-or-no-p
2852 ;; Effectively copy the after-revert-hook status, 2866 (format "Revert buffer from file %s? "
2853 ;; since after-find-file will clobber it. 2867 file-name)))))
2854 (let ((global-hook (default-value 'after-revert-hook)) 2868 ;; If file was backed up but has changed since,
2855 (local-hook-p (local-variable-p 'after-revert-hook 2869 ;; we should make another backup.
2856 (current-buffer))) 2870 (and (not auto-save-p)
2857 (local-hook (and (local-variable-p 'after-revert-hook 2871 (not (verify-visited-file-modtime (current-buffer)))
2858 (current-buffer)) 2872 (setq buffer-backed-up nil))
2859 after-revert-hook))) 2873 ;; Get rid of all undo records for this buffer.
2860 (let (buffer-read-only 2874 (or (eq buffer-undo-list t)
2861 ;; Don't make undo records for the reversion. 2875 (setq buffer-undo-list nil))
2862 (buffer-undo-list t)) 2876 ;; Effectively copy the after-revert-hook status,
2863 (if revert-buffer-insert-file-contents-function 2877 ;; since after-find-file will clobber it.
2864 (funcall revert-buffer-insert-file-contents-function 2878 (let ((global-hook (default-value 'after-revert-hook))
2865 file-name auto-save-p) 2879 (local-hook-p (local-variable-p 'after-revert-hook
2866 (if (not (file-exists-p file-name)) 2880 (current-buffer)))
2867 (error "File %s no longer exists!" file-name)) 2881 (local-hook (and (local-variable-p 'after-revert-hook
2868 ;; Bind buffer-file-name to nil 2882 (current-buffer))
2869 ;; so that we don't try to lock the file. 2883 after-revert-hook)))
2870 (let ((buffer-file-name nil)) 2884 (let (buffer-read-only
2871 (or auto-save-p 2885 ;; Don't make undo records for the reversion.
2872 (unlock-buffer))) 2886 (buffer-undo-list t))
2873 (widen) 2887 (if revert-buffer-insert-file-contents-function
2874 ;; When reading in an autosave, it's encoded using 2888 (funcall revert-buffer-insert-file-contents-function
2875 ;; `escape-quoted', so we need to use it. (It is always 2889 file-name auto-save-p)
2876 ;; safe to specify `escape-quoted': 2890 (if (not (file-exists-p file-name))
2877 ;; 2891 (error "File %s no longer exists!" file-name))
2878 ;; 1. If file-coding but no Mule, `escape-quoted' is 2892 ;; Bind buffer-file-name to nil
2879 ;; aliased to `binary'. 2893 ;; so that we don't try to lock the file.
2880 ;; 2. If no file-coding, all coding systems devolve into 2894 (let ((buffer-file-name nil))
2881 ;; `binary'. 2895 (or auto-save-p
2882 ;; 3. ASCII and ISO8859-1 are encoded the same in both 2896 (unlock-buffer)))
2883 ;; `binary' and `escape-quoted', so they will be 2897 (widen)
2884 ;; compatible for the most part.) 2898 ;; When reading in an autosave, it's encoded using
2885 ;; 2899 ;; `escape-quoted', so we need to use it. (It is always
2886 ;; Otherwise, use coding-system-for-read if explicitly 2900 ;; safe to specify `escape-quoted':
2887 ;; given (e.g. the "Revert Buffer with Specified 2901 ;;
2888 ;; Encoding" menu entries), or use the coding system 2902 ;; 1. If file-coding but no Mule, `escape-quoted' is
2889 ;; that the file was loaded as. 2903 ;; aliased to `binary'.
2890 (let* ((coding-system-for-read 2904 ;; 2. If no file-coding, all coding systems devolve into
2891 (if auto-save-p 'escape-quoted 2905 ;; `binary'.
2892 (or coding-system-for-read 2906 ;; 3. ASCII and ISO8859-1 are encoded the same in both
2893 buffer-file-coding-system-when-loaded))) 2907 ;; `binary' and `escape-quoted', so they will be
2894 ;; If the bfcs wasn't changed from its original 2908 ;; compatible for the most part.)
2895 ;; value (other than possible EOL change), then we 2909 ;;
2896 ;; should update it for the new coding system. 2910 ;; Otherwise, use coding-system-for-read if explicitly
2897 (should-update-bfcs 2911 ;; given (e.g. the "Revert Buffer with Specified
2898 (eq (coding-system-base 2912 ;; Encoding" menu entries), or use the coding system
2913 ;; that the file was loaded as.
2914 (let* ((coding-system-for-read
2915 (if auto-save-p 'escape-quoted
2916 (or coding-system-for-read
2917 buffer-file-coding-system-when-loaded)))
2918 ;; If the bfcs wasn't changed from its original
2919 ;; value (other than possible EOL change), then we
2920 ;; should update it for the new coding system.
2921 (should-update-bfcs
2922 (eq (coding-system-base
2923 buffer-file-coding-system-when-loaded)
2924 (coding-system-base
2925 buffer-file-coding-system)))
2926 (old-bfcs buffer-file-coding-system)
2927 ;; But if the EOL was changed, match it in the new
2928 ;; value of bfcs.
2929 (adjust-eol
2930 (and should-update-bfcs
2931 (not
2932 (eq (get-coding-system
2933 buffer-file-coding-system-when-loaded)
2934 (get-coding-system
2935 buffer-file-coding-system))))))
2936 (insert-file-contents file-name (not auto-save-p)
2937 nil nil t)
2938 (when should-update-bfcs
2939 (setq buffer-file-coding-system old-bfcs)
2940 (set-buffer-file-coding-system
2941 (if adjust-eol
2942 (coding-system-base
2943 buffer-file-coding-system-when-loaded)
2899 buffer-file-coding-system-when-loaded) 2944 buffer-file-coding-system-when-loaded)
2900 (coding-system-base 2945 (not adjust-eol))))))
2901 buffer-file-coding-system))) 2946 (goto-char (min opoint (point-max)))
2902 (old-bfcs buffer-file-coding-system) 2947 ;; Recompute the truename in case changes in symlinks
2903 ;; But if the EOL was changed, match it in the new 2948 ;; have changed the truename.
2904 ;; value of bfcs. 2949 ;;XEmacs: already done by insert-file-contents
2905 (adjust-eol 2950 ;;(setq buffer-file-truename
2906 (and should-update-bfcs 2951 ;;(abbreviate-file-name (file-truename buffer-file-name)))
2907 (not 2952 (after-find-file nil nil t t preserve-modes)
2908 (eq (get-coding-system 2953 ;; Run after-revert-hook as it was before we reverted.
2909 buffer-file-coding-system-when-loaded) 2954 (setq-default revert-buffer-internal-hook global-hook)
2910 (get-coding-system 2955 (if local-hook-p
2911 buffer-file-coding-system)))))) 2956 (progn
2912 (insert-file-contents file-name (not auto-save-p) 2957 (make-local-variable 'revert-buffer-internal-hook)
2913 nil nil t) 2958 (setq revert-buffer-internal-hook local-hook))
2914 (when should-update-bfcs 2959 (kill-local-variable 'revert-buffer-internal-hook))
2915 (setq buffer-file-coding-system old-bfcs) 2960 (run-hooks 'revert-buffer-internal-hook)))
2916 (set-buffer-file-coding-system 2961 ((null newbuf)
2917 (if adjust-eol 2962 ;; The resultant buffer is identical, alter
2918 (coding-system-base 2963 ;; modtime, update mods and exit
2919 buffer-file-coding-system-when-loaded) 2964 (set-visited-file-modtime)
2920 buffer-file-coding-system-when-loaded) 2965 (after-find-file nil nil t t t))
2921 (not adjust-eol)))))) 2966 (t t))
2922 (goto-char (min opoint (point-max)))
2923 ;; Recompute the truename in case changes in symlinks
2924 ;; have changed the truename.
2925 ;XEmacs: already done by insert-file-contents
2926 ;;(setq buffer-file-truename
2927 ;;(abbreviate-file-name (file-truename buffer-file-name)))
2928 (after-find-file nil nil t t preserve-modes)
2929 ;; Run after-revert-hook as it was before we reverted.
2930 (setq-default revert-buffer-internal-hook global-hook)
2931 (if local-hook-p
2932 (progn
2933 (make-local-variable 'revert-buffer-internal-hook)
2934 (setq revert-buffer-internal-hook local-hook))
2935 (kill-local-variable 'revert-buffer-internal-hook))
2936 (run-hooks 'revert-buffer-internal-hook))
2937 t))))) 2967 t)))))
2968
2969 (defun revert-buffer-internal (&optional file-name)
2970 (let* ((newbuf (get-buffer-create " *revert*"))
2971 bmin bmax)
2972 (save-excursion
2973 (set-buffer newbuf)
2974 (let (buffer-read-only
2975 (buffer-undo-list t)
2976 after-change-function
2977 after-change-functions
2978 before-change-function
2979 before-change-functions)
2980 (if revert-buffer-insert-file-contents-function
2981 (funcall revert-buffer-insert-file-contents-function
2982 file-name nil)
2983 (if (not (file-exists-p file-name))
2984 (error "File %s no longer exists!" file-name))
2985 (widen)
2986 (insert-file-contents file-name t nil nil t)
2987 (setq bmin (point-min)
2988 bmax (point-max)))))
2989 (if (not (and (eq bmin (point-min))
2990 (eq bmax (point-max))
2991 (eq (compare-buffer-substrings
2992 newbuf bmin bmax (current-buffer) bmin bmax) 0)))
2993 newbuf
2994 nil)))
2938 2995
2939 (defun recover-file (file) 2996 (defun recover-file (file)
2940 "Visit file FILE, but get contents from its last auto-save file." 2997 "Visit file FILE, but get contents from its last auto-save file."
2941 ;; Actually putting the file name in the minibuffer should be used 2998 ;; Actually putting the file name in the minibuffer should be used
2942 ;; only rarely. 2999 ;; only rarely.