Imported Upstream version 16.5~dfsg

1 files changed, 33 insertions, 42 deletions

diff --git a/s7-slib-init.scm b/s7-slib-init.scm
index c89f2e9..f6a7ec7 100644
--- a/s7-slib-init.scm
+++ b/s7-slib-init.scm
@@ -58,22 +58,16 @@
 ;;; customize a computer environment for a user.
 (define (home-vicinity)
   (let ((home (getenv "HOME")))
-    (and home
-	 (case (software-type)
-	   ((unix coherent ms-dos)	;V7 unix has a / on HOME
-	    (if (eqv? #\/ (string-ref home (+ -1 (string-length home))))
-		home
-		(string-append home "/")))
-	   (else home)))))
-
+    (if (and (memq (software-type) '(unix coherent ms-dos))
+	     (not (char=? #\/ (string-ref home (- (string-length home) 1)))))
+	(string-append home "/")
+	home)))
 ;@
 (define in-vicinity string-append)
 
 ;@
 (define (user-vicinity)
-  (case (software-type)
-    ((vms)	"[.]")
-    (else	"")))
+  (if (eq? (software-type) 'vms) "[.]" ""))
 
 (define *load-pathname* #f)	 ; *load-path* is a list of dirs in s7
 
@@ -104,22 +98,23 @@
       (slib:error 'program-vicinity " called; use slib:load to load")))
 ;@
 (define sub-vicinity
-  (case (software-type)
-    ((vms) (lambda (vic name)
-	     (let ((l (string-length vic)))
-	       (if (or (zero? (string-length vic))
-		       (not (char=? #\] (string-ref vic (- l 1)))))
-		   (string-append vic "[" name "]")
-		   (string-append (substring vic 0 (- l 1))
-				  "." name "]")))))
-    (else (let ((*vicinity-suffix*
-		 (case (software-type)
-		   ((nosve) ".")
-		   ((macos thinkc) ":")
-		   ((ms-dos windows atarist os/2) "\\")
-		   ((unix coherent plan9 amiga) "/"))))
-	    (lambda (vic name)
-	      (string-append vic name *vicinity-suffix*))))))
+  (if (eq? (software-type) 'vms)
+      (lambda (vic name)
+	(let ((L (string-length vic)))
+	  (string-append
+	   (if (or (zero? (string-length vic))
+		   (not (char=? #\] (string-ref vic (- L 1)))))
+	       (values vic "[")
+	       (values (substring vic 0 (- L 1)) "."))
+	   name "]")))
+      (let ((*vicinity-suffix* (case (software-type)
+				 ((nosve) ".")
+				 ((macos thinkc) ":")
+				 ((ms-dos windows atarist os/2) "\\")
+				 ((unix coherent plan9 amiga) "/"))))
+	(lambda (vic name)
+	  (string-append vic name *vicinity-suffix*)))))
+
 ;@
 (define (make-vicinity <pathname>) <pathname>)
 ;@
@@ -288,21 +283,21 @@
 (define (defmacro? m) (assq m *defmacros*))
 ;@
 (define (macroexpand-1 e)
-  (if (pair? e)
+  (if (not (pair? e))
+      e
       (let ((a (car e)))
 	(cond ((symbol? a) (set! a (assq a *defmacros*))
 	       (if a (apply (cdr a) (cdr e)) e))
-	      (else e)))
-      e))
+	      (else e)))))
 ;@
 (define (macroexpand e)
-  (if (pair? e)
+  (if (not (pair? e))
+      e
       (let ((a (car e)))
 	(cond ((symbol? a)
 	       (set! a (assq a *defmacros*))
 	       (if a (macroexpand (apply (cdr a) (cdr e))) e))
-	      (else e)))
-      e))
+	      (else e)))))
 ;@
 (define gentemp
   (let ((*gensym-counter* -1))
@@ -325,9 +320,7 @@
   (lambda args
     (let ((cep (current-error-port)))
       (if (provided? 'trace) (print-call-stack cep))
-      (display "Warn: " cep)
-      (for-each (lambda (x) (display #\space cep) (write x cep)) args)
-      (newline cep))))
+      (format cep "Warn: ~{ ~S~}~%" args))))
 
 ;;@ define an error procedure for the library
 (define slib:error error)
@@ -365,18 +358,18 @@
       (try "netscape '" "'")))
 
 ;;@ define these as appropriate for your system.
-(define slib:tab (integer->char 9))
+(define slib:tab #\tab)
 (define slib:form-feed (integer->char 12))
 
 ;;@ Support for older versions of Scheme.  Not enough code for its own file.
-(define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l))
+(define (last-pair lst) (if (pair? (cdr lst)) (last-pair (cdr lst)) lst))
 (define t #t)
 (define nil #f)
 
 ;;@ Define these if your implementation's syntax can support it and if
 ;;; they are not already defined.
 (define (1+ n) (+ n 1))
-(define (-1+ n) (+ n -1))
+(define (-1+ n) (- n 1))
 (define 1- -1+)
 
 ;;@ Define SLIB:EXIT to be the implementation procedure to exit or
@@ -385,9 +378,7 @@
 
 ;;@ Here for backward compatability
 (define scheme-file-suffix
-  (let ((suffix (case (software-type)
-		  ((nosve) "_scm")
-		  (else ".scm"))))
+  (let ((suffix (if (eq? (software-type) 'nosve) "_scm" ".scm")))
     (lambda () suffix)))
 
 ;;@ (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever