diff lisp/prim/files.el @ 74:54cc21c15cbb r20-0b32

Import from CVS: tag r20-0b32
author cvs
date Mon, 13 Aug 2007 09:04:33 +0200
parents b9518feda344
children 6a378aca36af
line wrap: on
line diff
--- a/lisp/prim/files.el	Mon Aug 13 09:03:47 2007 +0200
+++ b/lisp/prim/files.el	Mon Aug 13 09:04:33 2007 +0200
@@ -749,10 +749,13 @@
   "Create a suitably named buffer for visiting FILENAME, and return it.
 FILENAME (sans directory) is used unchanged if that name is free;
 otherwise a string <2> or <3> or ... is appended to get an unused name."
-  (let ((lastname (file-name-nondirectory filename)))
-    (if (string= lastname "")
-	(setq lastname filename))
-    (generate-new-buffer lastname)))
+    (let ((handler (find-file-name-handler filename 'create-file-buffer)))
+      (if handler
+	  (funcall handler 'create-file-buffer filename)
+	(let ((lastname (file-name-nondirectory filename)))
+	  (if (string= lastname "")
+	      (setq lastname filename))
+	  (generate-new-buffer lastname)))))
 
 (defun generate-new-buffer (name)
   "Create and return a buffer with a name based on NAME.
@@ -767,48 +770,51 @@
 See documentation of variable `directory-abbrev-alist' for more information.
 If optional argument HACK-HOMEDIR is non-nil, then this also substitutes
 \"~\" for the user's home directory."
-  ;; Get rid of the prefixes added by the automounter.
-  ;(if (and (string-match automount-dir-prefix filename)
-  ;         (file-exists-p (file-name-directory
-  ;                         (substring filename (1- (match-end 0))))))
-  ;    (setq filename (substring filename (1- (match-end 0)))))
-  (let ((tail directory-abbrev-alist))
-    ;; If any elt of directory-abbrev-alist matches this name,
-    ;; abbreviate accordingly.
-    (while tail
-      (if (string-match (car (car tail)) filename)
-	  (setq filename
-		(concat (cdr (car tail)) (substring filename (match-end 0)))))
-      (setq tail (cdr tail))))
-  (if hack-homedir
-      (progn
-	;; Compute and save the abbreviated homedir name.
-	;; We defer computing this until the first time it's needed, to
-	;; give time for directory-abbrev-alist to be set properly.
-	;; We include a slash at the end, to avoid spurious matches
-	;; such as `/usr/foobar' when the home dir is `/usr/foo'.
-	(or abbreviated-home-dir
-	    (setq abbreviated-home-dir
-		  (let ((abbreviated-home-dir "$foo"))
-		    (concat "\\`" (regexp-quote (abbreviate-file-name
-						 (expand-file-name "~")))
-			    "\\(/\\|\\'\\)"))))
-        ;; If FILENAME starts with the abbreviated homedir,
-        ;; make it start with `~' instead.
-	(if (and (string-match abbreviated-home-dir filename)
-                 ;; If the home dir is just /, don't change it.
-                 (not (and (= (match-end 0) 1) ;#### unix-specific
-			   (= (aref filename 0) ?/)))
-		 (not (and (or (eq system-type 'ms-dos) 
-			       (eq system-type 'windows-nt))
-			   (save-match-data
-			     (string-match "^[a-zA-Z]:/$" filename)))))
-	    (setq filename
-		  (concat "~"
-			  (substring filename
-				     (match-beginning 1) (match-end 1))
-			  (substring filename (match-end 0)))))))
-  filename)
+  (let ((handler (find-file-name-handler filename 'abbreviate-file-name)))
+    (if handler
+	(funcall handler 'abbreviate-file-name filename hack-homedir)
+      ;; Get rid of the prefixes added by the automounter.
+      ;;(if (and (string-match automount-dir-prefix filename)
+      ;;         (file-exists-p (file-name-directory
+      ;;                         (substring filename (1- (match-end 0))))))
+      ;;    (setq filename (substring filename (1- (match-end 0)))))
+      (let ((tail directory-abbrev-alist))
+	;; If any elt of directory-abbrev-alist matches this name,
+	;; abbreviate accordingly.
+	(while tail
+	  (if (string-match (car (car tail)) filename)
+	      (setq filename
+		    (concat (cdr (car tail)) (substring filename (match-end 0)))))
+	  (setq tail (cdr tail))))
+      (if hack-homedir
+	  (progn
+	    ;; Compute and save the abbreviated homedir name.
+	    ;; We defer computing this until the first time it's needed, to
+	    ;; give time for directory-abbrev-alist to be set properly.
+	    ;; We include a slash at the end, to avoid spurious matches
+	    ;; such as `/usr/foobar' when the home dir is `/usr/foo'.
+	    (or abbreviated-home-dir
+		(setq abbreviated-home-dir
+		      (let ((abbreviated-home-dir "$foo"))
+			(concat "\\`" (regexp-quote (abbreviate-file-name
+						     (expand-file-name "~")))
+				"\\(/\\|\\'\\)"))))
+	    ;; If FILENAME starts with the abbreviated homedir,
+	    ;; make it start with `~' instead.
+	    (if (and (string-match abbreviated-home-dir filename)
+		     ;; If the home dir is just /, don't change it.
+		     (not (and (= (match-end 0) 1) ;#### unix-specific
+			       (= (aref filename 0) ?/)))
+		     (not (and (or (eq system-type 'ms-dos) 
+				   (eq system-type 'windows-nt))
+			       (save-match-data
+				 (string-match "^[a-zA-Z]:/$" filename)))))
+		(setq filename
+		      (concat "~"
+			      (substring filename
+					 (match-beginning 1) (match-end 1))
+			      (substring filename (match-end 0)))))))
+      filename)))
 
 (defvar find-file-not-true-dirname-list nil
   "*List of logical names for which visiting shouldn't save the true dirname.
@@ -1240,7 +1246,10 @@
 		  (setq alist (cdr alist))))
               ;; If we can't deduce a mode from the file name,
               ;; look for an interpreter specified in the first line.
-	      (if (null mode)
+	      (if (and (null mode)
+		       (save-excursion ; XEmacs
+			 (goto-char (point-min))
+			 (looking-at "#!")))
                   (let ((firstline
                          (buffer-substring
                           (point-min)
@@ -1456,22 +1465,23 @@
 		   (setq result (cons (cons key val) result))
 		   (skip-chars-forward " \t;")))
 	       (setq result (nreverse result))))))
-	
-    (let ((set-any-p (or force (hack-local-variables-p t)))
-	  (mode-p nil))
-      (while result
-	(let ((key (car (car result)))
-	      (val (cdr (car result))))
-	  (cond ((eq key 'mode)
-		 (setq mode-p t)
-		 (funcall (intern (concat (downcase (symbol-name val))
-					  "-mode"))))
-		(set-any-p
-		 (hack-one-local-variable key val))
-		(t
-		 nil)))
-	(setq result (cdr result)))
-      mode-p)))
+
+    (if result
+	(let ((set-any-p (or force (hack-local-variables-p t)))
+	      (mode-p nil))
+	  (while result
+	    (let ((key (car (car result)))
+		  (val (cdr (car result))))
+	      (cond ((eq key 'mode)
+		     (setq mode-p t)
+		     (funcall (intern (concat (downcase (symbol-name val))
+					      "-mode"))))
+		    (set-any-p
+		     (hack-one-local-variable key val))
+		    (t
+		     nil)))
+	    (setq result (cdr result)))
+	  mode-p))))
 
 (defconst ignored-local-variables
   (list 'enable-local-eval)
@@ -1689,81 +1699,85 @@
 If the value is non-nil, it is the result of `file-modes' on the original file;
 this means that the caller, after saving the buffer, should change the modes
 of the new file to agree with the old modes."
-  (if (and make-backup-files
-           (not backup-inhibited)
-	   (not buffer-backed-up)
-	   (file-exists-p buffer-file-name)
-	   (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
-		 '(?- ?l)))
-      (let ((real-file-name buffer-file-name)
-	    backup-info backupname targets setmodes)
-	;; If specified name is a symbolic link, chase it to the target.
-	;; Thus we make the backups in the directory where the real file is.
-	(setq real-file-name (file-chase-links real-file-name))
-	(setq backup-info (find-backup-file-name real-file-name)
-	      backupname (car backup-info)
-	      targets (cdr backup-info))
+  (if buffer-file-name
+      (let ((handler (find-file-name-handler buffer-file-name 'backup-buffer)))
+	(if handler
+	    (funcall handler 'backup-buffer)
+	  (if (and make-backup-files
+		   (not backup-inhibited)
+		   (not buffer-backed-up)
+		   (file-exists-p buffer-file-name)
+		   (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
+			 '(?- ?l)))
+	      (let ((real-file-name buffer-file-name)
+		    backup-info backupname targets setmodes)
+		;; If specified name is a symbolic link, chase it to the target.
+		;; Thus we make the backups in the directory where the real file is.
+		(setq real-file-name (file-chase-links real-file-name))
+		(setq backup-info (find-backup-file-name real-file-name)
+		      backupname (car backup-info)
+		      targets (cdr backup-info))
 ;;;     (if (file-directory-p buffer-file-name)
 ;;;         (error "Cannot save buffer in directory %s" buffer-file-name))
-	(if backup-info
-	    (condition-case ()
-		(let ((delete-old-versions
-		       ;; If have old versions to maybe delete,
-		       ;; ask the user to confirm now, before doing anything.
-		       ;; But don't actually delete til later.
-		       (and targets
-			    (or (eq delete-old-versions t)
-				(eq delete-old-versions nil))
-			    (or delete-old-versions
-				(y-or-n-p (format "Delete excess backup versions of %s? "
-						  real-file-name))))))
-		  ;; Actually write the back up file.
-		  (condition-case ()
-		      (if (or file-precious-flag
-    ;			  (file-symlink-p buffer-file-name)
-			      backup-by-copying
-			      (and backup-by-copying-when-linked
-				   (> (file-nlinks real-file-name) 1))
-			      (and backup-by-copying-when-mismatch
-				   (let ((attr (file-attributes real-file-name)))
-				     (or (nth 9 attr)
-					 (not (file-ownership-preserved-p real-file-name))))))
+		(if backup-info
+		    (condition-case ()
+			(let ((delete-old-versions
+			       ;; If have old versions to maybe delete,
+			       ;; ask the user to confirm now, before doing anything.
+			       ;; But don't actually delete til later.
+			       (and targets
+				    (or (eq delete-old-versions t)
+					(eq delete-old-versions nil))
+				    (or delete-old-versions
+					(y-or-n-p (format "Delete excess backup versions of %s? "
+							  real-file-name))))))
+			  ;; Actually write the back up file.
 			  (condition-case ()
-			      (copy-file real-file-name backupname t t)
+			      (if (or file-precious-flag
+					;			  (file-symlink-p buffer-file-name)
+				      backup-by-copying
+				      (and backup-by-copying-when-linked
+					   (> (file-nlinks real-file-name) 1))
+				      (and backup-by-copying-when-mismatch
+					   (let ((attr (file-attributes real-file-name)))
+					     (or (nth 9 attr)
+						 (not (file-ownership-preserved-p real-file-name))))))
+				  (condition-case ()
+				      (copy-file real-file-name backupname t t)
+				    (file-error
+				     ;; If copying fails because file BACKUPNAME
+				     ;; is not writable, delete that file and try again.
+				     (if (and (file-exists-p backupname)
+					      (not (file-writable-p backupname)))
+					 (delete-file backupname))
+				     (copy-file real-file-name backupname t t)))
+				;; rename-file should delete old backup.
+				(rename-file real-file-name backupname t)
+				(setq setmodes (file-modes backupname)))
 			    (file-error
-			     ;; If copying fails because file BACKUPNAME
-			     ;; is not writable, delete that file and try again.
-			     (if (and (file-exists-p backupname)
-				      (not (file-writable-p backupname)))
-				 (delete-file backupname))
-			     (copy-file real-file-name backupname t t)))
-			;; rename-file should delete old backup.
-			(rename-file real-file-name backupname t)
-			(setq setmodes (file-modes backupname)))
-		    (file-error
-		     ;; If trouble writing the backup, write it in ~.
-		     (setq backupname (expand-file-name "~/%backup%~"))
-		     (message "Cannot write backup file; backing up in ~/%%backup%%~")
-		     (sleep-for 1)
-		     (condition-case ()
-			 (copy-file real-file-name backupname t t)
-		       (file-error
-			;; If copying fails because file BACKUPNAME
-			;; is not writable, delete that file and try again.
-			(if (and (file-exists-p backupname)
-				 (not (file-writable-p backupname)))
-			    (delete-file backupname))
-			(copy-file real-file-name backupname t t)))))
-		  (setq buffer-backed-up t)
-		  ;; Now delete the old versions, if desired.
-		  (if delete-old-versions
-		      (while targets
-			(condition-case ()
-			    (delete-file (car targets))
-			  (file-error nil))
-			(setq targets (cdr targets))))
-		  setmodes)
-	    (file-error nil))))))
+			     ;; If trouble writing the backup, write it in ~.
+			     (setq backupname (expand-file-name "~/%backup%~"))
+			     (message "Cannot write backup file; backing up in ~/%%backup%%~")
+			     (sleep-for 1)
+			     (condition-case ()
+				 (copy-file real-file-name backupname t t)
+			       (file-error
+				;; If copying fails because file BACKUPNAME
+				;; is not writable, delete that file and try again.
+				(if (and (file-exists-p backupname)
+					 (not (file-writable-p backupname)))
+				    (delete-file backupname))
+				(copy-file real-file-name backupname t t)))))
+			  (setq buffer-backed-up t)
+			  ;; Now delete the old versions, if desired.
+			  (if delete-old-versions
+			      (while targets
+				(condition-case ()
+				    (delete-file (car targets))
+				  (file-error nil))
+				(setq targets (cdr targets))))
+			  setmodes)
+		      (file-error nil)))))))))
 
 (defun file-name-sans-versions (name &optional keep-backup-version)
   "Return FILENAME sans backup versions or strings.
@@ -2503,28 +2517,35 @@
   ;; Not just because users often use the default.
   (interactive "FRecover file: ")
   (setq file (expand-file-name file))
-  (if (auto-save-file-name-p file)
-      (error "%s is an auto-save file" file))
-  (let ((file-name (let ((buffer-file-name file))
-		     (make-auto-save-file-name))))
-    (cond ((if (file-exists-p file)
-	       (not (file-newer-than-file-p file-name file))
-	     (not (file-exists-p file-name)))
-	   (error "Auto-save file %s not current" file-name))
-	  ((save-window-excursion
-	     (if (not (eq system-type 'vax-vms))
-		 (with-output-to-temp-buffer "*Directory*"
-		   (buffer-disable-undo standard-output)
-		   (call-process "ls" nil standard-output nil
-				 (if (file-symlink-p file) "-lL" "-l")
-				 file file-name)))
-	     (yes-or-no-p (format "Recover auto save file %s? " file-name)))
-	   (switch-to-buffer (find-file-noselect file t))
-	   (let ((buffer-read-only nil))
-	     (erase-buffer)
-	     (insert-file-contents file-name nil))
-	   (after-find-file nil nil t))
-	  (t (error "Recover-file cancelled.")))))
+  (let ((handler (or (find-file-name-handler file 'recover-file)
+		    (find-file-name-handler 
+		     (let ((buffer-file-name file))
+		       (make-auto-save-file-name))
+		     'recover-file))))
+    (if handler
+	(funcall handler 'recover-file file)
+      (if (auto-save-file-name-p file)
+	  (error "%s is an auto-save file" file))
+      (let ((file-name (let ((buffer-file-name file))
+			 (make-auto-save-file-name))))
+	(cond ((if (file-exists-p file)
+		   (not (file-newer-than-file-p file-name file))
+		 (not (file-exists-p file-name)))
+	       (error "Auto-save file %s not current" file-name))
+	      ((save-window-excursion
+		 (if (not (eq system-type 'vax-vms))
+		     (with-output-to-temp-buffer "*Directory*"
+		       (buffer-disable-undo standard-output)
+		       (call-process "ls" nil standard-output nil
+				     (if (file-symlink-p file) "-lL" "-l")
+				     file file-name)))
+		 (yes-or-no-p (format "Recover auto save file %s? " file-name)))
+	       (switch-to-buffer (find-file-noselect file t))
+	       (let ((buffer-read-only nil))
+		 (erase-buffer)
+		 (insert-file-contents file-name nil))
+	       (after-find-file nil nil t))
+	      (t (error "Recover-file cancelled.")))))))
 
 (defun recover-session ()
   "Recover auto save files from a previous Emacs session.