File: manual.lisp

package info (click to toggle)
stumpwm 1:20110819.gitca08e08-2
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 1,948 kB
  • sloc: lisp: 14,330; sh: 179; makefile: 112
file content (116 lines) | stat: -rw-r--r-- 5,925 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
;; Copyright (C) 2007-2008 Shawn Betts
;;
;;  This file is part of stumpwm.
;;
;; stumpwm is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; stumpwm is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA

;; Commentary:
;;
;; Generate the texinfo manual from docstrings in the source. Note,
;; this only works in sbcl and clisp
;;
;; Code:

(in-package :stumpwm)

#+sbcl (require :sb-introspect)

;; handy for figuring out which symbol is borking the documentation
(defun dprint (sym)
  (declare (ignorable sym))
  ;;(format t "~&Doing ~a..." sym))
)

(defun generate-function-doc (s line)
  (ppcre:register-groups-bind (name) ("^@@@ (.*)" line)
                              (dprint name)
                              (let ((fn (if (find #\( name :test 'char=)
                                            ;; handle (setf <symbol>) functions
                                            (with-standard-io-syntax
                                              (let ((*package* (find-package :stumpwm)))
                                                (fdefinition (read-from-string name))))
                                            (symbol-function (find-symbol (string-upcase name) :stumpwm))))
                                    (*print-pretty* nil))
                                (format s "@defun {~a} ~{~a~^ ~}~%~a~&@end defun~%~%"
                                        name
                                        #+sbcl (sb-introspect:function-arglist fn)
                                        #+clisp (ext:arglist fn)
                                        #- (or sbcl clisp) '("(Check the code for args list)")
                                        (documentation fn 'function))
                                t)))

(defun generate-macro-doc (s line)
  (ppcre:register-groups-bind (name) ("^%%% (.*)" line)
                              (dprint name)
                              (let* ((symbol (find-symbol (string-upcase name) :stumpwm))
                                     (*print-pretty* nil))
                                (format s "@defmac {~a} ~{~a~^ ~}~%~a~&@end defmac~%~%"
                                        name
                                        #+sbcl (sb-introspect:function-arglist (macro-function symbol))
                                        #+clisp (ext:arglist symbol)
                                        #- (or sbcl clisp) '("(Check the code for args list)")
                                        ;;; FIXME: when clisp compiles
                                        ;;; a macro it discards the
                                        ;;; documentation string! So
                                        ;;; unless when generating the
                                        ;;; manual for clisp, it is
                                        ;;; loaded and not compiled
                                        ;;; this will return NIL.
                                        #+clisp (or (documentation symbol 'function)
                                                    "Due to a bug in clisp, macro function documentation is not generated. Try building the manual using sbcl.")
                                        #-clisp (documentation symbol 'function))
                                t)))

(defun generate-variable-doc (s line)
  (ppcre:register-groups-bind (name) ("^### (.*)" line)
                              (dprint name)
                              (let ((sym (find-symbol (string-upcase name) :stumpwm)))
                                (format s "@defvar ~a~%~a~&@end defvar~%~%"
                                        name (documentation sym 'variable))
                                t)))

(defun generate-hook-doc (s line)
  (ppcre:register-groups-bind (name) ("^\\$\\$\\$ (.*)" line)
                              (dprint name)
                              (let ((sym (find-symbol (string-upcase name) :stumpwm)))
                                (format s "@defvr {Hook} ~a~%~a~&@end defvr~%~%"
                                        name (documentation sym 'variable))
                                t)))

(defun generate-command-doc (s line)
  (ppcre:register-groups-bind (name) ("^!!! (.*)" line)
                              (dprint name)
                              (let ((cmd (symbol-function (find-symbol (string-upcase name) :stumpwm))))
                                (format s "@deffn {Command} ~a ~{~a~^ ~}~%~a~&@end deffn~%~%"
                                        name
                                        #+sbcl (sb-introspect:function-arglist cmd)
                                        #+clisp (ext:arglist cmd)
                                        #- (or sbcl clisp) '("(Check the code for args list)")
                                        (documentation cmd 'function))
                                t)))

(defun generate-manual (&key (in #p"stumpwm.texi.in") (out #p"stumpwm.texi"))
  (let ((*print-case* :downcase))
    (with-open-file (os out :direction :output :if-exists :supersede)
      (with-open-file (is in :direction :input)
	(loop for line = (read-line is nil is)
	   until (eq line is) do
	     (or (generate-function-doc os line)
		 (generate-macro-doc os line)
		 (generate-hook-doc os line)
		 (generate-variable-doc os line)
		 (generate-command-doc os line)
		 (write-line line os)))))))