135 lines
4.1 KiB
Plaintext
135 lines
4.1 KiB
Plaintext
(include "/usr/local/var/mlisp/terminal.lsp")
|
|
|
|
|
|
(defn doc::strip-backticks (s)
|
|
(if (and (> (string-len s) 2)
|
|
(= (string-substr s 0 1) "`")
|
|
(= (string-substr s -1 1) "`"))
|
|
(string-substr s 1 (- (string-len s) 2))
|
|
s))
|
|
|
|
(defn doc::read-doc-file (filename)
|
|
(do (def parse-line (lambda (ln)
|
|
(if (string-regex? ln "^|.*|")
|
|
(do (def tokens (tail (string-split (string-rltrim ln " \n\r\t" "trim") "\|"))) ; first element is ""
|
|
(if (= (len tokens) 4)
|
|
(insert tokens 0 (string-replace-re (first (string-split (first tokens) "\s+|\)")) "`|\(" ""))
|
|
nil)
|
|
)
|
|
nil)
|
|
))
|
|
|
|
(def lines (string-split (read-file filename) "\n") )
|
|
(def lines (map (lambda (ln) (parse-line ln)) lines))
|
|
(def lines (filter (lambda (e) (!= e nil)) lines))
|
|
(set! doc::doc_entries lines)
|
|
'loaded
|
|
))
|
|
|
|
(defn doc::print (entry)
|
|
(do (print (term-green (doc::strip-backticks (second entry))) "-" (third entry))
|
|
(if (> (string-len (fourth entry)) 2) ; example
|
|
(for example (string-regex-list (fourth entry) "(`.*?`)" "token")
|
|
(def examp (doc::strip-backticks (first example)))
|
|
(def pos (string-find examp "=>" 0))
|
|
(if (and pos (> pos 0))
|
|
(print (term-magenta
|
|
(+ (string-substr examp 0 (- pos 1))
|
|
"\n => "
|
|
(string-substr examp (+ pos 3) (string-len examp)))
|
|
)))
|
|
)
|
|
)
|
|
nil
|
|
))
|
|
|
|
(defn doc::print-entry (entry)
|
|
(do (def call (doc::strip-backticks (second entry)))
|
|
(def desc (doc::strip-backticks (third entry)))
|
|
(print (term-red (first entry)) "-" (term-green (doc::strip-backticks (second entry))) "-" (third entry))
|
|
))
|
|
|
|
(defn doc::man (what)
|
|
(do (def man (filter (lambda (x) (= (first x) what)) doc::doc_entries))
|
|
(if man
|
|
(doc::print (first man))
|
|
(print (term-red (+ "No entry for " what)))
|
|
)
|
|
))
|
|
|
|
(defn doc::look (what)
|
|
(do (def what_list (string-split (string-downcase what) "\s+"))
|
|
(def scores '()) ; ((score entry)..)
|
|
|
|
(for entry doc::doc_entries
|
|
; ("throw-exception" "`(throw-exception exp_desc)`" "Throws an exception with exp_desc describing what happened " "" "Exceptions"
|
|
(def entry_score 0)
|
|
(for kw what_list
|
|
; name matches
|
|
(if (= (string-downcase (first entry)) kw)
|
|
(set! entry_score (+ entry_score 100)))
|
|
; name contains kw
|
|
(if (string-find (string-downcase (first entry)) kw 0)
|
|
(set! entry_score (+ entry_score 10)))
|
|
; desc contains kw
|
|
(if (string-find (string-downcase (third entry)) kw 0)
|
|
(set! entry_score (+ entry_score 1)))
|
|
)
|
|
(if (> entry_score 0)
|
|
(set! scores (push scores (list entry_score entry))))
|
|
)
|
|
|
|
(def sorted (quick-sort-by scores (lambda (a b) (< (first a) (first b)))))
|
|
(for e (take sorted 10)
|
|
(doc::print-entry (second e))))
|
|
|
|
(if (> (len sorted) 10) (print "..."))
|
|
))
|
|
|
|
(defn doc::section (what)
|
|
(do
|
|
(def entries '())
|
|
(for entry doc::doc_entries
|
|
; ("throw-exception" "`(throw-exception exp_desc)`" "Throws an exception with exp_desc describing what happened " "" "Exceptions"
|
|
; section matches
|
|
(if (= (string-downcase (fifth entry)) (string-downcase what))
|
|
(set! entries (push entries entry)))
|
|
)
|
|
|
|
(for e (quick-sort-by entries (lambda (a b) (> (string-cmp (first a) (first b)) 0)))
|
|
(doc::print-entry e))
|
|
))
|
|
|
|
(defn doc::all ()
|
|
(for e (quick-sort-by doc::doc_entries (lambda (a b) (> (string-cmp (first a) (first b)) 0)))
|
|
(doc::print-entry e))
|
|
)
|
|
|
|
(defn doc::appropos (which)
|
|
(doc::look which))
|
|
|
|
(defn doc::lookup (which)
|
|
(doc::look which))
|
|
|
|
(defn doc::doc ()
|
|
(do
|
|
(print "Usage:")
|
|
(print "\t(doc::doc) - shows this help")
|
|
(print "\t(doc::man func) - func must be a string, ie (doc::man \"for\")")
|
|
(print "\t(doc::look str) - str must be a string, ie (doc::look \"length\")")
|
|
(print "\t(doc::lookup) - alias for doc::look")
|
|
(print "\t(doc::appropos) - alias for doc::look")
|
|
(print "\t(doc::all) - show short info about all functions")
|
|
(print "\t(doc::section sec) - show help for section, sec is string one of:")
|
|
(print "\t\t\t\t\"List manipulation\" \"Language\" \"System\"")
|
|
(print "\t\t\t\t\"String manipulation\" \"Date and time\" \"IO\" \"Regex\"")
|
|
(print "\t\t\t\t\"Type casting\" \"Threading\" \"Exceptions\"")
|
|
))
|
|
|
|
|
|
(def doc::doc_entries '()) ; must be here
|
|
|
|
; read doc into memory
|
|
(doc::read-doc-file "/usr/local/var/mlisp/Doc.md")
|
|
|