Mercurial > hg > xemacs-beta
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 |