command-help.lsp

(define (primitives reg flag (predicate primitive?) (cnt MAIN))
  (let (func (filter (letex (_p predicate) (fn (x) ('_p (eval x)))) (symbols cnt)))
    (if-not reg
        func
      (let (pat (if flag reg (string "^" reg ".*")))
        (map sym (find-all pat (map string func) $it (fn (x y) (regex x y 1))))))
  ))
(context 'MAIN:syntax)
(setq lst (MAIN:primitives))
(define (set-manual (text (read-file (string (env "NEWLISPDIR" ) "/newlisp_manual.html"))))
  (setq manual text))
(if-not manual (set-manual))
(define (set-flag flag)
  (setq ex-flag flag))
(set-flag nil)
(define (syntax:syntax func (flag ex-flag) (html manual))
  (letn (tmp (string func)
         fname (or (lookup tmp
                    '(("-" "+") ("*" "+") ("/" "+") ("%" "+")
                      ("<" "&lt;") (">" "&lt;") ("=" "&lt;") ("<=" "&lt;") (">=" "&lt;") ("!=" "&lt;")
                      (">>" "&lt;&lt;") ("<<" "&lt;&lt;")
                      ("&" "&amp;")))
                   tmp)
         pre (find (string {<span class="function">} fname) html)
         post (find (if flag "</p>" "</h4>") html 1 pre)
         res (replace {<[^>]+>} (pre (- post pre) html) "" 1))
    (replace "&lt;" res "<")
    (replace "&gt;" res ">")
    (replace "&amp;" res "&")
    (replace "&mdash;" res "-")
    (replace "&nbsp;" res " ")
    (replace "\n\n" res "\n")
    (when flag 
      (replace "\n\n" res "\n")
      (replace "\t" res ""))
    (println res) "")
)
(context MAIN)
(command-event 
  (fn (s)
    (let (x (read-expr s))
      (if (and (symbol? x)(find x syntax:lst))(syntax x)))))

No comments yet

コメントを残す