[gnu.emacs.bug] Bug in file-name-sans-versions for VMS

rbr4@UHURA.CC.ROCHESTER.EDU (Roland Roberts) (09/02/89)

While modifying one section of basic-save-buffer to have it trim
version numbers from VMS file names and buffer names, I bumped into a
bug in file-name-sans-versions on VMS.  When (eq system-type 'vax-vms)
is true, the following behavior is seen:

(file-name-sans-versions "disk:[dir]file.5")
===> "disk:[dir]file"

At the DCL level the file would have a name like "disk:[dir]file.5;2"
so the ".5" that was stripped was NOT the version number.  I've made a
patch (below) that corrects this behavior.

Also below, the second patch is the correction to basic-save-buffer I
mentioned.  If buffer-file-name has a version attached to it, the
version number is stripped and the buffer name modified accordingly,
before the attempt to save.  This is consistent with the VMS approach
in general, and (if I recall correctly) is much like emacs worked on
the TOPS-20 system.  When the attempt to save the old version is made,
verify-visited-file-modtime catches it and asks for confirmation
before completing the save.

All rights are (naturally) turned over to the FSF for use of this
code.

roland
Roland Roberts                      BITNET: roberts@uornsrl
  Nuclear Structure Research Lab  INTERNET: rbr4@uhura.cc.rochester.edu
  271 East River Road                 UUCP: rochester!ur-cc!uhura!rbr4
  Rochester, NY  14267                AT&T: (716) 275-8962

*** [lisp]files.el
--- files.el
**************
*** 547,553
    (substring name 0
  	     (if (eq system-type 'vax-vms)
  		 (or (string-match ";[0-9]+\\'" name)
! 		     (string-match ".[0-9]+\\'" name)
  		     (length name))
  	       (or (string-match "\\.~[0-9]+~\\'" name)
  		   (string-match "~\\'" name)
--- 547,557 -----
    (substring name 0
  	     (if (eq system-type 'vax-vms)
  		 (or (string-match ";[0-9]+\\'" name)
! 		     (if (string-match "]" name)
! 			 (if (string-match "].*\\..*\.[0-9]+\\'" name)
! 			     (string-match "\\.[0-9]+\\'" name)
! 			   (length name))
! 		       (length name))
  		     (length name))
  	       (or (string-match "\\.~[0-9]+~\\'" name)
  		   (string-match "~\\'" name)
**************
*** 653,658
    (interactive)
    (if (buffer-modified-p)
        (let (setmodes tempsetmodes)
  	(or buffer-file-name
  	    (progn
  	      (setq buffer-file-name
--- 657,683 -----
    (interactive)
    (if (buffer-modified-p)
        (let (setmodes tempsetmodes)
+ 	(if (and (eq system-type 'vax-vms)
+ 		 (not (string= buffer-file-name
+ 			  (file-name-sans-versions buffer-file-name))))
+ 	    (let ((buffer-new-name nil)
+ 		  (buffer-name-list nil))
+ 	      ;; Strip VMS version number before save
+ 	      (setq buffer-file-name
+ 		    (file-name-sans-versions buffer-file-name))
+ 	      ;; Select a buffer name to correspond
+ 	      (setq buffer-new-name
+ 		    (downcase (file-name-nondirectory buffer-file-name)))
+ 	      ;; Check to see if the buffer name is in use
+ 	      (setq buffer-name-list
+ 		    (mapcar (function buffer-name) (buffer-list)))
+ 	      (while (and buffer-name-list
+ 			  (not (string= buffer-new-name
+ 					(car buffer-name-list))))
+ 		(setq buffer-name-list (cdr buffer-name-list)))
+ 	      ;; Change the buffer name, if no conflict
+ 	      (if (not buffer-name-list)
+ 		  (rename-buffer buffer-new-name))))
  	(or buffer-file-name
  	    (progn
  	      (setq buffer-file-name

rbr4@UHURA.CC.ROCHESTER.EDU (Roland Roberts) (09/02/89)

There was still an error in the diffs I sent.  I left out a '\' when
quoting a '.'  The correct diffs appear below.

roland
---
Roland Roberts                      BITNET: roberts@uornsrl
  Nuclear Structure Research Lab  INTERNET: rbr4@uhura.cc.rochester.edu
  271 East River Road                 UUCP: rochester!ur-cc!uhura!rbr4
  Rochester, NY  14267                AT&T: (716) 275-8962

*** [lisp]files.el
--- files.el
**************
*** 547,553
    (substring name 0
  	     (if (eq system-type 'vax-vms)
  		 (or (string-match ";[0-9]+\\'" name)
! 		     (string-match ".[0-9]+\\'" name)
  		     (length name))
  	       (or (string-match "\\.~[0-9]+~\\'" name)
  		   (string-match "~\\'" name)
--- 547,557 -----
    (substring name 0
  	     (if (eq system-type 'vax-vms)
  		 (or (string-match ";[0-9]+\\'" name)
! 		     (if (string-match "]" name)
! 			 (if (string-match "].*\\..*\\.[0-9]+\\'" name)
! 			     (string-match "\\.[0-9]+\\'" name)
! 			   (length name))
! 		       (length name))
  		     (length name))
  	       (or (string-match "\\.~[0-9]+~\\'" name)
  		   (string-match "~\\'" name)
**************
*** 653,658
    (interactive)
    (if (buffer-modified-p)
        (let (setmodes tempsetmodes)
  	(or buffer-file-name
  	    (progn
  	      (setq buffer-file-name
--- 657,683 -----
    (interactive)
    (if (buffer-modified-p)
        (let (setmodes tempsetmodes)
+ 	(if (and (eq system-type 'vax-vms)
+ 		 (not (string= buffer-file-name
+ 			  (file-name-sans-versions buffer-file-name))))
+ 	    (let ((buffer-new-name nil)
+ 		  (buffer-name-list nil))
+ 	      ;; Strip VMS version number before save
+ 	      (setq buffer-file-name
+ 		    (file-name-sans-versions buffer-file-name))
+ 	      ;; Select a buffer name to correspond
+ 	      (setq buffer-new-name
+ 		    (downcase (file-name-nondirectory buffer-file-name)))
+ 	      ;; Check to see if the buffer name is in use
+ 	      (setq buffer-name-list
+ 		    (mapcar (function buffer-name) (buffer-list)))
+ 	      (while (and buffer-name-list
+ 			  (not (string= buffer-new-name
+ 					(car buffer-name-list))))
+ 		(setq buffer-name-list (cdr buffer-name-list)))
+ 	      ;; Change the buffer name, if no conflict
+ 	      (if (not buffer-name-list)
+ 		  (rename-buffer buffer-new-name))))
  	(or buffer-file-name
  	    (progn
  	      (setq buffer-file-name