Add OS/HOSTNAME procedure to get a host name suitable for use in an

email address.  (Implemented for unix and OS/2.)

diff --git a/v7/src/edwin/dos.scm b/v7/src/edwin/dos.scm
index e9b1219e7d62d80c2690cf9d2d7a67f4c502d16d..83157365321774f2a107942a4019d72c660589c5 100644 (file)
--- a/v7/src/edwin/dos.scm
+++ b/v7/src/edwin/dos.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: dos.scm,v 1.24 1995/05/02 21:19:13 cph Exp $
+;;;    $Id: dos.scm,v 1.25 1995/05/05 22:32:23 cph Exp $
 ;;;
 ;;;    Copyright (c) 1992-95 Massachusetts Institute of Technology
 ;;;
@@ -471,6 +471,9 @@ Includes the new backup.  Must be > 0."
 (define (os/rmail-pop-procedure)
   #f)
 
+(define (os/hostname)
+  (error "OS/HOSTNAME procedure unimplemented."))
+
 (define (os/interprogram-cut string)
   string push?
   unspecific)

diff --git a/v7/src/edwin/os2.scm b/v7/src/edwin/os2.scm
index 52aaf46d1cdbf0b5f72317fce8b009d5d55e3848..d359dbe7d986a80e0d79677828b2a0da6affc73b 100644 (file)
--- a/v7/src/edwin/os2.scm
+++ b/v7/src/edwin/os2.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: os2.scm,v 1.15 1995/05/04 07:06:12 cph Exp $
+;;;    $Id: os2.scm,v 1.16 1995/05/05 22:32:33 cph Exp $
 ;;;
 ;;;    Copyright (c) 1994-95 Massachusetts Institute of Technology
 ;;;
@@ -706,6 +706,26 @@ filename suffix \".gz\"."
 Otherwise, messages remain on the server and will be re-fetched later."
   #t
   boolean?)
+
+(define (os/hostname)
+  (if (not os2/cached-hostname)
+      (let ((buffer (temporary-buffer "*hostname*")))
+       (let ((status.reason
+              (run-synchronous-process #f (buffer-end buffer) #f #f
+                                       "hostname")))
+         (if (not (equal? status.reason '(EXITED . 0)))
+             (begin
+               (pop-up-buffer buffer)
+               (error "Error running HOSTNAME program:" status.reason))))
+       (set! os2/cached-hostname (string-trim (buffer-string buffer)))
+       (kill-buffer buffer)))
+  os2/cached-hostname)
+
+(define os2/cached-hostname #f)
+(add-event-receiver! event:after-restore
+  (lambda ()
+    (set! os2/cached-hostname #f)
+    unspecific))
 \f
 ;;;; Generic Stuff
 ;;; These definitions are OS-independent and references to them should

diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index b2a52c6059a716964c4a3d79269bc62f134574dd..5bddb82d04426d9ca3a069949e3c9e3a1876e4e7 100644 (file)
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: unix.scm,v 1.49 1995/05/02 21:19:22 cph Exp $
+;;;    $Id: unix.scm,v 1.50 1995/05/05 22:32:44 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-95 Massachusetts Institute of Technology
 ;;;
@@ -691,6 +691,9 @@ Value is a list of strings."
 (define (os/rmail-pop-procedure)
   #f)
 
+(define os/hostname
+  (ucode-primitive full-hostname 0))
+
 (define (os/ls-file-time-string time)
   (let ((dt (decode-file-time time))
        (ns (lambda (n m c) (string-pad-left (number->string n) m c))))