Changeset 38720 in project for release

Timestamp:

05/31/20 01:02:06 (8 months ago)

Author:

Kon Lovett

Message:

add common slib-compat

Location:

release/5/slib-charplot/trunk

Files:

• slib-charplot.egg (modified) (1 diff)
• slib-compat.scm (modified) (2 diffs)

release/5/slib-charplot/trunk/slib-charplot.egg

@@ -3 +3 @@
 
 ((synopsis "The SLIB character plotting library")
- (version "1.1.0")
+ (version "1.1.1")
  (author "Aubrey Jaffer")
  (maintainer "[[kon lovett]]")

release/5/slib-charplot/trunk/slib-compat.scm

@@ -1 @@
-;;;; slib-compat.scm
+;;;; slib-compat.scm  -*- scheme -*-
+;;;; Kon Lovett, Apr '20
 
-(define (output-port-width port)
-  (let-values (((h w)(terminal-size port)))
-    (if (zero? w) 80 w)))
+(import (only (srfi 1) every last-pair))
+(import (only (chicken port) call-with-output-string))
+(import (only (chicken pretty-print) pretty-print))
+(import (only (chicken base) let-values identity))
 
-(define (output-port-height port)
-  (let-values (((h w) (terminal-size port)))
-    (if (zero? h) 25 h)))
+(define mod modulo)
+
+(define (cleanup-handlers!) (begin))
+
+(define (find-if . args)
+  (import (only (srfi 1) find))
+  (apply find args) )
+
+(define (remove-if. args)
+  (import (only (srfi 1) remove))
+  (apply remove args) )
+
+(define last)
+(let ()
+  (define (comlist:nthcdr n lst)
+    (if (zero? n) lst (comlist:nthcdr (+ -1 n) (cdr lst))))
+  (set! last (lambda (lst n) (comlist:nthcdr (- (length lst) n) lst))) )
+
+;;@ FORCE-OUTPUT flushes any pending output on optional arg output port
+;;; use this definition if your system doesn't have such a procedure.
+(define (force-output . args)
+  (import (only (chicken base) flush-output))
+  (flush-output (if (pair? args) (car args) (current-output-port))))
+
+(define (software-type)
+  (import (only (chicken platform) software-type))
+  (let ((softtype (software-type)))
+    (case softtype
+      ((windows)  'ms-dos)
+      (else       softtype)) ) )
+
+(define output-port-width)
+(define output-port-height)
+(let ()
+  (import (only (chicken port) terminal-size))
+  (set! output-port-width (lambda (port)
+    (let-values (((h w) (terminal-size port)))
+      (if (zero? w) 80 w))))
+  (set! output-port-height (lambda (port)
+    (let-values (((h w) (terminal-size port)))
+      (if (zero? h) 25 h)))) )
 
 (define provided?
   (let (
-    (+numeric+ '(inexact))
+    (+numeric+ '(inexact bignum))
     (+builtins+ '()) )
     (lambda (x)
+      (import (only (chicken keyword) string->keyword))
+      (import (only (chicken platform) features))
       (let (
         (kwd (string->keyword (symbol->string x)))
@@ -25 +67 @@
             #t ) ) ) ) )
 
-(define slib:error error)
+(define (require x)
+  ;(print "SLIB require " #\' x)
+  (begin) )
+
+(define (require-if p x)
+  ;(print "SLIB require-if " #\' p " " x)
+  (begin) )
+
+(define (nconc . args)
+  (import (only (srfi 1) concatenate!))
+  (concatenate! args) )
+
+(define (print-call-stack out)
+  (import (only (chicken base) print-call-chain))
+  (print-call-chain out) )
+
+(define (slib:warn args)
+  (import (only (chicken base) current-error-port))
+  (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) ) )
+
+(define slib:error)
+(let ()
+  (import (only (chicken base) error))
+  (let ((error error))
+    (set! slib:error (lambda args
+      (import (only (chicken base) current-error-port))
+      (if (provided? 'trace) (print-call-stack (current-error-port)))
+      (apply error args))) ) )
+
+(define slib:tab #\tab)
+(define slib:form-feed #\page)
+
+(define (math:error . args) (apply slib:error 'math: args))
+(define (math:warn . args)  (apply slib:warn 'math: args))
+(define (math:exit b)       (cleanup-handlers!) (slib:error "error in math system"))