sigil.lisp (4421 bytes)
1 ;;;; This was originally a part of StumpWM, a window manager for the X window 2 ;;;; system written in Common Lisp. As such, the original copyright message is 3 ;;;; included below. 4 ;;;; -- equwal 2020-03-26 5 6 ;;;; Copyright (C) 2007-2008 Shawn Betts 7 ;;;; 8 ;;;; stumpwm is free software; you can redistribute it and/or modify 9 ;;;; it under the terms of the GNU General Public License as published by 10 ;;;; the Free Software Foundation; either version 2, or (at your option) 11 ;;;; any later version. 12 13 ;;;; stumpwm is distributed in the hope that it will be useful, 14 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;;;; GNU General Public License for more details. 17 18 ;;;; You should have received a copy of the GNU General Public License 19 ;;;; along with this software; see the file COPYING. If not, see 20 ;;;; <http://www.gnu.org/licenses/>. 21 22 ;;;; Commentary: 23 ;;; 24 ;;; Generate documentation for sigil lines in the source, according to some 25 ;;; input documentation standard. 26 ;;; 27 ;;;; Code: 28 29 (in-package #:sigil) 30 31 (eval-when (:compile-toplevel :load-toplevel :execute) 32 (defvar *doc-fns* nil "The functions used to generate documents.") 33 (defun compile-doc (name body) 34 (concatenate 'string 35 "@" name " " body "~&@end " name "~%~%")) 36 37 (defun doc-fmt (stream name body-format &rest args) 38 "Fill in a texinfo template." 39 (apply #'format stream (compile-doc name body-format) 40 name body-format args))) 41 42 (defmacro defdoc ((macro name specializer &optional pprint custom-var custom-var-body) body) 43 "Define a document generating method." 44 (with-gensyms (os line sym var) 45 `(push (lambda (,os ,line) 46 (ppcre:register-groups-bind (,sym) 47 (,(format nil "~@{~A~}" "^" macro "(\\W)*(.*)") ,line) 48 (let* ((,var (find-symbol (string-upcase ,sym) :stumpwm)) 49 (,var (cond ((eql ',specializer 'function) 50 (symbol-function ,var)) 51 ((eql ',specializer 'macro) 52 (macro-function ,var)) 53 (t ,var))) 54 (,var `(if ,',custom-var 55 ,(let ((custom-var sym)) 56 `(progn ,,@custom-var-body)) 57 ,var))) 58 (format *debug-io* "~&Formatting manual for the ~a ~a...~&" 59 ',var ,sym) 60 (let ((*print-pretty* ,pprint)) 61 (if (member ',specializer '(function macro)) 62 (doc-fmt ,os ,name ,body 63 ,sym 64 (sb-introspect:function-lambda-list ,var) 65 (documentation ,var ',specializer)) 66 (doc-fmt ,os ,name ,body 67 ,sym 68 (documentation ,var ',specializer)))) 69 t))) 70 *doc-fns*))) 71 72 (defdoc ("@@@" "defun" function t 73 name 74 (if (find #\( name :test 'char=) 75 ;; handle (setf <symbol>) functions 76 (with-standard-io-syntax 77 (let ((*package* (find-package :stumpwm))) 78 (fdefinition (read-from-string name)))) 79 (symbol-function (find-symbol (string-upcase name) :stumpwm)))) 80 "{~a} ~{~a~^ ~}~%~a") 81 82 (defdoc ("%%%" "defmac" function) "{~a} ~{~a~^ ~}~%~a") 83 (defdoc ("###" "defvar" variable nil) "~a~%~a") 84 85 (defun generate (os line) 86 "Generate a texi.in documentation line." 87 (dolist (fn *doc-fns*) 88 (when (funcall fn os line) 89 (return-from generate))) 90 ;; Not a macro line. 91 (write-line line os)) 92 93 (defun generate-manual (&key in out (package (find-package :cl))) 94 #.(format nil "~@{~a~^~%~}" 95 "Generate the texinfo manual from the template texi.in file." 96 "IN the input file path file.texi.in" 97 "OUT the output file path file.texi" 98 "PACKAGE is the package where names are pulled from") 99 (let ((*print-case* :downcase)) 100 (with-open-file (os out :direction :output :if-exists :supersede) 101 (with-open-file (is in :direction :input) 102 (loop for line = (read-line is nil is) 103 until (eq line is) do (generate os line))))))