Fix bug under OS/2: when overwriting a file that has its "archived"
authorChris Hanson <org/chris-hanson/cph>
Sat, 4 May 1996 17:38:55 +0000 (17:38 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 4 May 1996 17:38:55 +0000 (17:38 +0000)
bit cleared, the bit should be set but was not.

v7/src/edwin/dos.scm
v7/src/edwin/fileio.scm
v7/src/edwin/os2.scm
v7/src/edwin/unix.scm

index 569bc6af70c8d1cb52d5d020eaab0fb7c55732ae..a5c99e5fb25612198071e870f3fc5bbb3b76065a 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: dos.scm,v 1.35 1996/04/24 02:38:58 cph Exp $
+;;;    $Id: dos.scm,v 1.36 1996/05/04 17:38:40 cph Exp $
 ;;;
 ;;;    Copyright (c) 1992-96 Massachusetts Institute of Technology
 ;;;
 (define (os/set-file-modes-writable! pathname)
   (set-file-modes! pathname #o777))
 
+(define os/restore-modes-to-updated-file!
+  ;; **** If implementation is changed so that file modes are DOS
+  ;; attributes rather than an emulation of unix modes, this will have
+  ;; to be changed to work like the OS/2 code.  ****
+  set-file-modes!)
+
 (define (os/scheme-can-quit?)
   #t)
 
index 945bf78c047c6d1eb3661f0b21ec5602bc2b8e11..6721c089c1d945444c4f02cc249ecc4aa17d9e48 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: fileio.scm,v 1.135 1996/04/24 02:30:01 cph Exp $
+;;;    $Id: fileio.scm,v 1.136 1996/05/04 17:37:30 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology
 ;;;
@@ -525,7 +525,9 @@ Otherwise, a message is written both before and after long file writes."
              (if modes
                  (catch-file-errors
                   (lambda () unspecific)
-                  (lambda () (set-file-modes! pathname modes))))))))))
+                  (lambda ()
+                    (os/restore-modes-to-updated-file! pathname
+                                                       modes))))))))))
 
 (define (verify-visited-file-modification-time? buffer)
   (let ((truename (buffer-truename buffer))
index 3cf3c3b8178cf3841a2e782280c1d5e47af5592f..6042338a171917867f17609ac39c27b0178aed97 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: os2.scm,v 1.29 1996/04/24 02:38:48 cph Exp $
+;;;    $Id: os2.scm,v 1.30 1996/05/04 17:38:12 cph Exp $
 ;;;
 ;;;    Copyright (c) 1994-96 Massachusetts Institute of Technology
 ;;;
              result))))))
 
 (define (os/set-file-modes-writable! pathname)
-  (set-file-modes! pathname (fix:andc (file-modes pathname) #x0001)))
+  (set-file-modes! pathname
+                  (fix:andc (file-modes pathname) os2-file-mode/read-only)))
+
+(define (os/restore-modes-to-updated-file! pathname modes)
+  (set-file-modes! pathname (fix:or modes os2-file-mode/archived)))
 
 (define (os/scheme-can-quit?)
   #f)
index 95d0c5900905acee47cdf36b67a12a7a2025fb53..c3b9bb10c45c7827a66913cbb577475a922a956f 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: unix.scm,v 1.68 1996/04/24 02:38:37 cph Exp $
+;;;    $Id: unix.scm,v 1.69 1996/05/04 17:38:55 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-96 Massachusetts Institute of Technology
 ;;;
@@ -775,6 +775,9 @@ option, instead taking -P <filename>."
 (define (os/set-file-modes-writable! pathname)
   (set-file-modes! pathname #o777))
 
+(define os/restore-modes-to-updated-file!
+  set-file-modes!)
+
 (define (os/sendmail-program)
   (if (file-exists? "/usr/lib/sendmail")
       "/usr/lib/sendmail"