source: project/release/4/apropos/trunk/apropos-srfi-csi.scm @ 35744

Last change on this file since 35744 was 35744, checked in by Kon Lovett, 2 years ago

boing

File size: 1.9 KB
Line 
1;;;; apropos-srfi-csi.scm
2;;;; Kon Lovett, Jul '18
3
4(module apropos-srfi-csi
5
6(;export
7  srfi-features)
8
9(import scheme chicken)
10(import (only csi toplevel-command))  ;wtf?
11(use
12  (only data-structures alist-ref)
13  (only extras read-line read-file format)
14  (only ports with-input-from-string)
15  (only utf8-srfi-13 string-trim-both)
16  (only feature-utils sorted-feature-srfis)
17  (only apropos-srfi srfi-info srfi-srfis))
18
19;;; String Utilities
20
21(define (string-fixed-length x n #!optional (pad #\space) (tag "..."))
22  (let ((rem (fx- n (string-length x))))
23    (if (positive? rem)
24      (string-append x (make-string rem pad))
25      (string-append (substring x 0 (fx- n (string-length tag))) tag) ) ) )
26
27;;; ,csi Extras
28
29(define-constant CSI-HELP-HEAD-WIDTH 18)
30
31(define (csi-help-command-pad x)
32  (string-fixed-length x CSI-HELP-HEAD-WIDTH) )
33
34;;;
35
36(define CSI-SRFI-HELP-HEAD (csi-help-command-pad ",srfi #|#t|#f"))
37
38(define CSI-SRFI-HELP-BODY "Apropos of SRFI # or all SRFIs or \"featured\" SRFIs")
39
40(define CSI-SRFI-HELP (string-append CSI-SRFI-HELP-HEAD CSI-SRFI-HELP-BODY))
41
42;;
43
44(define srfi-features (make-parameter (sorted-feature-srfis)
45  (lambda (x)
46    (if (list? x)
47      x
48      (begin
49        (warning 'srfi-features "not list of #" x)
50        (srfi-features))))))
51
52(define (srfi-info-present n)
53  (let ((xs (srfi-info n)))
54    (format #t "~A\t~A~%"
55      (alist-ref 'SRFI xs eq?) (alist-ref 'title xs eq?)) ) )
56
57(define (csi-srfi-apropos-command)
58  ;FIXME could be empty of args
59  (let* (
60    (cmdlin (read-line))
61    (istr (string-trim-both cmdlin))
62    (iargs (with-input-from-string istr read-file))
63    (x (and (not (null? iargs)) (car iargs))) )
64    ;
65    (cond
66      ((not x)
67        (for-each srfi-info-present (srfi-features) ) )
68      ((number? x)
69        (srfi-info-present x) )
70      (else
71        (for-each srfi-info-present (srfi-srfis)) ) ) ) )
72
73(toplevel-command 'srfi csi-srfi-apropos-command CSI-SRFI-HELP)
74
75) ;module apropos-srfi-csi
Note: See TracBrowser for help on using the repository browser.