docs/extract-docstrings.lisp

   1 (quicklisp:quickload :iterate)
   2 (quicklisp:quickload :alexandria)
   3
   4 (defpackage :it.bese.fiveam.documentation
   5   (:use :common-lisp :iterate :alexandria))
   6
   7 (in-package :it.bese.fiveam.documentation)
   8
   9 (quicklisp:quickload :cl-fad)
  10 (quicklisp:quickload :cl-ppcre)
  11 (quicklisp:quickload :closer-mop)
  12
  13 (quicklisp:quickload :fiveam)
  14
  15 (defvar *slime-root* #P"/Users/mb/m/.emacs/slime/")
  16
  17 (load (path:catfile *slime-root* "swank.asd"))
  18 (asdf:load-system :swank)
  19
  20 (ensure-directories-exist "./docstrings/")
  21
  22 (defun symbol-name-to-pathname (symbol type)
  23   (let ((name (if (symbolp symbol)
  24                   (symbol-name symbol)
  25                   (string symbol))))
  26     (setf name (cl-ppcre:regex-replace-all "\\*" name "-STAR-")
  27           name (cl-ppcre:regex-replace-all "\\+" name "-PLUS-")
  28           name (cl-ppcre:regex-replace-all "\\~" name "-TILDE-")
  29           name (cl-ppcre:regex-replace-all "\\!" name "-EPOINT-")
  30           name (cl-ppcre:regex-replace-all "\\!" name "-QMARK-"))
  31     (concatenate 'string
  32                  (ecase type (function "OP") (type "TYPE") (arglist "ARGLIST") (variable "VAR"))
  33                  "_"
  34                  name)))
  35
  36 (defun output-docstring (name type)
  37   (let ((docstring (documentation name type)))
  38     (when docstring
  39       (with-output-to-file (d (path:catfile "./docstrings/" (format nil "~A.txt" (symbol-name-to-pathname name type))) :if-exists :supersede)
  40         (write-string docstring d)))))
  41
  42 (iter
  43  (with *package* = (find-package :fiveam))
  44  (for i in-package (find-package :fiveam) external-only t)
  45
  46  (output-docstring i 'function)
  47  (when (documentation i 'function)
  48    (with-output-to-file (d (path:catfile "./docstrings/" (format nil "~A.txt" (symbol-name-to-pathname i 'arglist))))
  49      (write-string (string-downcase (format nil "~A~{ __~A__~}~%~%" i (swank-backend:arglist i)))
  50                    d)))
  51   (output-docstring i 'variable))
  52
  53 (output-docstring '5am::test-suite 'type)
  54 (output-docstring '5am::testable-object 'type)
  55 (output-docstring '5am::test-case 'type)