doc/manual/generate-texinfo.lisp

   1 (map nil #'require '("asdf" "uiop"))
   2 (asdf:initialize-source-registry
   3  '(:source-registry :ignore-inherited-configuration))
   4
   5 (with-compilation-unit ()
   6   (load "docstrings.lisp"))
   7 \f
   8 ;;;; Generating documentation strings
   9
  10 (defvar *contrib-directory* #P"../../contrib/")
  11
  12 (defvar *documented-packages*
  13   '("COMMON-LISP" "SB-ALIEN" "SB-DEBUG" "SB-EXT" "SB-GRAY" "SB-MOP"
  14     "SB-PCL" "SB-SYS" "SB-SEQUENCE" "SB-UNICODE" "SB-PROFILE"
  15     "SB-THREAD"))
  16
  17 (defun documented-contribs (&key (exclude '("asdf")))
  18   (loop for texinfo-file in (directory (merge-pathnames
  19                                         "*/*.texinfo" *contrib-directory*))
  20         for name = (car (last (pathname-directory texinfo-file)))
  21         for package = (string-upcase name)
  22         when (cond
  23                ((find name exclude :test #'string=)
  24                 nil)
  25                ((find name result :test #'string= :key #'car)
  26                 nil)
  27                (t
  28                 t))
  29         collect (cons name package) into result
  30         finally (return result)))
  31
  32 (defun generate-docstrings-texinfo (runtime
  33                                     &key (docstring-directory "docstrings/")
  34                                    (blocklist '()))
  35   (let* ((contribs (sort (documented-contribs :exclude (append '("asdf") blocklist)) #'string< :key #'car))
  36          (packages (sort (append *documented-packages*
  37                                  (map 'list #'cdr contribs))
  38                          #'string<)))
  39     (format t "/creating docstring snippets~@
  40                ~2@Tfrom SBCL=\'~A\'~@
  41                ~2@Tfor documented contribs~%~4@T~A~@
  42                ~2@Tfor packages~%~4@T~A~%"
  43             runtime (map 'list #'car contribs) packages)
  44     (map nil (lambda (contrib) (require (car contrib))) contribs)
  45     (apply #'sb-texinfo:generate-includes docstring-directory packages)))
  46 \f
  47 ;;;; Special cases: external formats list, package locks, variables.template
  48
  49 (defun replace-all (new old string)
  50   (with-output-to-string (stream)
  51     (loop with old-length = (length old)
  52        for start = 0 then (+ offset old-length)
  53        for offset = (search old string :start2 start)
  54        while offset
  55        do (write-string (subseq string start offset) stream)
  56          (write-string new stream)
  57        finally (write-string (subseq string start) stream))))
  58
  59 (defun expand-variables (&key (input-file "variables.template")
  60                            (output-file "variables.texinfo"))
  61   (format t "/expanding variables in ~A~%" output-file)
  62   (let* ((version (lisp-implementation-version))
  63          (date (multiple-value-bind (second minute hour day month year)
  64                    (decode-universal-time (get-universal-time))
  65                  (declare (ignore second minute hour day))
  66                  (format nil "~D-~2,'0D" year month)))
  67          (template (uiop:read-file-string input-file))
  68          (expanded (replace-all version "@VERSION@"
  69                                 (replace-all date "@MONTH@" template))))
  70     (with-open-file (output output-file
  71                             :direction :output
  72                             :if-exists :supersede
  73                             :if-does-not-exist :create)
  74       (write-string expanded output))))
  75
  76 (defun generate-external-format-texinfo (&optional (output-file "encodings.texi-temp"))
  77   (format t "/creating ~A~%" output-file)
  78   (with-open-file (stream output-file :direction :output :if-exists :supersede)
  79     (flet ((table (items)
  80              (format stream "@table @code~%~%")
  81              (loop for (canonical-name . names) in items
  82                 do (format stream "@item ~S~%~{@code{~S}~^, ~}~%~%"
  83                            canonical-name names))
  84              (format stream "@end table~%")))
  85       (let (result)
  86         (loop for ef across sb-impl::*external-formats*
  87               when (sb-impl::external-format-p ef)
  88               do
  89               (pushnew (sb-impl::ef-names ef) result :test #'equal))
  90         (table (sort result #'string< :key #'car))))))
  91 \f
  92 ;;;; Entry point
  93
  94 (destructuring-bind (program runtime docstring-directory blocklist) *posix-argv*
  95   (declare (ignore program))
  96   (generate-docstrings-texinfo
  97    runtime :docstring-directory docstring-directory :blocklist (uiop:split-string blocklist))
  98
  99   (expand-variables)
 100   (generate-external-format-texinfo))