[newLISP]HTMLマニュアルからヘルプファイル(arglist)を生成する

mkarglist.lsp

#!/usr/bin/env newlisp

# Create newlisp's primitive arglist
# Usage: newlisp mkarglist.lsp [-o target-file] manual-file

# 手動で書いたものはこちら
# https://github.com/kosh04/nl-modules >>> arglist.lsp

(define (xml-parse-file file (xml-option (| 1 2 4 8)))
  (xml-type-tags nil nil nil nil)
  (xml-parse (read-file file) xml-option))

(define (html-unquote text)
  (replace ">" text ">")
  (replace "&lt;" text "<")
  (replace "&amp;" text "&")
  text)

;; @syntax (arglist primitive-name)
(define-macro (arglist fname)
  (let (ret (Arglist (string fname)))
    (when ret
      (println ret)
      true)))

(define (__main__)

  (define $argv (2 $main-args))

  (when (null? $argv)
    (println "Usage: newlisp mkarglist.lsp [-o target-file] manual-file")
    (exit))

  (let (n (find "-o" $argv))
    (cond
      (n
       (setq $target ($argv (+ 1 n)))
       (pop $argv)
       (pop $argv))
      (true
       (setq $target "arglist.lsp"))
      ))

  (when (file? $target)
    (println $target ": already exists")
    (exit))

  (print "Creating arglist from document...\r")

  (new Tree 'Arglist)
  (letn ((manual-xhtml ($argv 0))
         ;; NOTE:
         ;; - xml-option 8, distinguish between tags and contents
         (xml (xml-parse-file manual-xhtml (+ 2 4 8)))
         (h2-template '(h2 (span ((class "function")) ?) *))
         fname arg)
    (dolist (idx (ref-all h2-template xml match))
      (setq fname (map html-unquote (clean empty? (parse ((xml idx) 1 -1)))))
      (++ (last idx))
      (if (string? (xml idx)) (++ (last idx)))
      (setq arg (html-unquote (join (filter string? (flat (xml idx))))))
      (dolist (f fname)
        (Arglist f arg))
      ))

  (save $target 'Arglist 'arglist)
  (print "making arglist from document...done\n")

  (exit))

(__main__)