You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
91 lines
2.9 KiB
91 lines
2.9 KiB
(defvar functions '()) |
|
|
|
(defun example-to-string (example) |
|
(let ((actual (car example)) |
|
(expected (cadr (cdr example)))) |
|
(format "%s ;; => %s" actual expected))) |
|
|
|
(defun examples-to-strings (examples) |
|
(let (result) |
|
(while examples |
|
(setq result (cons (example-to-string examples) result)) |
|
(setq examples (cddr (cdr examples)))) |
|
(nreverse result))) |
|
|
|
(defmacro defexamples (cmd &rest examples) |
|
`(add-to-list 'functions (list |
|
',cmd ;; command name |
|
(cadr (symbol-function ',cmd)) ;; signature |
|
(car (cddr (symbol-function ',cmd))) ;; docstring |
|
(examples-to-strings ',examples)))) ;; examples |
|
|
|
(defun quote-and-downcase (string) |
|
(format "`%s`" (downcase string))) |
|
|
|
(defun quote-docstring (docstring) |
|
(let (case-fold-search) |
|
(setq docstring (replace-regexp-in-string "\\b\\([A-Z][A-Z-]*[0-9]*\\)\\b" 'quote-and-downcase docstring t)) |
|
(setq docstring (replace-regexp-in-string "`\\([^ ]+\\)'" "`\\1`" docstring t))) |
|
docstring) |
|
|
|
(defun function-to-md (function) |
|
(let ((command-name (car function)) |
|
(signature (cadr function)) |
|
(docstring (quote-docstring (cadr (cdr function)))) |
|
(examples (cadr (cddr function)))) |
|
(format "### %s `%s`\n\n%s\n\n```cl\n%s\n```\n" |
|
command-name |
|
signature |
|
docstring |
|
(mapconcat 'identity (three-first examples) "\n")))) |
|
|
|
(defun function-summary (function) |
|
(let ((command-name (car function)) |
|
(signature (cadr function))) |
|
(format "%s %s" command-name signature))) |
|
|
|
(defun simplify-quotes () |
|
(goto-char (point-min)) |
|
(while (search-forward "(quote " nil t) |
|
(forward-char -7) |
|
(let ((p (point))) |
|
(forward-sexp 1) |
|
(delete-char -1) |
|
(goto-char p) |
|
(delete-char 7) |
|
(insert "'")))) |
|
|
|
(defun create-docs-file () |
|
(let ((functions (nreverse functions))) |
|
(with-temp-file "./README.md" |
|
(insert-file-contents-literally "./readme-prefix.md") |
|
(goto-char (point-max)) |
|
(newline) |
|
(insert "## Available functions") |
|
(newline 2) |
|
(insert "```cl") |
|
(newline) |
|
(insert (mapconcat 'function-summary functions "\n")) |
|
(newline) |
|
(insert "```") |
|
(newline 2) |
|
(insert "There are also anaphoric versions of these |
|
functions where that makes sense, prefixed with two bangs |
|
instead of one.") |
|
(newline 2) |
|
(insert "## Documentation and examples") |
|
(newline 2) |
|
(insert (mapconcat 'function-to-md functions "\n")) |
|
(newline) |
|
(insert-file-contents-literally "./readme-postfix.md") |
|
(simplify-quotes)))) |
|
|
|
(defun three-first (list) |
|
(let (first) |
|
(when (car list) |
|
(setq first (cons (car list) first)) |
|
(when (cadr list) |
|
(setq first (cons (cadr list) first)) |
|
(when (car (cddr list)) |
|
(setq first (cons (car (cddr list)) first))))) |
|
(nreverse first)))
|
|
|