(*features*): Remove array and array-for-each, core

definitions are insufficient for latest slib.
(t, nil): New constants slib says are supposed to exist.
(call-with-open-ports, browse-url): New functions for latest slib.
Implementations taken from Template.scm (public domain).
(open-file): Extend core definition to accept symbols for the mode,
required by latest slib.
(delete-file): Replace core definition with version returning #t/#f as
per slib spec.
(slib:exit, slib:error, slib:warn, slib:eval, slib:eval-load,
slib:tab, slib:form-feed, slib:load-source, output-port-width,
output-port-height, difftime, offset-time): Export these, they're
meant to be public.

ice-9/slib.scm

@@ -71,10 +71,10 @@
 
 
 
-(define slib:exit quit)
+(define-public slib:exit quit)
-(define slib:error error)
+(define-public slib:error error)
-(define slib:warn warn)
+(define-public slib:warn warn)
-(define slib:eval (lambda (x) (eval x slib-module)))
+(define-public slib:eval (lambda (x) (eval x slib-module)))
 (define defmacro:eval (lambda (x) (eval x (interaction-environment))))
 (define logical:logand logand)
 (define logical:logior logior)
@@ -86,9 +86,9 @@
 (define logical:bit-extract bit-extract)
 (define logical:integer-expt integer-expt)
 (define logical:ipow-by-squaring ipow-by-squaring)
-(define slib:eval-load eval-load)
+(define-public slib:eval-load eval-load)
-(define slib:tab #\tab)
+(define-public slib:tab #\tab)
-(define slib:form-feed #\page)
+(define-public slib:form-feed #\page)
 
 (define slib-module (current-module))
 
@@ -128,18 +128,10 @@
 	      '(system)
 	      '())
 
-	  (if (defined? 'array?)
-	      '(array)
-	      '())
-
 	  (if (defined? 'char-ready?)
 	      '(char-ready?)
 	      '())
 
-	  (if (defined? 'array-for-each)
-	      '(array-for-each)
-	      '())
-
 	  (if (and (string->number "0.0") (inexact? (string->number "0.0")))
 	      '(inexact)
 	      '())
@@ -162,6 +154,36 @@
 		'()))))
 
 
+;; The array module specified by slib 3a1 is not the same as what guile
+;; provides, so we must remove `array' from the features list.
+;;
+;; The main difference is `create-array' which is similar to
+;; `make-uniform-array', but the `Ac64' etc prototype procedures incorporate
+;; an initial fill element into the prototype.
+;;
+;; Believe the array-for-each module will need to be taken from slib when
+;; the array module is taken from there, since what the array module creates
+;; won't be understood by the guile functions.  So remove `array-for-each'
+;; from the features list too.
+;;
+;; Also, slib 3a1 array-for-each specifies an `array-map' which is not in
+;; guile (but could be implemented quite easily).
+;;
+;; ENHANCE-ME: It'd be nice to implement what's necessary, since the guile
+;; functions should be more efficient than the implementation in slib.
+;;
+;; FIXME: Since the *features* variable is shared by slib and the guile
+;; core, removing these feature symbols has the unhappy effect of making it
+;; look like they aren't in the core either.  Let's assume that arrays have
+;; been present unconditionally long enough that no guile-specific code will
+;; bother to test.  An alternative would be to make a new separate
+;; *features* variable which the slib stuff operated on, leaving the core
+;; mechanism alone.  That might be a good thing anyway.
+;;
+(set! *features* (delq 'array          *features*))
+(set! *features* (delq 'array-for-each *features*))
+
+
 ;;; FIXME: Because uers want require to search the path, this uses
 ;;; load-from-path, which probably isn't a hot idea.  slib
 ;;; doesn't expect this function to search a path, so I expect to get
@@ -189,7 +211,7 @@
 		       (lambda args args)))
 	   (apply throw errinfo))))))
 
-(define slib:load-source slib:load)
+(define-public slib:load-source slib:load)
 (define defmacro:load slib:load)
 
 (define slib-parent-dir
@@ -208,10 +230,58 @@
 (define (scheme-implementation-type) 'guile)
 (define (scheme-implementation-version) "")
 
-(define (output-port-width . arg) 80)
+;; legacy from r3rs, but slib says all implementations provide these
-(define (output-port-height . arg) 24)
+;; ("Legacy" section of the "Miscellany" node in the manual)
+(define-public t   #t)
+(define-public nil #f)
+
+(define-public (output-port-width . arg) 80)
+(define-public (output-port-height . arg) 24)
 (define (identity x) x)
 
+;; slib 3a1 and up, straight from Template.scm
+(define-public (call-with-open-ports . ports)
+  (define proc (car ports))
+  (cond ((procedure? proc) (set! ports (cdr ports)))
+	(else (set! ports (reverse ports))
+	      (set! proc (car ports))
+	      (set! ports (reverse (cdr ports)))))
+  (let ((ans (apply proc ports)))
+    (for-each close-port ports)
+    ans))
+
+;; slib (version 3a1) requires open-file accept a symbol r, rb, w or wb for
+;; MODES, so extend the guile core open-file accordingly.
+;;
+;; slib (version 3a1) also calls open-file with strings "rb" or "wb", not
+;; sure if that's intentional, but in any case this extension continues to
+;; accept strings to make that work.
+;;
+(define-public open-file
+  (let ((guile-core-open-file open-file))
+    (lambda (filename modes)
+      (if (symbol? modes)
+	  (set! modes (symbol->string modes)))
+      (guile-core-open-file filename modes))))
+
+;; returning #t/#f instead of throwing an error for failure
+(define-public delete-file
+  (let ((guile-core-delete-file delete-file))
+    (lambda (filename)
+      (catch 'system-error
+	(lambda () (guile-core-delete-file filename) #t)
+	(lambda args #f)))))
+
+;; Nothing special to do for this, so straight from Template.scm.  Maybe
+;; "sensible-browser" for a debian system would be worth trying too (and
+;; would be good on a tty).
+(define-public (browse-url url)
+  (define (try cmd end) (zero? (system (string-append cmd url end))))
+  (or (try "netscape-remote -remote 'openURL(" ")'")
+      (try "netscape -remote 'openURL(" ")'")
+      (try "netscape '" "'&")
+      (try "netscape '" "'")))
+
 ;;; {Random numbers}
 ;;;
 (define (make-random-state . args)
@@ -254,8 +324,8 @@
 ;;; {Time}
 ;;;
 
-(define difftime -)
+(define-public difftime -)
-(define offset-time +)
+(define-public offset-time +)
 
 
 (define %system-define define)