apropos/apropos-csi.scm

197 lines
5.8 KiB
Scheme
Raw Normal View History

2024-09-25 16:28:37 +00:00
;;;; apropos-csi.scm -*- Scheme -*-
;;;; Kon Lovett, Jul '18
;;;; Kon Lovett, Oct '17
;;;; Kon Lovett, Mar '09
;;;; From the Chicken 4 core, Version 4.0.0x5 - SVN rev. 13662
;; Issues
;;
;; - old csi option
;; ; {{search|mode pre[fix]|suff[ix]|#t}} : {{#:search-mode (or #:prefix #:suffix #t)}}
;; ; {{SEARCH-MODE}} : {{(or #:prefix #:suffix #t)}} for contains. The default is {{#t}}.
(module apropos-csi ()
(import scheme)
(import (chicken base))
(import (chicken fixnum))
(import (chicken platform))
(import (chicken io))
(import (chicken port))
(import apropos-api)
;;(srfi 1)
(import (only (srfi 1) cons*))
#; ;UNUSED until no (srfi 1)
(define (cons* first . rest)
(let recur ((x first) (rest rest))
(if (pair? rest)
(cons x (recur (car rest) (cdr rest)))
x) ) )
;; Constants
;Some options only in full help. ex: "raw", "base [#]", "internal"
;Pad out to CSI-HELP-HEAD-WIDTH 18, No tabs
(define CSI-HELP #<<EOS
,a PATT OPT... Apropos of PATT with OPT from help, mac, ci, imp, sort nam|mod|typ|#f, find nam|mod|#f
EOS
)
(define HELP-TEXT #<<EOS
Pattern:
The pattern PATT is a symbol, string, sre (see irregex), or quoted.
Symbols & strings are interpreted as a substring match.
The quoted PATT (no sort order is implied):
'(PATT . PATT) performs as if `PATT+PATT find module+name` worked.
'(PATT . _) synonym for `PATT find module`.
'(_ . PATT) synonym for `PATT find name`.
'(_ . _) synonym for '.* | '".*" | (: (* any)) ;match any.
'<atom> interpret `<atom>` as an irregex.
Best to present REGEX-style patterns as a string.
Ex: '"^[a-zA-Z]$" vs. '^\[a-zA-Z\]$
Arguments:
help This message
mac | macros Include macro bound symbols
ci | case-insensitive
Pattern has no capitals
imp | imported Only imported identifiers, otherwise global symbols
sort name | module | type | #f
Order items; optional when last argument
find name | module | #f
Pattern match component; optional when last argument
(also see the '(_ . _) pattern)
all Means `ci mac`
krl Means `all sort mod`
base For number valued pattern
raw No listing symbol interpretation (i.e. x123 ~> x)
internal Include internal modules
EOS
)
;;
;; REPL Integeration
;;
(define (interp-find-arg loc arg)
(case arg
((n nam name) #:name)
((m mod module) #:module)
(else
(and arg
(error-apropos-find-key loc "unknown find key" arg)) ) ) )
(define (interp-sort-arg loc arg)
(case arg
((n nam name) #:name)
((m mod module) #:module)
((t typ type) #:type)
(else
(and arg
(error-apropos-sort-key loc "unknown sort key" arg)) ) ) )
(define (display-apropos-help)
(print CSI-HELP)
(print)
(print HELP-TEXT) )
(define (parse-csi-apropos-arguments iargs)
(let* ((patt (and (not (null? iargs)) (car iargs)))
(args (if patt (cdr iargs) '())) )
(let loop ((args args) (oargs `(,patt)))
;
(define (restargs next optarg?)
(cond ((null? next)
'())
(optarg?
(cdr next))
(else
next) ) )
;
(define (arg-next kwd init #!optional optarg?)
(define (thisargs next kwd init optarg?)
(cond ((null? next)
(cons* init kwd oargs))
(optarg?
(cons* (optarg? (car next)) kwd oargs))
(else
(cons* init kwd oargs)) ) )
(let* ((next (cdr args))
(args (restargs next optarg?))
(oargs (thisargs next kwd init optarg?)) )
(loop args oargs) ) )
;
(if (null? args)
;original ordering
(reverse oargs)
;csi-apropos-syntax => keyword-apropos-syntax
(let ((arg (car args)))
(case arg
;
((krl)
(loop (restargs (cons* 'all (cdr args)) #f)
(cons* #:module #:sort oargs)) )
;
((all)
(loop (restargs (cdr args) #f)
(cons* #t #:case-insensitive? #t #:macros? oargs)) )
;
((imp imported)
(arg-next #:imported? #t) )
;
((mac macros)
(arg-next #:macros? #t) )
;
((ci case-insensitive)
(arg-next #:case-insensitive? #t) )
;
((internal)
(arg-next #:internal? #t) )
;
((raw)
(arg-next #:raw? #t) )
;
((base)
(arg-next #:base (apropos-default-base) (cute check-apropos-number-base '|,a| <>)) )
;
((sort)
(arg-next #:sort #:type (cute interp-sort-arg '|,a| <>)) )
;
((find split)
(arg-next #:find #f (cute interp-find-arg '|,a| <>)) )
;
((help)
(loop '() '()) )
;
(else
(loop (cdr args) (cons arg oargs)) ) ) ) ) ) ) )
(define (csi-apropos-command)
(let* ((cmdlin (read-line))
(csi-args (with-input-from-string cmdlin read-list))
(apropos-args (parse-csi-apropos-arguments csi-args)) )
;NOTE will not dump the symbol-table unless explicit
;use '(: (* any)) | '(_ . _)
(if (null? apropos-args)
(display-apropos-help)
(apply apropos apropos-args) ) ) )
;; Main
(when (feature? #:csi)
;; Load csi library at runtime here in Chicken 6 only after we confirm
;; csi is running. Otherwise chicken.csi load fails.
(import (only (chicken csi) toplevel-command))
(toplevel-command 'a csi-apropos-command CSI-HELP) )
) ;module apropos-csi