From xemacs-m  Mon Dec 16 02:59:27 1996
Received: from macon.informatik.uni-tuebingen.de (macon2.Informatik.Uni-Tuebingen.De [134.2.13.2]) by xemacs.cs.uiuc.edu (8.8.3/8.8.3) with SMTP id CAA21875 for <xemacs-beta@xemacs.org>; Mon, 16 Dec 1996 02:59:11 -0600 (CST)
Received: from modas.Informatik.Uni-Tuebingen.De by macon.informatik.uni-tuebingen.de (AIX 4.1/UCB 5.64/4.03)
          id AA16124; Mon, 16 Dec 1996 09:58:52 +0100
Received: by modas.informatik.uni-tuebingen.de (AIX 4.1/UCB 5.64/4.03)
          id AA23344; Mon, 16 Dec 1996 09:58:50 +0100
Sender: sperber@informatik.uni-tuebingen.de
To: xemacs-beta@xemacs.org
Subject: More file-name-handlers
Mime-Version: 1.0 (generated by tm-edit 7.95)
Content-Type: text/plain; charset=US-ASCII
From: sperber@informatik.uni-tuebingen.de (Michael Sperber [Mr. Preprocessor])
Date: 16 Dec 1996 09:58:48 +0100
Message-Id: <y9l916yq307.fsf@modas.informatik.uni-tuebingen.de>
Lines: 374
X-Mailer: Red Gnus v0.74/XEmacs 20.0


It would improve EFS support is more functions had file-name-handlers.
The attached patch is a suggestion for that.  Note it's relative to
20.0b30, I don't know how cleanly it applies to 19.15.  Please let me
know if this goes in as that would mean I could remove some kludgery
from EFS.

Cheers =8-} Mike

*** lisp/prim/files.el.orig	Mon Dec 16 09:32:09 1996
--- lisp/prim/files.el	Mon Dec 16 09:41:02 1996
***************
*** 735,744 ****
    "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)))
  
  (defun generate-new-buffer (name)
    "Create and return a buffer with a name based on NAME.
--- 735,747 ----
    "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 ((handler (find-file-name-handler file 'create-file-buffer)))
!       (if handler
! 	  (funcall handler 'create-file-buffer file)
! 	(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,814 ****
  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)
  
  (defvar find-file-not-true-dirname-list nil
    "*List of logical names for which visiting shouldn't save the true dirname.
--- 770,820 ----
  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."
!   (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.
***************
*** 1680,1760 ****
  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 (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))))))
  			  (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 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.
--- 1686,1770 ----
  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 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))))))
! 				  (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 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.
***************
*** 2494,2521 ****
    ;; 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.")))))
  
  (defun recover-session ()
    "Recover auto save files from a previous Emacs session.
--- 2504,2538 ----
    ;; Not just because users often use the default.
    (interactive "FRecover file: ")
    (setq file (expand-file-name file))
!   (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.

