skribilo-mdoc

  1;; This file implements an engine for creating mdoc(7) manual
  2;; pages using Skribilo. Semantic mdoc(7) markup is supported
  3;; through a custom Skribilo markup package.
  4;;
  5;; See https://man.openbsd.org/mdoc.7
  6
  7(define-module (skribilo engine mdoc)
  8  #:use-module (skribilo evaluator)
  9  #:use-module (skribilo lib)
 10  #:use-module (skribilo ast)
 11  #:use-module (skribilo engine)
 12  #:use-module (skribilo writer)
 13  #:use-module (skribilo utils syntax)
 14  #:use-module (skribilo utils strings)
 15  #:use-module (skribilo package base)
 16  #:use-module (skribilo output)
 17  #:autoload   (skribilo parameters)    (*destination-file*)
 18
 19  #:use-module (mdoc utils markup)
 20  #:use-module (mdoc utils output)
 21
 22  #:export (mdoc-engine))
 23
 24(skribilo-module-syntax)
 25
 26;; State to detect empty lines in filter function.
 27(define filter-prev-empty? #t)
 28
 29(define mdoc-engine
 30  (default-engine-set!
 31    (make-engine 'mdoc
 32      :version 0.1
 33      :format "mdoc"
 34      :delegate (find-engine 'base)
 35      ;; TODO: Remove the newline filtering code at some point.
 36      :filter (lambda (str)
 37                (let* ((is-empty? (equal? str "\n"))
 38                       (ret-value (if (and is-empty? filter-prev-empty?)
 39                                    ""
 40                                    (string-trim str char-set:blank))))
 41                  (set! filter-prev-empty? is-empty?)
 42                  ret-value))
 43      :custom '())))
 44
 45(make-ornament 'bold 'Sy)
 46;; TODO: 'code
 47(make-ornament 'emph 'Em)
 48(make-ornament 'it 'Em)
 49;; TODO: 'kbd
 50(make-ornament 'roman 'No)
 51;; TODO: 'sc
 52;; TODO: 'underline
 53;; TODO: 'sf
 54;; TODO: 'sub
 55;; TODO: 'sup
 56;; TODO: 'tt
 57;; TODO: 'underline
 58(make-ornament 'var 'Va)
 59
 60(make-block 'blockquote '(Bd "-literal" "-offset indent") '(Ed))
 61(make-block 'center '(Bd "-centered") '(Ed))
 62(make-block 'pre '(Bd "-literal") '(Ed))
 63;; TODO: flush
 64
 65(markup-writer 'document
 66  :options '(:title :author :ending :mdoc-desc :mdoc-date :mdoc-section :mdoc-system)
 67  :action (lambda (doc e)
 68            (set-port-encoding! (current-output-port) "UTF-8")
 69            (let ((title   (markup-option doc :title))
 70                  (desc    (markup-option doc :mdoc-desc))
 71                  (section (markup-option doc :mdoc-section))
 72                  (date    (markup-option doc :mdoc-date))
 73                  (system  (markup-option doc :mdoc-system))
 74                  (body    (markup-body doc)))
 75              (output-preamble e
 76                (if (string? title)
 77                  title
 78                  (ast->string title))
 79                (or date "$Mdocdate$")
 80                (or section
 81                    (begin
 82                      (skribe-warning 1 "mdoc section not defined, defaulting to '1'")
 83                      1))
 84                system)
 85
 86              (output-section e "name")
 87              (output-macro e 'Nm title)
 88              (if desc
 89                (output-macro e 'Nd desc)
 90                (skribe-warning 1 "mdoc one-line description is missing"))
 91
 92              (output body e)
 93              (output-newline e))))
 94
 95(markup-writer 'paragraph
 96  :before (lambda (n e)
 97            (output-macro e 'Pp))
 98  :after  (lambda (n e)
 99            (output-newline e)))
100
101(markup-writer 'section
102  :options '(:title :number :file :toc)
103  :action (lambda (n e)
104            (let ((body  (markup-body n))
105                  (title (markup-option n :title)))
106              (output-section e (ast->string title))
107              (output body e))))
108
109(make-listing 'itemize "-tag" "-width Ds")
110(make-listing 'enumerate "-enum")
111;; TODO: description
112
113(markup-writer 'item
114   :options '(:key)
115   :action (lambda (n e)
116             (let ((k (markup-option n :key)))
117               (if k
118                 (with-parsed-macro (e 'It)
119                   (evaluate-document k e))
120                 (output-macro e 'It)))
121             (evaluate-document (markup-body n) e)))
122
123(make-macro 'mark 'Tg)
124(make-macro 'mailto 'Mt '(:text))
125
126;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
127
128(markup-writer 'man-name
129  :action (lambda (n e)
130            (output-macro e 'Nm)))
131
132(make-parsed-macro 'man-arg 'Ar)
133(make-parsed-macro 'man-flags 'Fl)
134(make-parsed-macro 'man-opt 'Op)