Find file
Fetching contributors…
Cannot retrieve contributors at this time
113 lines (95 sloc) 3.49 KB
(defvar functions '())
(defun example-to-string (example)
(let ((actual (car example))
(expected (cadr (cdr example))))
"\r" "\\r"
"\t" "\\t"
"\n" "\\n"
"\\\\\\?" "?"
(format "%S ;; => %S" actual expected)) t t) t t) t t)))
(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)))
(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"
(mapconcat 'identity (three-first examples) "\n"))))
(defun split-name (s)
"Split name into list of words"
(let ((case-fold-search nil))
(replace-regexp-in-string "\\([a-z]\\)\\([A-Z]\\)" "\\1 \\2" s)))
"[^A-Za-z0-9]+" t))
(defun dashed-words (s)
"Convert string S to snake-case string."
(mapconcat 'identity (mapcar
'(lambda (word) (downcase word))
(split-name s)) "-"))
(defun github-id (command-name signature)
(dashed-words (format "%s %s" command-name signature)))
(defun function-summary (function)
(let ((command-name (car function))
(signature (cadr function)))
(format "* [%s](#%s) `%s`" command-name (github-id command-name signature) signature)))
(defun simplify-quotes ()
(goto-char (point-min))
(while (search-forward "(quote nil)" nil t)
(replace-match "'()"))
(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 goto-and-remove (s)
(goto-char (point-min))
(search-forward s)
(delete-char (- (length s))))
(defun create-docs-file ()
(let ((functions (nreverse functions)))
(with-temp-file "./"
(insert-file-contents-literally "./")
(goto-and-remove "[[ function-list ]]")
(insert (mapconcat 'function-summary functions "\n"))
(goto-and-remove "[[ function-docs ]]")
(insert (mapconcat 'function-to-md functions "\n"))
(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)))