Changeset 35739 in project


Ignore:
Timestamp:
07/05/18 00:39:38 (2 weeks ago)
Author:
kon
Message:

add csi cmd supp

Location:
release/4/apropos/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/apropos/trunk/apropos.meta

    r34742 r35739  
    1 ;;;; apropos.meta  -*- Hen -*-
     1;;;; apropos.meta
    22
    33((egg "apropos.egg")
     
    1818  "apropos.meta" "apropos.setup"
    1919  "apropos.scm"
    20   "tests/run.scm") )
     20  "tests/run.scm" "tests/apropos-test.scm") )
  • release/4/apropos/trunk/apropos.scm

    r35439 r35739  
    111111        (if (fixnum? ire) ire (irregex-num-submatches ire))) ) ) )
    112112
     113;; string extensions
     114
     115(define (string-fixed-length x n #!optional (pad #\space) (tag "..."))
     116  (let ((rem (fx- n (string-length x))))
     117    (if (positive? rem)
     118      (string-append x (make-string rem pad))
     119      (string-append (substring x 0 (fx- n (string-length tag))) tag) ) ) )
     120
    113121;; raw access renames
    114122
     
    131139;; Constants
    132140
    133 (define-constant CSI-HELP-HEAD (string-append ",a PATT ARG..." (make-string 4 #\space)))
     141(define-constant CSI-HELP-HEAD-WIDTH 18)
     142
     143(define (csi-help-command-pad x)
     144  (string-fixed-length x CSI-HELP-HEAD-WIDTH) )
     145
     146(define CSI-HELP-HEAD (csi-help-command-pad ",a PATT ARG..."))
    134147
    135148;rmvd ", raw, base [#]"
    136 (define-constant CSI-HELP-BODY
     149(define CSI-HELP-BODY
    137150  "Apropos of PATT with ARG from ?, mac, split [nam|mod|#f], qual, ci, sort [nam|mod|typ|#f]")
    138151
    139 (define-constant CSI-HELP (string-append CSI-HELP-HEAD CSI-HELP-BODY))
     152(define CSI-HELP (string-append CSI-HELP-HEAD CSI-HELP-BODY))
    140153
    141154(define-constant HELP-TEXT
     
    258271  (let* (
    259272    (str (symbol->string sym))
     273    ;assume # not part of module name
    260274    (idx (string-index str #\#))
    261275    (mod (if idx (string-take str idx) *TOPLEVEL-MODULE-STRING*))
     
    298312
    299313(: root-symbol-table-size (--> fixnum))
     314;
    300315(define root-symbol-table-size
    301316  (foreign-lambda* int ()
     
    303318
    304319(: root-symbol-table-element (fixnum --> pair))
     320;
    305321(define root-symbol-table-element
    306322  (foreign-lambda* scheme-object ((int i))
     
    308324
    309325(: bucket-symbol (pair --> symbol))
     326;
    310327(define bucket-symbol
    311328  (foreign-lambda* scheme-object ((scheme-object bucket))
     
    313330
    314331(: bucket-link (pair --> list))
     332;
    315333(define bucket-link
    316334  (foreign-lambda* scheme-object ((scheme-object bucket))
     
    318336
    319337(: bucket-last? (list --> boolean))
     338;
    320339(define bucket-last? null?)
    321340
     
    325344
    326345(: make-symbol-table-cursor (* * --> <symbol-table-cursor>))
     346;
    327347(define make-symbol-table-cursor cons)
    328348
    329349(: symbol-table-cursor-active? (* --> boolean))
     350;
    330351(define symbol-table-cursor-active? pair?)
    331352
    332353(: symbol-table-cursor? (* --> boolean))
     354;
    333355(define (symbol-table-cursor? obj)
    334356  (or
     
    337359
    338360(: symbol-table-cursor-index (<symbol-table-cursor> --> *))
     361;
    339362(define symbol-table-cursor-index car)
    340363
    341364(: set-symbol-table-cursor-index! (<symbol-table-cursor> * -> void))
     365;
    342366(define set-symbol-table-cursor-index! set-car!)
    343367
    344368(: symbol-table-cursor-bucket (<symbol-table-cursor> --> *))
     369;
    345370(define symbol-table-cursor-bucket cdr)
    346371
    347372(: set-symbol-table-cursor-bucket! (<symbol-table-cursor> * -> void))
     373;
    348374(define set-symbol-table-cursor-bucket! set-cdr!)
    349375
    350376(: symbol-table-cursor (--> <symbol-table-cursor>))
     377;
    351378(define (symbol-table-cursor)
    352379  (make-symbol-table-cursor -1 '()) )
     
    355382
    356383(: search-interaction-environment-symbols (* procedure --> list))
     384;
    357385(define (search-interaction-environment-symbols env optarg?)
    358386  (let loop ((cursor (initial-symbol-table-cursor)) (syms '()))
     
    364392
    365393(: search-list-environment-symbols (list procedure --> list))
     394;
    366395(define (search-list-environment-symbols env optarg?)
    367396  (foldl
     
    375404
    376405(: search-macro-environment-symbols (list procedure --> list))
     406;
    377407(define (search-macro-environment-symbols env optarg?)
    378408  (search-list-environment-symbols env optarg?) )
    379409
    380410(: search-system-environment-symbols (list procedure --> list))
     411;
    381412(define (search-system-environment-symbols env optarg?)
    382413  (if env
     
    387418
    388419(: next-root-symbol (<symbol-table-cursor> --> <symbol-table-cursor>))
     420;
    389421(define (next-root-symbol cursor)
    390422  (and
     
    406438
    407439(: initial-symbol-table-cursor (--> <symbol-table-cursor>))
     440;
    408441(define (initial-symbol-table-cursor)
    409442  (next-root-symbol (symbol-table-cursor)) )
    410443
    411444(: root-symbol (<symbol-table-cursor> --> (or boolean symbol)))
     445;
    412446(define (root-symbol cursor)
    413447  (and
     
    416450
    417451(: bucket-symbol-ref (list --> (or boolean symbol)))
     452;
    418453(define (bucket-symbol-ref bkt)
    419454  (and
     
    422457
    423458(: bucket-link-ref (list --> (or boolean list)))
     459;
    424460(define (bucket-link-ref bkt)
    425461  (and
     
    11631199
    11641200(define (csi-apropos-command)
     1201  ;FIXME could be empty of args
    11651202  (let* (
    1166     (cmdlin (read-line) )
    1167     (istr (string-trim-both cmdlin) )
    1168     (iargs (with-input-from-string istr read-file) )
    1169     (aargs (parse-csi-apropos-arguments iargs)))
     1203    (cmdlin (read-line))
     1204    (istr (string-trim-both cmdlin))
     1205    (iargs (with-input-from-string istr read-file))
     1206    (aargs (parse-csi-apropos-arguments iargs)) )
    11701207    ;NOTE will not dump the symbol-table unless explicit ; use '(: (* any))
    11711208    (cond
Note: See TracChangeset for help on using the changeset viewer.