Mercurial > hg > xemacs-beta
comparison lisp/files.el @ 272:c5d627a313b1 r21-0b34
Import from CVS: tag r21-0b34
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:28:48 +0200 |
parents | 966663fcf606 |
children | ca9a9ec9c1c1 |
comparison
equal
deleted
inserted
replaced
271:c7b7086b0a39 | 272:c5d627a313b1 |
---|---|
311 ;; to provide a new output method, but don't want to have to duplicate all | 311 ;; to provide a new output method, but don't want to have to duplicate all |
312 ;; of the backup file and file modes logic.that does not occur if one uses | 312 ;; of the backup file and file modes logic.that does not occur if one uses |
313 ;; a write-file-hook which returns non-nil. | 313 ;; a write-file-hook which returns non-nil. |
314 (put 'write-file-data-hooks 'permanent-local t) | 314 (put 'write-file-data-hooks 'permanent-local t) |
315 (defvar write-file-data-hooks nil | 315 (defvar write-file-data-hooks nil |
316 "List of functions to be called to put the bytes on disk. | 316 "List of functions to be called to put the bytes on disk. |
317 These functions receive the name of the file to write to as argument. | 317 These functions receive the name of the file to write to as argument. |
318 The default behavior is to call | 318 The default behavior is to call |
319 (write-region (point-min) (point-max) filename nil t) | 319 (write-region (point-min) (point-max) filename nil t) |
320 If one of them returns non-nil, the file is considered already written | 320 If one of them returns non-nil, the file is considered already written |
321 and the rest are not called. | 321 and the rest are not called. |
322 These hooks are considered to pertain to the visited file. | 322 These hooks are considered to pertain to the visited file. |
323 So this list is cleared if you change the visited file name. | 323 So this list is cleared if you change the visited file name. |
577 ; filename)) | 577 ; filename)) |
578 | 578 |
579 ;; XEmacs addition. Called from `insert-file-contents-internal' | 579 ;; XEmacs addition. Called from `insert-file-contents-internal' |
580 ;; at the appropriate time. | 580 ;; at the appropriate time. |
581 (defun compute-buffer-file-truename (&optional buffer) | 581 (defun compute-buffer-file-truename (&optional buffer) |
582 "Recomputes BUFFER's value of `buffer-file-truename' | 582 "Recompute BUFFER's value of `buffer-file-truename' |
583 based on the current value of `buffer-file-name'. | 583 based on the current value of `buffer-file-name'. |
584 BUFFER defaults to the current buffer if unspecified." | 584 BUFFER defaults to the current buffer if unspecified." |
585 (save-excursion | 585 (save-excursion |
586 (set-buffer (or buffer (current-buffer))) | 586 (set-buffer (or buffer (current-buffer))) |
587 (cond ((null buffer-file-name) | 587 (cond ((null buffer-file-name) |
888 ;; make it start with `~' instead. | 888 ;; make it start with `~' instead. |
889 (if (and (string-match abbreviated-home-dir filename) | 889 (if (and (string-match abbreviated-home-dir filename) |
890 ;; If the home dir is just /, don't change it. | 890 ;; If the home dir is just /, don't change it. |
891 (not (and (= (match-end 0) 1) ;#### unix-specific | 891 (not (and (= (match-end 0) 1) ;#### unix-specific |
892 (= (aref filename 0) ?/))) | 892 (= (aref filename 0) ?/))) |
893 (not (and (or (eq system-type 'ms-dos) | 893 (not (and (or (eq system-type 'ms-dos) |
894 (eq system-type 'windows-nt)) | 894 (eq system-type 'windows-nt)) |
895 (save-match-data | 895 (save-match-data |
896 (string-match "^[a-zA-Z]:/$" filename))))) | 896 (string-match "^[a-zA-Z]:/$" filename))))) |
897 (setq filename | 897 (setq filename |
898 (concat "~" | 898 (concat "~" |
954 find-file-hooks, etc. | 954 find-file-hooks, etc. |
955 This function ensures that none of these modifications will take place." | 955 This function ensures that none of these modifications will take place." |
956 (let ((file-name-handler-alist nil) | 956 (let ((file-name-handler-alist nil) |
957 (format-alist nil) | 957 (format-alist nil) |
958 (after-insert-file-functions nil) | 958 (after-insert-file-functions nil) |
959 (find-buffer-file-type-function | 959 (find-buffer-file-type-function |
960 (if (fboundp 'find-buffer-file-type) | 960 (if (fboundp 'find-buffer-file-type) |
961 (symbol-function 'find-buffer-file-type) | 961 (symbol-function 'find-buffer-file-type) |
962 nil))) | 962 nil))) |
963 (unwind-protect | 963 (unwind-protect |
964 (progn | 964 (progn |
1092 ; (expand-file-name buffer-file-truename)))) | 1092 ; (expand-file-name buffer-file-truename)))) |
1093 (and find-file-use-truenames | 1093 (and find-file-use-truenames |
1094 ;; This should be in C. Put pathname abbreviations that have | 1094 ;; This should be in C. Put pathname abbreviations that have |
1095 ;; been explicitly requested back into the pathname. Most | 1095 ;; been explicitly requested back into the pathname. Most |
1096 ;; importantly, strip out automounter /tmp_mnt directories so | 1096 ;; importantly, strip out automounter /tmp_mnt directories so |
1097 ;; that auto-save will work | 1097 ;; that auto-save will work |
1098 (setq buffer-file-name (abbreviate-file-name buffer-file-name))) | 1098 (setq buffer-file-name (abbreviate-file-name buffer-file-name))) |
1099 ;; Set buffer's default directory to that of the file. | 1099 ;; Set buffer's default directory to that of the file. |
1100 (setq default-directory (file-name-directory buffer-file-name)) | 1100 (setq default-directory (file-name-directory buffer-file-name)) |
1101 ;; Turn off backup files for certain file names. Since | 1101 ;; Turn off backup files for certain file names. Since |
1102 ;; this is a permanent local, the major mode won't eliminate it. | 1102 ;; this is a permanent local, the major mode won't eliminate it. |
1354 (while keep-going | 1354 (while keep-going |
1355 (setq keep-going nil) | 1355 (setq keep-going nil) |
1356 (let ((alist auto-mode-alist) | 1356 (let ((alist auto-mode-alist) |
1357 (mode nil)) | 1357 (mode nil)) |
1358 ;; Find first matching alist entry. | 1358 ;; Find first matching alist entry. |
1359 (let ((case-fold-search | 1359 (let ((case-fold-search |
1360 (memq system-type '(vax-vms windows-nt)))) | 1360 (memq system-type '(vax-vms windows-nt)))) |
1361 (while (and (not mode) alist) | 1361 (while (and (not mode) alist) |
1362 (if (string-match (car (car alist)) name) | 1362 (if (string-match (car (car alist)) name) |
1363 (if (and (consp (cdr (car alist))) | 1363 (if (and (consp (cdr (car alist))) |
1364 (nth 2 (car alist))) | 1364 (nth 2 (car alist))) |
1445 ;;; Local variables: | 1445 ;;; Local variables: |
1446 ;;; variable-name: variable-value | 1446 ;;; variable-name: variable-value |
1447 ;;; end: | 1447 ;;; end: |
1448 ;;; | 1448 ;;; |
1449 ;;; The lines may begin with a common prefix, like ";;; " in the above | 1449 ;;; The lines may begin with a common prefix, like ";;; " in the above |
1450 ;;; example. They may also have a common suffix (" */" for example). In | 1450 ;;; example. They may also have a common suffix (" */" for example). In |
1451 ;;; this form, the local variable "mode" can be used to change the major | 1451 ;;; this form, the local variable "mode" can be used to change the major |
1452 ;;; mode, and the local variable "eval" can be used to evaluate an arbitrary | 1452 ;;; mode, and the local variable "eval" can be used to evaluate an arbitrary |
1453 ;;; form. | 1453 ;;; form. |
1454 ;;; | 1454 ;;; |
1455 ;;; Local variables may also be specified in the first line of the file. | 1455 ;;; Local variables may also be specified in the first line of the file. |
1456 ;;; Embedded in this line are a pair of "-*-" sequences. What lies between | 1456 ;;; Embedded in this line are a pair of "-*-" sequences. What lies between |
1552 ;; Returns t if mode was set. | 1552 ;; Returns t if mode was set. |
1553 (let ((result nil)) | 1553 (let ((result nil)) |
1554 (save-excursion | 1554 (save-excursion |
1555 (goto-char (point-min)) | 1555 (goto-char (point-min)) |
1556 (skip-chars-forward " \t\n\r") | 1556 (skip-chars-forward " \t\n\r") |
1557 (let ((end (save-excursion | 1557 (let ((end (save-excursion |
1558 ;; If the file begins with "#!" | 1558 ;; If the file begins with "#!" |
1559 ;; (un*x exec interpreter magic), look | 1559 ;; (un*x exec interpreter magic), look |
1560 ;; for mode frobs in the first two | 1560 ;; for mode frobs in the first two |
1561 ;; lines. You cannot necessarily | 1561 ;; lines. You cannot necessarily |
1562 ;; put them in the first line of | 1562 ;; put them in the first line of |
1600 (if (equal (downcase (symbol-name key)) "mode") | 1600 (if (equal (downcase (symbol-name key)) "mode") |
1601 (setq key 'mode)) | 1601 (setq key 'mode)) |
1602 (setq result (cons (cons key val) result)) | 1602 (setq result (cons (cons key val) result)) |
1603 (skip-chars-forward " \t;"))) | 1603 (skip-chars-forward " \t;"))) |
1604 (setq result (nreverse result)))))) | 1604 (setq result (nreverse result)))))) |
1605 | 1605 |
1606 (let ((set-any-p (or force | 1606 (let ((set-any-p (or force |
1607 ;; It's OK to force null specifications. | 1607 ;; It's OK to force null specifications. |
1608 (null result) | 1608 (null result) |
1609 ;; It's OK to force mode-only specifications. | 1609 ;; It's OK to force mode-only specifications. |
1610 (let ((remaining result) | 1610 (let ((remaining result) |
1660 (put 'exec-directory 'risky-local-variable t) | 1660 (put 'exec-directory 'risky-local-variable t) |
1661 (put 'process-environment 'risky-local-variable t) | 1661 (put 'process-environment 'risky-local-variable t) |
1662 ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode. | 1662 ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode. |
1663 (put 'outline-level 'risky-local-variable t) | 1663 (put 'outline-level 'risky-local-variable t) |
1664 (put 'rmail-output-file-alist 'risky-local-variable t) | 1664 (put 'rmail-output-file-alist 'risky-local-variable t) |
1665 | 1665 |
1666 ;; This one is safe because the user gets to check it before it is used. | 1666 ;; This one is safe because the user gets to check it before it is used. |
1667 (put 'compile-command 'safe-local-variable t) | 1667 (put 'compile-command 'safe-local-variable t) |
1668 | 1668 |
1669 ;(defun hack-one-local-variable-quotep (exp) | 1669 ;(defun hack-one-local-variable-quotep (exp) |
1670 ; (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) | 1670 ; (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) |
1968 pos)) | 1968 pos)) |
1969 (string-match "~\\'" name) | 1969 (string-match "~\\'" name) |
1970 (length name)))))))) | 1970 (length name)))))))) |
1971 | 1971 |
1972 (defun file-ownership-preserved-p (file) | 1972 (defun file-ownership-preserved-p (file) |
1973 "Returns t if deleting FILE and rewriting it would preserve the owner." | 1973 "Return t if deleting FILE and rewriting it would preserve the owner." |
1974 (let ((handler (find-file-name-handler file 'file-ownership-preserved-p))) | 1974 (let ((handler (find-file-name-handler file 'file-ownership-preserved-p))) |
1975 (if handler | 1975 (if handler |
1976 (funcall handler 'file-ownership-preserved-p file) | 1976 (funcall handler 'file-ownership-preserved-p file) |
1977 (let ((attributes (file-attributes file))) | 1977 (let ((attributes (file-attributes file))) |
1978 ;; Return t if the file doesn't exist, since it's true that no | 1978 ;; Return t if the file doesn't exist, since it's true that no |
2165 (let ((localval (symbol-value hook)) | 2165 (let ((localval (symbol-value hook)) |
2166 (globalval (default-value hook))) | 2166 (globalval (default-value hook))) |
2167 (if (memq t localval) | 2167 (if (memq t localval) |
2168 (setq localval (append (delq t localval) (delq t globalval)))) | 2168 (setq localval (append (delq t localval) (delq t globalval)))) |
2169 localval)) | 2169 localval)) |
2170 | 2170 |
2171 (defun basic-save-buffer () | 2171 (defun basic-save-buffer () |
2172 "Save the current buffer in its visited file, if it has been modified. | 2172 "Save the current buffer in its visited file, if it has been modified. |
2173 After saving the buffer, run `after-save-hook'." | 2173 After saving the buffer, run `after-save-hook'." |
2174 (interactive) | 2174 (interactive) |
2175 (save-excursion | 2175 (save-excursion |
2278 (setq tempsetmodes t) | 2278 (setq tempsetmodes t) |
2279 (error | 2279 (error |
2280 "Attempt to save to a file which you aren't allowed to write")))))) | 2280 "Attempt to save to a file which you aren't allowed to write")))))) |
2281 (or buffer-backed-up | 2281 (or buffer-backed-up |
2282 (setq setmodes (backup-buffer))) | 2282 (setq setmodes (backup-buffer))) |
2283 (let ((dir (file-name-directory buffer-file-name))) | 2283 (let ((dir (file-name-directory buffer-file-name))) |
2284 (if (and file-precious-flag | 2284 (if (and file-precious-flag |
2285 (file-writable-p dir)) | 2285 (file-writable-p dir)) |
2286 ;; If file is precious, write temp name, then rename it. | 2286 ;; If file is precious, write temp name, then rename it. |
2287 ;; This requires write access to the containing dir, | 2287 ;; This requires write access to the containing dir, |
2288 ;; which is why we don't try it if we don't have that access. | 2288 ;; which is why we don't try it if we don't have that access. |
2302 tempname nil realname | 2302 tempname nil realname |
2303 buffer-file-truename) | 2303 buffer-file-truename) |
2304 (setq succeed t)) | 2304 (setq succeed t)) |
2305 ;; If writing the temp file fails, | 2305 ;; If writing the temp file fails, |
2306 ;; delete the temp file. | 2306 ;; delete the temp file. |
2307 (or succeed | 2307 (or succeed |
2308 (progn | 2308 (progn |
2309 (delete-file tempname) | 2309 (delete-file tempname) |
2310 (set-visited-file-modtime old-modtime)))) | 2310 (set-visited-file-modtime old-modtime)))) |
2311 ;; Since we have created an entirely new file | 2311 ;; Since we have created an entirely new file |
2312 ;; and renamed it, make sure it gets the | 2312 ;; and renamed it, make sure it gets the |
2711 ;; only rarely. | 2711 ;; only rarely. |
2712 ;; Not just because users often use the default. | 2712 ;; Not just because users often use the default. |
2713 (interactive "FRecover file: ") | 2713 (interactive "FRecover file: ") |
2714 (setq file (expand-file-name file)) | 2714 (setq file (expand-file-name file)) |
2715 (let ((handler (or (find-file-name-handler file 'recover-file) | 2715 (let ((handler (or (find-file-name-handler file 'recover-file) |
2716 (find-file-name-handler | 2716 (find-file-name-handler |
2717 (let ((buffer-file-name file)) | 2717 (let ((buffer-file-name file)) |
2718 (make-auto-save-file-name)) | 2718 (make-auto-save-file-name)) |
2719 'recover-file)))) | 2719 'recover-file)))) |
2720 (if handler | 2720 (if handler |
2721 (funcall handler 'recover-file file) | 2721 (funcall handler 'recover-file file) |
2829 (if files | 2829 (if files |
2830 (map-y-or-n-p "Recover %s? " | 2830 (map-y-or-n-p "Recover %s? " |
2831 (lambda (file) | 2831 (lambda (file) |
2832 (condition-case nil | 2832 (condition-case nil |
2833 (save-excursion (recover-file file)) | 2833 (save-excursion (recover-file file)) |
2834 (error | 2834 (error |
2835 "Failed to recover `%s'" file))) | 2835 "Failed to recover `%s'" file))) |
2836 files | 2836 files |
2837 '("file" "files" "recover")) | 2837 '("file" "files" "recover")) |
2838 (message "No files can be recovered from this session now"))) | 2838 (message "No files can be recovered from this session now"))) |
2839 (kill-buffer buffer)))) | 2839 (kill-buffer buffer)))) |
2909 (file-name-nondirectory fname) | 2909 (file-name-nondirectory fname) |
2910 "#") | 2910 "#") |
2911 | 2911 |
2912 ;; Deal with buffers that don't have any associated files. (Mail | 2912 ;; Deal with buffers that don't have any associated files. (Mail |
2913 ;; mode tends to create a good number of these.) | 2913 ;; mode tends to create a good number of these.) |
2914 | 2914 |
2915 (let ((buffer-name (buffer-name)) | 2915 (let ((buffer-name (buffer-name)) |
2916 (limit 0)) | 2916 (limit 0)) |
2917 ;; Use technique from Sebastian Kremer's auto-save | 2917 ;; Use technique from Sebastian Kremer's auto-save |
2918 ;; package to turn slashes into \\!. This ensures that | 2918 ;; package to turn slashes into \\!. This ensures that |
2919 ;; the auto-save buffer name is unique. | 2919 ;; the auto-save buffer name is unique. |
2920 | 2920 |
2921 ;; #### - yuck! yuck! yuck! move this functionality | 2921 ;; #### - yuck! yuck! yuck! move this functionality |
2922 ;; somewhere else and make the name translation customizable. | 2922 ;; somewhere else and make the name translation customizable. |
2923 ;; Using "\!" as part of a filename on a UNIX filesystem is nearly | 2923 ;; Using "\!" as part of a filename on a UNIX filesystem is nearly |
2924 ;; IMPOSSIBLE to get past a shell parser. -stig | 2924 ;; IMPOSSIBLE to get past a shell parser. -stig |
2925 | 2925 |
2926 (while (string-match "[/\\]" buffer-name limit) | 2926 (while (string-match "[/\\]" buffer-name limit) |
2927 (setq buffer-name | 2927 (setq buffer-name |
2928 (concat (substring buffer-name 0 (match-beginning 0)) | 2928 (concat (substring buffer-name 0 (match-beginning 0)) |
2929 (if (string= (substring buffer-name | 2929 (if (string= (substring buffer-name |
2930 (match-beginning 0) | 2930 (match-beginning 0) |
2943 ;; calls (make-auto-save-file-name) to determine whether | 2943 ;; calls (make-auto-save-file-name) to determine whether |
2944 ;; there is unsent, auto-saved mail to recover. If that | 2944 ;; there is unsent, auto-saved mail to recover. If that |
2945 ;; mail came from a previous emacs process (far and away | 2945 ;; mail came from a previous emacs process (far and away |
2946 ;; the most likely case) then this can never succeed as | 2946 ;; the most likely case) then this can never succeed as |
2947 ;; the pid differs. | 2947 ;; the pid differs. |
2948 | 2948 |
2949 (expand-file-name (format "#%s#" buffer-name))) | 2949 (expand-file-name (format "#%s#" buffer-name))) |
2950 )) | 2950 )) |
2951 ;; don't try to write auto-save files in unwritable places. Unless | 2951 ;; don't try to write auto-save files in unwritable places. Unless |
2952 ;; there's already an autosave file here, put ours somewhere safe. --Stig | 2952 ;; there's already an autosave file here, put ours somewhere safe. --Stig |
2953 (if (or (file-writable-p name) | 2953 (if (or (file-writable-p name) |
3113 (eq system-type 'windows-nt)) | 3113 (eq system-type 'windows-nt)) |
3114 (mswindows-insert-directory file switches wildcard full-directory-p)) | 3114 (mswindows-insert-directory file switches wildcard full-directory-p)) |
3115 (t | 3115 (t |
3116 (if wildcard | 3116 (if wildcard |
3117 ;; Run ls in the directory of the file pattern we asked for. | 3117 ;; Run ls in the directory of the file pattern we asked for. |
3118 (let ((default-directory | 3118 (let ((default-directory |
3119 (if (file-name-absolute-p file) | 3119 (if (file-name-absolute-p file) |
3120 (file-name-directory file) | 3120 (file-name-directory file) |
3121 (file-name-directory (expand-file-name file)))) | 3121 (file-name-directory (expand-file-name file)))) |
3122 (pattern (file-name-nondirectory file)) | 3122 (pattern (file-name-nondirectory file)) |
3123 (beg 0)) | 3123 (beg 0)) |