comparison lisp/files.el @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 7d59cb494b73
children a86b2b5e0111
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
792 (setq filename 792 (setq filename
793 (concat (cdr (car tail)) (substring filename (match-end 0))))) 793 (concat (cdr (car tail)) (substring filename (match-end 0)))))
794 (setq tail (cdr tail)))) 794 (setq tail (cdr tail))))
795 (when hack-homedir 795 (when hack-homedir
796 ;; Compute and save the abbreviated homedir name. 796 ;; Compute and save the abbreviated homedir name.
797 ;; We defer computing this until the first time it's needed, to 797 ;; We defer computing this until the first time it's needed,
798 ;; give time for directory-abbrev-alist to be set properly. 798 ;; to give time for directory-abbrev-alist to be set properly.
799 ;; We include a slash at the end, to avoid spurious matches 799 ;; We include the separator at the end, to avoid spurious
800 ;; such as `/usr/foobar' when the home dir is `/usr/foo'. 800 ;; matches such as `/usr/foobar' when the home dir is
801 ;; `/usr/foo'.
801 (or abbreviated-home-dir 802 (or abbreviated-home-dir
802 (setq abbreviated-home-dir 803 (setq abbreviated-home-dir
803 (let ((abbreviated-home-dir "$foo")) 804 (let ((abbreviated-home-dir "$foo"))
804 (concat "\\`" (regexp-quote (abbreviate-file-name 805 (concat "\\`"
805 (expand-file-name "~"))) 806 (regexp-quote
806 "\\(/\\|\\'\\)")))) 807 (abbreviate-file-name (expand-file-name "~")))
808 "\\("
809 (regexp-quote (string directory-sep-char))
810 "\\|\\'\\)"))))
807 ;; If FILENAME starts with the abbreviated homedir, 811 ;; If FILENAME starts with the abbreviated homedir,
808 ;; make it start with `~' instead. 812 ;; make it start with `~' instead.
809 (if (and (string-match abbreviated-home-dir filename) 813 (if (and (string-match abbreviated-home-dir filename)
810 ;; If the home dir is just /, don't change it. 814 ;; If the home dir is just /, don't change it.
811 (not (and (= (match-end 0) 1) ;#### unix-specific 815 (not (and (= (match-end 0) 1)
812 (= (aref filename 0) ?/))) 816 (= (aref filename 0) directory-sep-char)))
813 (not (and (memq system-type '(ms-dos windows-nt)) 817 (not (and (eq system-type 'windows-nt)
814 (save-match-data 818 (save-match-data
815 (string-match "^[a-zA-Z]:/$" filename))))) 819 (string-match (concat "\\`[a-zA-Z]:"
820 (regexp-quote
821 (string directory-sep-char))
822 "\\'")
823 filename)))))
816 (setq filename 824 (setq filename
817 (concat "~" 825 (concat "~"
818 (substring filename 826 (match-string 1 filename)
819 (match-beginning 1) (match-end 1))
820 (substring filename (match-end 0)))))) 827 (substring filename (match-end 0))))))
821 filename))) 828 filename)))
822 829
823 (defcustom find-file-not-true-dirname-list nil 830 (defcustom find-file-not-true-dirname-list nil
824 "*List of logical names for which visiting shouldn't save the true dirname." 831 "*List of logical names for which visiting shouldn't save the true dirname."
1155 ("\\.e\\'" . eiffel-mode) 1162 ("\\.e\\'" . eiffel-mode)
1156 ("\\.mss\\'" . scribe-mode) 1163 ("\\.mss\\'" . scribe-mode)
1157 ("\\.m\\(?:[mes]\\|an\\)\\'" . nroff-mode) 1164 ("\\.m\\(?:[mes]\\|an\\)\\'" . nroff-mode)
1158 ("\\.icn\\'" . icon-mode) 1165 ("\\.icn\\'" . icon-mode)
1159 ("\\.\\(?:[ckz]?sh\\|shar\\)\\'" . sh-mode) 1166 ("\\.\\(?:[ckz]?sh\\|shar\\)\\'" . sh-mode)
1167 ("\\.pro\\'" . idlwave-mode)
1160 ;; #### Unix-specific! 1168 ;; #### Unix-specific!
1161 ("/\\.\\(?:bash_\\|z\\)?\\(profile\\|login\||logout\\)\\'" . sh-mode) 1169 ("/\\.\\(?:bash_\\|z\\)?\\(profile\\|login\\|logout\\)\\'" . sh-mode)
1162 ("/\\.\\(?:[ckz]sh\\|bash\\|tcsh\\|es\\|xinit\\|startx\\)rc\\'" . sh-mode) 1170 ("/\\.\\(?:[ckz]sh\\|bash\\|tcsh\\|es\\|xinit\\|startx\\)rc\\'" . sh-mode)
1163 ("/\\.\\(?:[kz]shenv\\|xsession\\)\\'" . sh-mode) 1171 ("/\\.\\(?:[kz]shenv\\|xsession\\)\\'" . sh-mode)
1164 ;; The following come after the ChangeLog pattern for the sake of 1172 ;; The following come after the ChangeLog pattern for the sake of
1165 ;; ChangeLog.1, etc. and after the .scm.[0-9] pattern too. 1173 ;; ChangeLog.1, etc. and after the .scm.[0-9] pattern too.
1166 ("\\.[12345678]\\'" . nroff-mode) 1174 ("\\.[12345678]\\'" . nroff-mode)
1219 ("^#!.*sh\\b" . sh-mode) 1227 ("^#!.*sh\\b" . sh-mode)
1220 ("perl" . perl-mode) 1228 ("perl" . perl-mode)
1221 ("python" . python-mode) 1229 ("python" . python-mode)
1222 ("awk\\b" . awk-mode) 1230 ("awk\\b" . awk-mode)
1223 ("rexx" . rexx-mode) 1231 ("rexx" . rexx-mode)
1224 ("scm" . scheme-mode) 1232 ("scm\\|guile" . scheme-mode)
1233 ("emacs" . emacs-lisp-mode)
1234 ("make" . makefile-mode)
1225 ("^:" . sh-mode)) 1235 ("^:" . sh-mode))
1226 "Alist mapping interpreter names to major modes. 1236 "Alist mapping interpreter names to major modes.
1227 This alist is used to guess the major mode of a file based on the 1237 This alist is used to guess the major mode of a file based on the
1228 contents of the first line. This line often contains something like: 1238 contents of the first line. This line often contains something like:
1229 #!/bin/sh 1239 #!/bin/sh
1268 "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'. 1278 "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
1269 When checking `inhibit-first-line-modes-regexps', we first discard 1279 When checking `inhibit-first-line-modes-regexps', we first discard
1270 from the end of the file name anything that matches one of these regexps.") 1280 from the end of the file name anything that matches one of these regexps.")
1271 1281
1272 (defvar user-init-file 1282 (defvar user-init-file
1273 "" ; set by command-line 1283 nil ; set by command-line
1274 "File name including directory of user's initialization file.") 1284 "File name including directory of user's initialization file.")
1275 1285
1276 (defun set-auto-mode (&optional just-from-file-name) 1286 (defun set-auto-mode (&optional just-from-file-name)
1277 "Select major mode appropriate for current buffer. 1287 "Select major mode appropriate for current buffer.
1278 This checks for a -*- mode tag in the buffer's text, 1288 This checks for a -*- mode tag in the buffer's text,
1307 (keep-going t)) 1317 (keep-going t))
1308 (while keep-going 1318 (while keep-going
1309 (setq keep-going nil) 1319 (setq keep-going nil)
1310 (let ((alist auto-mode-alist) 1320 (let ((alist auto-mode-alist)
1311 (mode nil)) 1321 (mode nil))
1322
1312 ;; Find first matching alist entry. 1323 ;; Find first matching alist entry.
1324
1325 ;; #### This is incorrect. In NT, case sensitivity is a volume
1326 ;; property. For instance, NFS mounts *are* case sensitive.
1327 ;; Need internal function (file-name-case-sensitive f), F
1328 ;; being file or directory name. - kkm
1313 (let ((case-fold-search 1329 (let ((case-fold-search
1314 (memq system-type '(windows-nt)))) 1330 (eq system-type 'windows-nt)))
1315 (while (and (not mode) alist) 1331 (while (and (not mode) alist)
1316 (if (string-match (car (car alist)) name) 1332 (if (string-match (car (car alist)) name)
1317 (if (and (consp (cdr (car alist))) 1333 (if (and (consp (cdr (car alist)))
1318 (nth 2 (car alist))) 1334 (nth 2 (car alist)))
1319 (progn 1335 (progn
1867 (if backup-info 1883 (if backup-info
1868 (condition-case () 1884 (condition-case ()
1869 (let ((delete-old-versions 1885 (let ((delete-old-versions
1870 ;; If have old versions to maybe delete, 1886 ;; If have old versions to maybe delete,
1871 ;; ask the user to confirm now, before doing anything. 1887 ;; ask the user to confirm now, before doing anything.
1872 ;; But don't actually delete til later. 1888 ;; But don't actually delete till later.
1873 (and targets 1889 (and targets
1874 (or (eq delete-old-versions t) 1890 (or (eq delete-old-versions t)
1875 (eq delete-old-versions nil)) 1891 (eq delete-old-versions nil))
1876 (or delete-old-versions 1892 (or delete-old-versions
1877 (y-or-n-p (format "Delete excess backup versions of %s? " 1893 (y-or-n-p (format "Delete excess backup versions of %s? "
1985 ""))))) 2001 "")))))
1986 2002
1987 (defun make-backup-file-name (file) 2003 (defun make-backup-file-name (file)
1988 "Create the non-numeric backup file name for FILE. 2004 "Create the non-numeric backup file name for FILE.
1989 This is a separate function so you can redefine it for customization." 2005 This is a separate function so you can redefine it for customization."
1990 (if (eq system-type 'ms-dos) 2006 (concat file "~"))
1991 (let ((fn (file-name-nondirectory file)))
1992 (concat (file-name-directory file)
1993 (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
1994 (substring fn 0 (match-end 1)))
1995 ".bak"))
1996 (concat file "~")))
1997 2007
1998 (defun backup-file-name-p (file) 2008 (defun backup-file-name-p (file)
1999 "Return non-nil if FILE is a backup file name (numeric or not). 2009 "Return non-nil if FILE is a backup file name (numeric or not).
2000 This is a separate function so you can redefine it for customization. 2010 This is a separate function so you can redefine it for customization.
2001 You may need to redefine `file-name-sans-versions' as well." 2011 You may need to redefine `file-name-sans-versions' as well."
2002 (if (eq system-type 'ms-dos) 2012 (string-match "~\\'" file))
2003 (string-match "\\.bak\\'" file)
2004 (string-match "~\\'" file)))
2005 2013
2006 ;; This is used in various files. 2014 ;; This is used in various files.
2007 ;; The usage of bv-length is not very clean, 2015 ;; The usage of bv-length is not very clean,
2008 ;; but I can't see a good alternative, 2016 ;; but I can't see a good alternative,
2009 ;; so as of now I am leaving it alone. 2017 ;; so as of now I am leaving it alone.
2079 (let ((fname (expand-file-name filename))) 2087 (let ((fname (expand-file-name filename)))
2080 (setq directory (file-name-as-directory 2088 (setq directory (file-name-as-directory
2081 (expand-file-name (or directory default-directory)))) 2089 (expand-file-name (or directory default-directory))))
2082 ;; On Microsoft OSes, if FILENAME and DIRECTORY have different 2090 ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
2083 ;; drive names, they can't be relative, so return the absolute name. 2091 ;; drive names, they can't be relative, so return the absolute name.
2084 (if (and (memq system-type '(ms-dos windows-nt)) 2092 (if (and (eq system-type 'windows-nt)
2085 (not (string-equal (substring fname 0 2) 2093 (not (string-equal (substring fname 0 2)
2086 (substring directory 0 2)))) 2094 (substring directory 0 2))))
2087 filename 2095 filename
2088 (let ((ancestor ".") 2096 (let ((ancestor ".")
2089 (fname-dir (file-name-as-directory fname))) 2097 (fname-dir (file-name-as-directory fname)))
2209 (format "%s has changed since visited or saved. Save anyway? " 2217 (format "%s has changed since visited or saved. Save anyway? "
2210 (file-name-nondirectory buffer-file-name))) 2218 (file-name-nondirectory buffer-file-name)))
2211 (error "Save not confirmed")) 2219 (error "Save not confirmed"))
2212 (save-restriction 2220 (save-restriction
2213 (widen) 2221 (widen)
2214 (and (> (point-max) 1) 2222
2215 (/= (char-after (1- (point-max))) ?\n) 2223 ;; Add final newline if required. See `require-final-newline'.
2216 (not (and (eq selective-display t) 2224 (when (and (not (eq (char-before (point-max)) ?\n)) ; common case
2217 (= (char-after (1- (point-max))) ?\r))) 2225 (char-before (point-max)) ; empty buffer?
2218 (or (eq require-final-newline t) 2226 (not (and (eq selective-display t)
2219 (and require-final-newline 2227 (eq (char-before (point-max)) ?\r)))
2220 (y-or-n-p 2228 (or (eq require-final-newline t)
2221 (format "Buffer %s does not end in newline. Add one? " 2229 (and require-final-newline
2222 (buffer-name))))) 2230 (y-or-n-p
2223 (save-excursion 2231 (format "Buffer %s does not end in newline. Add one? "
2224 (goto-char (point-max)) 2232 (buffer-name))))))
2225 (insert ?\n))) 2233 (save-excursion
2226 ;; 2234 (goto-char (point-max))
2235 (insert ?\n)))
2236
2227 ;; Run the write-file-hooks until one returns non-null. 2237 ;; Run the write-file-hooks until one returns non-null.
2228 ;; Bind after-save-hook to nil while running the 2238 ;; Bind after-save-hook to nil while running the
2229 ;; write-file-hooks so that if this function is called 2239 ;; write-file-hooks so that if this function is called
2230 ;; recursively (from inside a write-file-hook) the 2240 ;; recursively (from inside a write-file-hook) the
2231 ;; after-hooks will only get run once (from the 2241 ;; after-hooks will only get run once (from the
2678 (setq found t))))) 2688 (setq found t)))))
2679 (yes-or-no-p (format "Revert buffer from file %s? " 2689 (yes-or-no-p (format "Revert buffer from file %s? "
2680 file-name))) 2690 file-name)))
2681 (run-hooks 'before-revert-hook) 2691 (run-hooks 'before-revert-hook)
2682 ;; If file was backed up but has changed since, 2692 ;; If file was backed up but has changed since,
2683 ;; we shd make another backup. 2693 ;; we should make another backup.
2684 (and (not auto-save-p) 2694 (and (not auto-save-p)
2685 (not (verify-visited-file-modtime (current-buffer))) 2695 (not (verify-visited-file-modtime (current-buffer)))
2686 (setq buffer-backed-up nil)) 2696 (setq buffer-backed-up nil))
2687 ;; Get rid of all undo records for this buffer. 2697 ;; Get rid of all undo records for this buffer.
2688 (or (eq buffer-undo-list t) 2698 (or (eq buffer-undo-list t)
2749 (cond ((if (file-exists-p file) 2759 (cond ((if (file-exists-p file)
2750 (not (file-newer-than-file-p file-name file)) 2760 (not (file-newer-than-file-p file-name file))
2751 (not (file-exists-p file-name))) 2761 (not (file-exists-p file-name)))
2752 (error "Auto-save file %s not current" file-name)) 2762 (error "Auto-save file %s not current" file-name))
2753 ((save-window-excursion 2763 ((save-window-excursion
2754 (with-output-to-temp-buffer "*Directory*" 2764 (if (not (eq system-type 'windows-nt))
2755 (buffer-disable-undo standard-output) 2765 (with-output-to-temp-buffer "*Directory*"
2756 (call-process "ls" nil standard-output nil 2766 (buffer-disable-undo standard-output)
2757 (if (file-symlink-p file) "-lL" "-l") 2767 (call-process "ls" nil standard-output nil
2758 file file-name)) 2768 (if (file-symlink-p file) "-lL" "-l")
2769 file file-name)))
2759 (yes-or-no-p (format "Recover auto save file %s? " file-name))) 2770 (yes-or-no-p (format "Recover auto save file %s? " file-name)))
2760 (switch-to-buffer (find-file-noselect file t)) 2771 (switch-to-buffer (find-file-noselect file t))
2761 (let ((buffer-read-only nil)) 2772 (let ((buffer-read-only nil))
2762 (erase-buffer) 2773 (erase-buffer)
2763 (insert-file-contents file-name nil)) 2774 (insert-file-contents file-name nil))
3128 'insert-directory))) 3139 'insert-directory)))
3129 (if handler 3140 (if handler
3130 (funcall handler 'insert-directory file switches 3141 (funcall handler 'insert-directory file switches
3131 wildcard full-directory-p) 3142 wildcard full-directory-p)
3132 (cond 3143 (cond
3144 ;; #### mswindows-insert-directory should be called
3145 ;; nt-insert-directory - kkm.
3133 ((and (fboundp 'mswindows-insert-directory) 3146 ((and (fboundp 'mswindows-insert-directory)
3134 (eq system-type 'windows-nt)) 3147 (eq system-type 'windows-nt))
3135 (mswindows-insert-directory file switches wildcard full-directory-p)) 3148 (mswindows-insert-directory file switches wildcard full-directory-p))
3136 (t 3149 (t
3137 (if wildcard 3150 (if wildcard