Changeset 38720 in project


Ignore:
Timestamp:
05/31/20 01:02:06 (6 months ago)
Author:
Kon Lovett
Message:

add common slib-compat

Location:
release/5/slib-charplot/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/slib-charplot/trunk/slib-charplot.egg

    r38672 r38720  
    33
    44((synopsis "The SLIB character plotting library")
    5  (version "1.1.0")
     5 (version "1.1.1")
    66 (author "Aubrey Jaffer")
    77 (maintainer "[[kon lovett]]")
  • release/5/slib-charplot/trunk/slib-compat.scm

    r38390 r38720  
    1 ;;;; slib-compat.scm
     1;;;; slib-compat.scm  -*- scheme -*-
     2;;;; Kon Lovett, Apr '20
    23
    3 (define (output-port-width port)
    4   (let-values (((h w)(terminal-size port)))
    5     (if (zero? w) 80 w)))
     4(import (only (srfi 1) every last-pair))
     5(import (only (chicken port) call-with-output-string))
     6(import (only (chicken pretty-print) pretty-print))
     7(import (only (chicken base) let-values identity))
    68
    7 (define (output-port-height port)
    8   (let-values (((h w) (terminal-size port)))
    9     (if (zero? h) 25 h)))
     9(define mod modulo)
     10
     11(define (cleanup-handlers!) (begin))
     12
     13(define (find-if . args)
     14  (import (only (srfi 1) find))
     15  (apply find args) )
     16
     17(define (remove-if. args)
     18  (import (only (srfi 1) remove))
     19  (apply remove args) )
     20
     21(define last)
     22(let ()
     23  (define (comlist:nthcdr n lst)
     24    (if (zero? n) lst (comlist:nthcdr (+ -1 n) (cdr lst))))
     25  (set! last (lambda (lst n) (comlist:nthcdr (- (length lst) n) lst))) )
     26
     27;;@ FORCE-OUTPUT flushes any pending output on optional arg output port
     28;;; use this definition if your system doesn't have such a procedure.
     29(define (force-output . args)
     30  (import (only (chicken base) flush-output))
     31  (flush-output (if (pair? args) (car args) (current-output-port))))
     32
     33(define (software-type)
     34  (import (only (chicken platform) software-type))
     35  (let ((softtype (software-type)))
     36    (case softtype
     37      ((windows)  'ms-dos)
     38      (else       softtype)) ) )
     39
     40(define output-port-width)
     41(define output-port-height)
     42(let ()
     43  (import (only (chicken port) terminal-size))
     44  (set! output-port-width (lambda (port)
     45    (let-values (((h w) (terminal-size port)))
     46      (if (zero? w) 80 w))))
     47  (set! output-port-height (lambda (port)
     48    (let-values (((h w) (terminal-size port)))
     49      (if (zero? h) 25 h)))) )
    1050
    1151(define provided?
    1252  (let (
    13     (+numeric+ '(inexact))
     53    (+numeric+ '(inexact bignum))
    1454    (+builtins+ '()) )
    1555    (lambda (x)
     56      (import (only (chicken keyword) string->keyword))
     57      (import (only (chicken platform) features))
    1658      (let (
    1759        (kwd (string->keyword (symbol->string x)))
     
    2567            #t ) ) ) ) )
    2668
    27 (define slib:error error)
     69(define (require x)
     70  ;(print "SLIB require " #\' x)
     71  (begin) )
     72
     73(define (require-if p x)
     74  ;(print "SLIB require-if " #\' p " " x)
     75  (begin) )
     76
     77(define (nconc . args)
     78  (import (only (srfi 1) concatenate!))
     79  (concatenate! args) )
     80
     81(define (print-call-stack out)
     82  (import (only (chicken base) print-call-chain))
     83  (print-call-chain out) )
     84
     85(define (slib:warn args)
     86  (import (only (chicken base) current-error-port))
     87  (let ((cep (current-error-port)))
     88    (if (provided? 'trace) (print-call-stack cep))
     89    (display "Warn: " cep)
     90    (for-each (lambda (x) (display #\space cep) (write x cep)) args) ) )
     91
     92(define slib:error)
     93(let ()
     94  (import (only (chicken base) error))
     95  (let ((error error))
     96    (set! slib:error (lambda args
     97      (import (only (chicken base) current-error-port))
     98      (if (provided? 'trace) (print-call-stack (current-error-port)))
     99      (apply error args))) ) )
     100
     101(define slib:tab #\tab)
     102(define slib:form-feed #\page)
     103
     104(define (math:error . args) (apply slib:error 'math: args))
     105(define (math:warn . args)  (apply slib:warn 'math: args))
     106(define (math:exit b)       (cleanup-handlers!) (slib:error "error in math system"))
Note: See TracChangeset for help on using the changeset viewer.