From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 9 Apr 1995 23:07:05 +0000 (+0000)
Subject: Make OS-independent binding for file-time->string.
X-Git-Tag: 20090517-FFI~6483
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=844fdc83675693ba47f980766a8c1414ea5bc68f;p=mit-scheme.git
Make OS-independent binding for file-time->string.
---
diff --git a/v7/src/edwin/dos.scm b/v7/src/edwin/dos.scm
index be6d21fec..dd35589d9 100644
--- a/v7/src/edwin/dos.scm
+++ b/v7/src/edwin/dos.scm
@@ -1,6 +1,6 @@
;;; -*-Scheme-*-
;;;
-;;; $Id: dos.scm,v 1.21 1995/04/09 22:33:18 cph Exp $
+;;; $Id: dos.scm,v 1.22 1995/04/09 23:06:37 cph Exp $
;;;
;;; Copyright (c) 1992-95 Massachusetts Institute of Technology
;;;
@@ -407,8 +407,8 @@ Includes the new backup. Must be > 0."
(define (generate-dired-entry! file point)
(define (file-attributes/ls-time-string attr)
;; Swap year around to the start
- (let ((time-string ((ucode-primitive file-time->string 1)
- (file-attributes/modification-time attr))))
+ (let ((time-string
+ (file-time->string (file-attributes/modification-time attr))))
(if (string? time-string)
(or (let ((len (string-length time-string)))
(and (fix:> len 5) ;; Grap the space char as well
@@ -463,4 +463,7 @@ Includes the new backup. Must be > 0."
(start-thread-timer)))))
(define (os/set-file-modes-writable! pathname)
- (set-file-modes! pathname #o777))
\ No newline at end of file
+ (set-file-modes! pathname #o777))
+
+(define (os/sendmail-program)
+ "sendmail.exe")
\ No newline at end of file
diff --git a/v7/src/edwin/os2.scm b/v7/src/edwin/os2.scm
index 91787682d..8981bdedd 100644
--- a/v7/src/edwin/os2.scm
+++ b/v7/src/edwin/os2.scm
@@ -1,6 +1,6 @@
;;; -*-Scheme-*-
;;;
-;;; $Id: os2.scm,v 1.7 1995/02/14 00:29:13 cph Exp $
+;;; $Id: os2.scm,v 1.8 1995/04/09 23:06:25 cph Exp $
;;;
;;; Copyright (c) 1994-95 Massachusetts Institute of Technology
;;;
@@ -334,6 +334,9 @@ Includes the new backup. Must be > 0."
(define (os/set-file-modes-writable! pathname)
(set-file-modes! pathname (fix:andc (file-modes pathname) #x0001)))
+
+(define (os/sendmail-program)
+ "sendmail.exe")
;;;; Dired customization
@@ -370,13 +373,13 @@ Includes the new backup. Must be > 0."
(lambda (time)
(let ((time (quotient time #x200000)))
(+ (* (quotient time 16) 12) (remainder time 16))))))
- (let ((now (nmonths (os2/current-file-time))))
+ (let ((now (nmonths (current-file-time))))
(lambda (entry)
(insert-string
(let ((name (car entry))
(attr (cdr entry)))
(let ((time (file-attributes/modification-time attr)))
- (let ((time-string (os2/file-time->string time)))
+ (let ((time-string (file-time->string time)))
(string-append
(file-attributes/mode-string attr)
" "
diff --git a/v7/src/edwin/rmail.scm b/v7/src/edwin/rmail.scm
index 6c5192d71..0ce77a93d 100644
--- a/v7/src/edwin/rmail.scm
+++ b/v7/src/edwin/rmail.scm
@@ -1,6 +1,6 @@
;;; -*-Scheme-*-
;;;
-;;; $Id: rmail.scm,v 1.34 1995/04/09 22:33:06 cph Exp $
+;;; $Id: rmail.scm,v 1.35 1995/04/09 23:07:05 cph Exp $
;;;
;;; Copyright (c) 1991-95 Massachusetts Institute of Technology
;;;
@@ -1362,7 +1362,7 @@ buffer visiting that file."
(fetch-first-field "from" start (header-end start end)))
"unknown")
" "
- (unix/file-time->string (get-time))
+ (file-time->string (current-file-time))
"\n")
start)))
(append-to-file (buffer-region buffer) pathname false)
diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm
index 76bb6d545..617c2221c 100644
--- a/v7/src/edwin/sendmail.scm
+++ b/v7/src/edwin/sendmail.scm
@@ -1,6 +1,6 @@
;;; -*-Scheme-*-
;;;
-;;; $Id: sendmail.scm,v 1.21 1995/04/09 22:33:23 cph Exp $
+;;; $Id: sendmail.scm,v 1.22 1995/04/09 23:06:17 cph Exp $
;;;
;;; Copyright (c) 1991-95 Massachusetts Institute of Technology
;;;
@@ -123,9 +123,7 @@ variable is false, it is ignored."
(define-variable sendmail-program
"Filename of sendmail program."
- (if (file-exists? "/usr/lib/sendmail")
- "/usr/lib/sendmail"
- "fakemail")
+ (os/sendmail-program)
string?)
(define-variable send-mail-procedure
@@ -550,7 +548,7 @@ Numeric argument means justify as well."
(insert-string "From " end)
(insert-string (current-user-name) end)
(insert-string " " end)
- (insert-string (unix/file-time->string (get-time)) end)
+ (insert-string (file-time->string (current-file-time)) end)
(insert-newline end)
(insert-region (buffer-start mail-buffer)
(buffer-end mail-buffer)
diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index 4c7c07ac8..b7838cb16 100644
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
;;; -*-Scheme-*-
;;;
-;;; $Id: unix.scm,v 1.45 1995/01/23 20:06:07 cph Exp $
+;;; $Id: unix.scm,v 1.46 1995/04/09 23:06:46 cph Exp $
;;;
;;; Copyright (c) 1989-95 Massachusetts Institute of Technology
;;;
@@ -681,4 +681,9 @@ Value is a list of strings."
(%quit))
(define (os/set-file-modes-writable! pathname)
- (set-file-modes! pathname #o777))
\ No newline at end of file
+ (set-file-modes! pathname #o777))
+
+(define (os/sendmail-program)
+ (if (file-exists? "/usr/lib/sendmail")
+ "/usr/lib/sendmail"
+ "fakemail"))
\ No newline at end of file
diff --git a/v7/src/edwin/vc.scm b/v7/src/edwin/vc.scm
index 8d7501f79..a2ad75b11 100644
--- a/v7/src/edwin/vc.scm
+++ b/v7/src/edwin/vc.scm
@@ -1,6 +1,6 @@
;;; -*-Scheme-*-
;;;
-;;; $Id: vc.scm,v 1.18 1995/04/09 22:33:12 cph Exp $
+;;; $Id: vc.scm,v 1.19 1995/04/09 23:06:31 cph Exp $
;;;
;;; Copyright (c) 1994-95 Massachusetts Institute of Technology
;;;
@@ -644,9 +644,12 @@ Normally shows only locked files; prefix arg says to show all files."
mark))
(define (ls-file-time-string attr)
+ ;; **** This assumes that file times are just integers in units of
+ ;; seconds, as in unix. This won't work for OS/2 where that isn't
+ ;; the case.
(let ((time (file-attributes/modification-time attr)))
- (let ((s (unix/file-time->string time))
- (delta (- ((ucode-primitive encoded-time)) time)))
+ (let ((s (file-time->string time))
+ (delta (- (current-file-time) time)))
(if (<= delta (* 60 60 24 180))
(substring s 4 16)
(string-append (substring s 4 11)