From 8e0448d1a0b2590453935e457d9f7de4a6d32502 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Fri, 1 Sep 2006 15:58:59 +0000
Subject: Turned `doc/skr' into `doc/modules', `skribe-load' into
`use-modules'.
git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-54
---
doc/modules/Makefile.am | 3 +
doc/modules/skribilo/Makefile.am | 3 +
doc/modules/skribilo/documentation/Makefile.am | 3 +
doc/modules/skribilo/documentation/api.scm | 621 +++++++++++++++++++++++
doc/modules/skribilo/documentation/env.scm | 47 ++
doc/modules/skribilo/documentation/extension.scm | 111 ++++
doc/modules/skribilo/documentation/manual.scm | 328 ++++++++++++
7 files changed, 1116 insertions(+)
create mode 100644 doc/modules/Makefile.am
create mode 100644 doc/modules/skribilo/Makefile.am
create mode 100644 doc/modules/skribilo/documentation/Makefile.am
create mode 100644 doc/modules/skribilo/documentation/api.scm
create mode 100644 doc/modules/skribilo/documentation/env.scm
create mode 100644 doc/modules/skribilo/documentation/extension.scm
create mode 100644 doc/modules/skribilo/documentation/manual.scm
(limited to 'doc/modules')
diff --git a/doc/modules/Makefile.am b/doc/modules/Makefile.am
new file mode 100644
index 0000000..1daf926
--- /dev/null
+++ b/doc/modules/Makefile.am
@@ -0,0 +1,3 @@
+SUBDIRS = skribilo
+
+## arch-tag: 9c90dd7b-0ee7-44b9-ab41-5283d1bf1fb9
diff --git a/doc/modules/skribilo/Makefile.am b/doc/modules/skribilo/Makefile.am
new file mode 100644
index 0000000..71e8c64
--- /dev/null
+++ b/doc/modules/skribilo/Makefile.am
@@ -0,0 +1,3 @@
+SUBDIRS = documentation
+
+## arch-tag: af599d8d-2e67-49b3-afdf-aa2dba5a7c4a
diff --git a/doc/modules/skribilo/documentation/Makefile.am b/doc/modules/skribilo/documentation/Makefile.am
new file mode 100644
index 0000000..1562b0a
--- /dev/null
+++ b/doc/modules/skribilo/documentation/Makefile.am
@@ -0,0 +1,3 @@
+EXTRA_DIST = api.scm env.scm extension.scm manual.scm
+
+## arch-tag: 171ec210-e895-42ce-b068-da10ed5c2551
diff --git a/doc/modules/skribilo/documentation/api.scm b/doc/modules/skribilo/documentation/api.scm
new file mode 100644
index 0000000..d27d074
--- /dev/null
+++ b/doc/modules/skribilo/documentation/api.scm
@@ -0,0 +1,621 @@
+;;; api.scm -- The style for documenting Scheme APIs.
+;;;
+;;; Copyright 2003, 2004 Manuel Serrano
+;;; Copyright 2005, 2006 Ludovic Court�s <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program 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 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo documentation api)
+ :use-module (skribilo reader)
+ :use-module (skribilo engine)
+ :use-module (skribilo writer)
+ :use-module (skribilo ast)
+ :use-module (skribilo output)
+ :use-module (skribilo lib) ;; `define-markup'
+ :use-module (skribilo utils keywords)
+ :use-module (skribilo utils compat)
+ :use-module (skribilo utils syntax) ;; `%skribilo-module-reader'
+
+ :use-module (skribilo package base)
+ :use-module (skribilo documentation manual) ;; `*markup-index*'
+ :use-module (skribilo documentation env) ;; `*api-engines*'
+
+ :use-module (srfi srfi-1)
+ :use-module (ice-9 match)
+ :use-module (ice-9 optargs))
+
+(fluid-set! current-reader (make-reader 'skribe))
+
+
+;*---------------------------------------------------------------------*/
+;* Html configuration */
+;*---------------------------------------------------------------------*/
+(let* ((he (find-engine 'html))
+ (tro (markup-writer-get 'tr he)))
+ (markup-writer 'tr he
+ :class 'api-table-header
+ :options '(:width :bg)
+ :action (lambda (n e)
+ (let ((c (engine-custom e 'section-title-background)))
+ (markup-option-add! n :bg c)
+ (output n e tro))))
+ (markup-writer 'tr he
+ :class 'api-table-prototype
+ :options '(:width :bg)
+ :action (lambda (n e)
+ (let ((c (engine-custom e 'title-background)))
+ (markup-option-add! n :bg c)
+ (output n e tro))))
+ (markup-writer 'tr he
+ :class 'api-symbol-prototype
+ :options '(:width :bg)
+ :action (lambda (n e)
+ (let ((c (engine-custom e 'title-background)))
+ (markup-option-add! n :bg c)
+ (output n e tro)))))
+
+;*---------------------------------------------------------------------*/
+;* LaTeX configuration */
+;*---------------------------------------------------------------------*/
+(let* ((le (find-engine 'latex))
+ (tro (markup-writer-get 'tr le)))
+ (markup-writer 'tr le
+ :class 'api-table-prototype
+ :options '(:width :bg)
+ :action #f)
+ (markup-writer 'tr le
+ :class 'api-table-header
+ :options '(:width :bg)
+ :action (lambda (n e)
+ (let ((c (engine-custom e 'section-title-background)))
+ (markup-option-add! n :bg c)
+ (output n e tro)))))
+
+;*---------------------------------------------------------------------*/
+;* api-search-definition ... */
+;* ------------------------------------------------------------- */
+;* Find a definition inside a source file. */
+;*---------------------------------------------------------------------*/
+(define* (api-search-definition id file pred :optional (skribe-source? #t))
+ ;; If SKRIBE-SOURCE? is true, then assume Skribe syntax. Otherwise, use
+ ;; the ``Skribilo module syntax''.
+ (let* ((path (append %load-path (skribe-path)))
+ (f (find-file/path file path))
+ (read (if skribe-source? (make-reader 'skribe)
+ %skribilo-module-reader)))
+ (if (not (string? f))
+ (skribe-error 'api-search-definition
+ (format #f "can't find source file `~a' in path"
+ file)
+ path)
+ (with-input-from-file f
+ (lambda ()
+ (let loop ((exp (read)))
+ (if (eof-object? exp)
+ (skribe-error 'api-search-definition
+ (format #f
+ "can't find `~a' definition" id)
+ file)
+ (or (pred id exp) (loop (read))))))))))
+
+;*---------------------------------------------------------------------*/
+;* api-compare-set ... */
+;* ------------------------------------------------------------- */
+;* This function compares two sets. It returns either #t */
+;* is they are equal, or two subsets which contain elements */
+;* not present in the arguments. For instance: */
+;* (api-compare-set '(foo bar) '(bar foo)) ==> #t */
+;* (api-compare-set '(foo gee) '(gee bar)) ==> '((foo) (bar)) */
+;*---------------------------------------------------------------------*/
+(define (api-compare-set s1 s2)
+ (let ((d1 (filter (lambda (x) (not (memq x s2))) s1))
+ (d2 (filter (lambda (x) (not (memq x s1))) s2)))
+ (or (and (null? d1) (null? d2))
+ (list d1 d2))))
+
+
+;*---------------------------------------------------------------------*/
+;* define-markup? ... */
+;*---------------------------------------------------------------------*/
+(define (define-markup? id o)
+ (match o
+ (((or 'define-markup 'define 'define* 'define-public 'define*-public)
+ ((? (lambda (x) (eq? x id)))
+ . (? (lambda (x) (or (pair? x) (null? x)))))
+ . _)
+ o)
+ (('define-simple-markup (? (lambda (x) (eq? x id))))
+ o)
+ (('define-simple-container (? (lambda (x) (eq? x id))))
+ o)
+ (else
+ #f)))
+
+;*---------------------------------------------------------------------*/
+;* make-engine? ... */
+;*---------------------------------------------------------------------*/
+(define (make-engine? id o)
+ ;(format #t "make-engine? ~a ~a~%" id o)
+ (match o
+ (((or 'make-engine 'copy-engine) ('quote sym) . rest)
+ (if (eq? sym id)
+ o
+ #f))
+ ((exp ___)
+ (let loop ((exp exp))
+ (cond ((null? exp)
+ #f)
+ ((pair? exp)
+ (or (make-engine? id (car exp))
+ (make-engine? id (cdr exp))))
+ (else
+ (make-engine? id exp)))))
+ (else
+ #f)))
+
+;*---------------------------------------------------------------------*/
+;* make-engine-custom ... */
+;*---------------------------------------------------------------------*/
+(define (make-engine-custom def)
+ (let ((customs (memq :custom def)))
+ (match (if customs (cdr customs) #f)
+ ((((or 'quote 'quasiquote) custom) _ ___)
+ custom)
+ (((custom) _ ___)
+ (primitive-eval custom))
+ (else
+ '()))))
+
+(define (sym/kw? x)
+ (or (symbol? x) (keyword? x)))
+
+;*---------------------------------------------------------------------*/
+;* define-markup-formals ... */
+;* ------------------------------------------------------------- */
+;* Returns the formal parameters of a define-markup (not the */
+;* options). */
+;*---------------------------------------------------------------------*/
+(define (define-markup-formals def)
+ (match def
+ ((_ (id args ___) _ ___)
+ (let loop ((args args)
+ (res '()))
+ (cond
+ ((null? args)
+ (reverse! res))
+ ((symbol? args)
+ (reverse! (cons args res)))
+ ((not (symbol? (car args)))
+ (reverse! res))
+ (else
+ (loop (cdr args) (cons (car args) res))))))
+ (('define-simple-markup _)
+ '())
+ (('define-simple-container _)
+ '())
+ (else
+ (skribe-error 'define-markup-formals
+ "Illegal `define-markup' form"
+ def))))
+
+;*---------------------------------------------------------------------*/
+;* define-markup-options ... */
+;* ------------------------------------------------------------- */
+;* Returns the options parameters of a define-markup. */
+;*---------------------------------------------------------------------*/
+(define (define-markup-options def)
+ (match def
+ ((_ (args ___) _ ___)
+ (if (not (list? args))
+ '()
+ (let ((keys (memq #!key args)))
+ (if (pair? keys)
+ (cdr keys) ;; FIXME: do we need to filter ((key val)...)?
+ '()))))
+ (('define-simple-markup _)
+ '((ident #f) (class #f)))
+ (('define-simple-container _)
+ '((ident #f) (class #f)))
+ (else
+ (skribe-error 'define-markup-options
+ "Illegal `define-markup' form"
+ def))))
+
+;*---------------------------------------------------------------------*/
+;* define-markup-rest ... */
+;* ------------------------------------------------------------- */
+;* Returns the rest parameter of a define-markup. */
+;*---------------------------------------------------------------------*/
+(define (define-markup-rest def)
+ (match def
+ ((_ (args ___) _)
+ (if (not (pair? args))
+ args
+ (let ((l (last-pair args)))
+ (if (symbol? (cdr l))
+ (cdr l)
+ (let ((rest (memq #!rest args)))
+ (if (pair? rest)
+ (if (or (not (pair? (cdr rest)))
+ (not (symbol? (cadr rest))))
+ (skribe-error 'define-markup-rest
+ "Illegal `define-markup' form"
+ def)
+ (cadr rest))
+ #f))))))
+ (('define-simple-markup _)
+ 'node)
+ (('define-simple-container _)
+ 'node)
+ (else
+ (skribe-error 'define-markup-rest
+ "Illegal `define-markup' form"
+ def))))
+
+;*---------------------------------------------------------------------*/
+;* doc-check-arguments ... */
+;*---------------------------------------------------------------------*/
+(define (doc-check-arguments id args dargs)
+ (if (not args)
+ (skribe-error 'doc-check-arguments id args))
+ (if (not dargs)
+ (skribe-error 'doc-check-arguments id dargs))
+ (let* ((s1 (map (lambda (x) (if (pair? x) (car x) x)) args))
+ (s2 (map (lambda (x)
+ (let ((i (car x)))
+ (if (keyword? i)
+ (keyword->symbol i)
+ i)))
+ dargs))
+ (d (api-compare-set s1 s2)))
+ (if (pair? d)
+ (let ((d1 (car d))
+ (d2 (cadr d)))
+ (if (pair? d1)
+ (skribe-error 'doc-markup
+ (format #f "~a: missing descriptions" id)
+ d1)
+ (skribe-error 'doc-markup
+ (format #f "~a: extra descriptions" id)
+ d2))))))
+
+;*---------------------------------------------------------------------*/
+;* exp->skribe ... */
+;*---------------------------------------------------------------------*/
+(define (exp->skribe exp)
+ (cond
+ ((number? exp) exp)
+ ((string? exp) (string-append "\"" exp "\""))
+ ((eq? exp #f) "#f")
+ ((eq? exp #t) "#t")
+ ((symbol? exp) (symbol->string exp))
+ ((equal? exp '(quote ())) "'()")
+ ((ast? exp)
+ (table :cellpadding 0 :cellspacing 0
+ (tr (td :align 'left exp))))
+ (else
+ (match exp
+ ((quote (and ?sym (? symbol?)))
+ (string-append "'" (symbol->string sym)))
+ (else
+ (with-output-to-string (lambda () (write exp))))))))
+
+;*---------------------------------------------------------------------*/
+;* doc-markup-proto ... */
+;*---------------------------------------------------------------------*/
+(define (doc-markup-proto id options formals rest)
+ (define (option opt)
+ (if (pair? opt)
+ (if (eq? (cadr opt) #f)
+ (list " [" (keyword (car opt)) "]")
+ (list " [" (keyword (car opt)) " "
+ (code (exp->skribe (cadr opt))) "]"))
+ (list " " (keyword opt))))
+ (define (formal f)
+ (list " " (param f)))
+ (code (list (bold "(") (bold :class 'api-proto-ident
+ (format #f "~a" id)))
+ (map option (sort options
+ (lambda (s1 s2)
+ (cond
+ ((and (pair? s1) (not (pair? s2)))
+ #f)
+ ((and (pair? s2) (not (pair? s1)))
+ #t)
+ (else
+ #t)))))
+ (if (pair? formals)
+ (map formal formals))
+ (if rest (list " " (param rest)))
+ (bold ")")))
+
+;*---------------------------------------------------------------------*/
+;* doc-markup ... */
+;*---------------------------------------------------------------------*/
+(define-markup (doc-markup id args
+ #!rest
+ opts
+ #!key
+ (writer-id #f)
+ (common-args '((:ident "The node identifier.")
+ (:class "The node class.")))
+ (ignore-args '(&skribe-eval-location))
+ (force-args '())
+ (idx *markup-index*)
+ (idx-note "definition")
+ (idx-suffix #f)
+ (source "skribilo/package/base.scm")
+ (def #f)
+ (see-also '())
+ (others '())
+ (force-engines '())
+ (engines *api-engines*)
+ (sui #f)
+ (skribe-source? #t)
+ &skribe-eval-location)
+ (define (opt-engine-support opt)
+ ;; find the engines providing a writer for id
+ (map (lambda (e)
+ (let* ((id (engine-ident e))
+ (s (symbol->string id)))
+ (if (engine-format? "latex")
+ (list s " ")
+ (list (if sui
+ (ref :skribe sui
+ :mark (string-append s "-engine")
+ :text s)
+ (ref :mark (string-append s "-engine")
+ :text s))
+ " "))))
+ (if (pair? force-engines)
+ force-engines
+ (filter (lambda (e)
+ (or (memq opt '(:ident :class))
+ (memq opt force-args)
+ (let ((w (markup-writer-get (or writer-id id)
+ e)))
+ (cond
+ ((not (writer? w))
+ #f)
+ (else
+ (let ((o (writer-options w)))
+ (cond
+ ((eq? o 'all)
+ #t)
+ ((not (pair? o))
+ #f)
+ (else
+ (memq opt o)))))))))
+ engines))))
+ (cond
+ ((and def source)
+ (skribe-error 'doc-markup "source and def both specified" id))
+ ((and (not def) (not source))
+ (skribe-error 'doc-markup "source or def must be specified" id))
+ (else
+ (let* ((d (or def (api-search-definition id source define-markup?
+ skribe-source?)))
+ (od (map (lambda (o)
+ (api-search-definition o source define-markup?
+ skribe-source?))
+ others))
+ (args (append common-args args))
+ (formals (define-markup-formals d))
+ (fformals (filter (lambda (s)
+ (let ((c (assq s args)))
+ (not
+ (and (pair? c)
+ (eq? (cadr c) 'ignore)))))
+ formals))
+ (options (filter (lambda (s)
+ (not (memq s ignore-args)))
+ (define-markup-options d)))
+ (dformals (filter (lambda (x)
+ (symbol? (car x)))
+ args))
+ (doptions (filter (lambda (x)
+ (and (keyword? (car x))
+ ;; useful for STklos only
+ (not (eq? (car x) #!rest))))
+ args))
+ (drest (filter (lambda (x)
+ (eq? #!rest (car x)))
+ args))
+ (dargs (and (pair? drest) (cadr (car drest))))
+ (p+ (cons (doc-markup-proto id options fformals dargs)
+ (map (lambda (id def)
+ (doc-markup-proto
+ id
+ (define-markup-options def)
+ (define-markup-formals def)
+ dargs))
+ others od))))
+ ;; doc table
+ (define (doc-markup.html)
+ (let ((df (map (lambda (f)
+ (tr :bg *prgm-skribe-color*
+ (td :colspan 2 :width 20. :align 'left
+ (param (car f)) )
+ (td :align 'left :width 80. (cadr f))))
+ dformals))
+ (dr (and (pair? drest)
+ (tr :bg *prgm-skribe-color*
+ (td :align 'left
+ :valign 'top
+ :colspan 2
+ :width 20.
+ (param (cadr (car drest))))
+ (td :align 'left :width 80.
+ (caddr (car drest))))))
+ (do (map (lambda (f)
+ (tr :bg *prgm-skribe-color*
+ (td :align 'left
+ :valign 'top
+ :width 10.
+ (param (car f)))
+ (td :align 'left
+ :valign 'top
+ :width 20.
+ (opt-engine-support (car f)))
+ (td :align 'left :width 70. (cadr f))))
+ doptions))
+ (so (map (lambda (x)
+ (let ((s (symbol->string x)))
+ (list
+ (ref :mark s :text (code s))
+ " ")))
+ see-also)))
+ (table :border (if (engine-format? "latex") 1 0)
+ :width (if (engine-format? "latex") #f *prgm-width*)
+ `(,(tr :class 'api-table-prototype
+ (th :colspan 3 :align 'left :width *prgm-width*
+ "prototype"))
+ ,@(map (lambda (p)
+ (tr :bg *prgm-skribe-color*
+ (td :colspan 3 :width *prgm-width*
+ :align 'left p)))
+ p+)
+ ,@(if (pair? do)
+ `(,(tr :class 'api-table-header
+ (th :align 'left "option"
+ :width 10.)
+ (th :align 'center "engines"
+ :width 20.)
+ (th "description"))
+ ,@do)
+ '())
+ ,@(if (or (pair? df) dr)
+ `(,(tr :class 'api-table-header
+ (th :colspan 2
+ :align 'left
+ :width 30.
+ "argument")
+ (th "description"))
+ ,@(if (pair? df) df '())
+ ,@(if dr (list dr) '()))
+ '())
+ ,@(if (pair? so)
+ `(,(tr :class 'api-table-header
+ (th :colspan 3 :align 'left
+ (it "See also")))
+ ,(tr :bg *prgm-skribe-color*
+ (td :colspan 3 :align 'left so)))
+ '())))))
+ ;; doc enumerate
+ (define (doc-markup.latex)
+ (let ((df (map (lambda (f)
+ (item :key (param (car f)) (cadr f)))
+ dformals))
+ (dr (if (pair? drest)
+ (list (item :key (param (cadr (car drest)))
+ (caddr (car drest))))
+ '()))
+ (do (map (lambda (f)
+ (item :key (param (car f))
+ (list (opt-engine-support (car f))
+ (cadr f))))
+ doptions))
+ (so (map (lambda (x)
+ (let ((s (symbol->string x)))
+ (list
+ (ref :mark s :page #t
+ :text [,(code s), p.])
+ " ")))
+ see-also)))
+ (list (center
+ (frame :margin 5 :border 0 :width *prgm-width*
+ (color :class 'api-table-prototype
+ :margin 5 :width 100. :bg "#ccccff"
+ p+)))
+ (when (pair? do)
+ (subsubsection :title "Options" :number #f :toc #f
+ (description do)))
+ (when (or (pair? df) (pair? dr))
+ (subsubsection :title "Parameters" :number #f :toc #f
+ (description (append df dr))))
+ (when (pair? so)
+ (subsubsection :title "See also" :number #f :toc #f
+ (p so)
+ (! "\\noindent"))))))
+ ;; check all the descriptions
+ (doc-check-arguments id formals dformals)
+ (doc-check-arguments id options doptions)
+ (if (and (pair? drest) (not (define-markup-rest d)))
+ (skribe-error 'doc-markup "No rest argument for" id)
+ options)
+ (list (mark :class "public-definition" (symbol->string id))
+ (map (lambda (i) (mark (symbol->string i))) others)
+ (map (lambda (i)
+ (let ((is (symbol->string i)))
+ (index (if (string? idx-suffix)
+ (string-append is idx-suffix)
+ is)
+ :index idx
+ :note idx-note)))
+ (cons id others))
+ (cond
+ ((engine-format? "latex")
+ (doc-markup.latex))
+ (else
+ (center (doc-markup.html)))))))))
+
+;*---------------------------------------------------------------------*/
+;* doc-engine ... */
+;*---------------------------------------------------------------------*/
+(define-markup (doc-engine id args
+ #!rest
+ opts
+ #!key
+ (idx *custom-index*)
+ source
+ (skribe-source? #t)
+ (def #f))
+ (cond
+ ((and def source)
+ (skribe-error 'doc-engine "source and def both specified" id))
+ ((and (not def) (not source))
+ (skribe-error 'doc-engine "source or def must be specified" id))
+ (else
+ (let* ((d (or def (api-search-definition id source make-engine?
+ skribe-source?)))
+ (c (make-engine-custom d)))
+ (doc-check-arguments id c args)
+ (cond
+ ((engine-format? "latex")
+ #f)
+ (else
+ (center
+ (apply table
+ :width *prgm-width*
+ (tr :class 'api-table-header
+ (th :align 'left :width 20. "custom")
+ (th :width 10. "default")
+ (th "description"))
+ (map (lambda (r)
+ (tr :bg *prgm-skribe-color*
+ (td :align 'left :valign 'top
+ (list (index (symbol->string (car r))
+ :index idx
+ :note (format #f "~a custom"
+ id))
+ (symbol->string (car r))))
+ (let ((def (assq (car r) c)))
+ (td :valign 'top
+ (code (exp->skribe (cadr def)))))
+ (td :align 'left :valign 'top (cadr r))))
+ (filter cadr args))))))))))
+
diff --git a/doc/modules/skribilo/documentation/env.scm b/doc/modules/skribilo/documentation/env.scm
new file mode 100644
index 0000000..569f194
--- /dev/null
+++ b/doc/modules/skribilo/documentation/env.scm
@@ -0,0 +1,47 @@
+;;; env.scm -- The environment variables for the documentation.
+;;;
+;;; Copyright 2003, 2004 Manuel Serrano
+;;; Copyright 2005, 2006 Ludovic Court�s <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program 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 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo documentation env)
+ :use-module (skribilo config)
+ :use-module (skribilo engine))
+
+(define-public *serrano-url* "http://www.inria.fr/mimosa/Manuel.Serrano")
+(define-public *serrano-mail* "Manuel.Serrano@sophia.inria.fr")
+(define-public *courtes-mail* "ludovic.courtes@laas.fr")
+(define-public *html-url* "http://www.w3.org/TR/html4")
+(define-public *html-form* "interact/forms.html")
+(define-public *emacs-url* "http://www.gnu.org/software/emacs")
+(define-public *xemacs-url* "http://www.xemacs.org")
+(define-public *texinfo-url* "http://www.texinfo.org")
+(define-public *r5rs-url* "http://www.inria.fr/mimosa/fp/Bigloo/doc/r5rs.html")
+(define-public *bigloo-url* "http://www.inria.fr/mimosa/fp/Bigloo")
+(define-public *skribe-user-doc-url* (string-append (skribe-doc-dir) "/user.html"))
+(define-public *skribe-dir-doc-url* (string-append (skribe-doc-dir) "/dir.html"))
+
+(define-public *prgm-width* 97.)
+(define-public *prgm-skribe-color* "#ffffcc")
+(define-public *prgm-default-color* "#ffffcc")
+(define-public *prgm-xml-color* "#ffcccc")
+(define-public *prgm-example-color* "#ccccff")
+(define-public *disp-color* "#ccffcc")
+(define-public *header-color* "#cccccc")
+
+(define-public *api-engines* (map find-engine '(html latex xml)))
diff --git a/doc/modules/skribilo/documentation/extension.scm b/doc/modules/skribilo/documentation/extension.scm
new file mode 100644
index 0000000..e012cb2
--- /dev/null
+++ b/doc/modules/skribilo/documentation/extension.scm
@@ -0,0 +1,111 @@
+;;; extension.scm -- The Skribe package for documenting extensions
+;;;
+;;; Copyright 2003, 2004 Manuel Serrano
+;;;
+;;;
+;;; This program 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 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo documentation extension)
+ :use-module (skribilo reader)
+ :use-module (skribilo utils compat))
+
+(fluid-set! current-reader (make-reader 'skribe))
+
+
+;*---------------------------------------------------------------------*/
+;* extension */
+;*---------------------------------------------------------------------*/
+(define-markup (extension #!rest opt
+ #!key (ident (symbol->string (gensym 'extension)))
+ (class "extension")
+ title html-title ending author description
+ (env '()))
+ (new document
+ (markup 'extension)
+ (ident ident)
+ (class class)
+ (options (the-options opt))
+ (body (the-body opt))
+ (env (append env
+ (list (list 'example-counter 0) (list 'example-env '())
+ (list 'chapter-counter 0) (list 'chapter-env '())
+ (list 'section-counter 0) (list 'section-env '())
+ (list 'footnote-counter 0) (list 'footnote-env '())
+ (list 'figure-counter 0) (list 'figure-env '()))))))
+
+;*---------------------------------------------------------------------*/
+;* html engine */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+ (engine-custom-set! he 'web-book-main-browsing-extra
+ (lambda (n e)
+ (let ((i (let ((m (find-markup-ident "Index")))
+ (and (pair? m) (car m)))))
+ (if (not i)
+ (table :width 100. :border 0 :cellspacing 0 :cellpadding 0
+ (tr (td :align 'left :valign 'top (bold "Skribe: "))
+ (td :align 'right :valign 'top
+ (ref :url *skribe-dir-doc-url*
+ :text "Directory")))
+ (tr (td)
+ (td :align 'right :valign 'top
+ (ref :url *skribe-user-doc-url*
+ :text "User Manual"))))
+ (table :width 100. :border 0 :cellspacing 0 :cellpadding 0
+ (tr (td :align 'left :valign 'top (bold "index:"))
+ (td :align 'right (ref :handle (handle i))))
+ (tr (td :align 'left :valign 'top (bold "Skribe: "))
+ (td :align 'right :valign 'top
+ (ref :url *skribe-dir-doc-url*
+ :text "Directory")))
+ (tr (td)
+ (td :align 'right :valign 'top
+ (ref :url *skribe-user-doc-url*
+ :text "User Manual"))))))))
+ (default-engine-set! he))
+
+;*---------------------------------------------------------------------*/
+;* extension-sui ... */
+;*---------------------------------------------------------------------*/
+(define (extension-sui n e)
+ (define (sui)
+ (display "(sui \"")
+ (skribe-eval (markup-option n :title) html-title-engine)
+ (display "\"\n")
+ (printf " :file ~s\n" (sui-referenced-file n e))
+ (printf " :description ~s\n" (markup-option n :description))
+ (sui-marks n e)
+ (display " )\n"))
+ (if (string? *skribe-dest*)
+ (let ((f (format "~a.sui" (prefix *skribe-dest*))))
+ (with-output-to-file f sui))
+ (sui)))
+
+;*---------------------------------------------------------------------*/
+;* project ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'extension
+ :options '(:title :html-title :ending :author :description)
+ :action (lambda (n e)
+ (output n e (markup-writer-get 'document he)))
+ :after (lambda (n e)
+ (if (engine-custom e 'emit-sui)
+ (extension-sui n e))))
+
+;*---------------------------------------------------------------------*/
+;* Restore the base engine */
+;*---------------------------------------------------------------------*/
+(default-engine-set! (find-engine 'base))
diff --git a/doc/modules/skribilo/documentation/manual.scm b/doc/modules/skribilo/documentation/manual.scm
new file mode 100644
index 0000000..f2a6cdd
--- /dev/null
+++ b/doc/modules/skribilo/documentation/manual.scm
@@ -0,0 +1,328 @@
+;;; manual.scm -- Skribe manuals and documentation pages style
+;;;
+;;; Copyright 2003, 2004 Manuel Serrano
+;;;
+;;;
+;;; This program 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 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo documentation manual)
+ :use-module (skribilo reader)
+ :use-module (skribilo engine)
+ :use-module (skribilo writer)
+ :use-module (skribilo ast)
+ :use-module (skribilo lib) ;; `define-markup'
+ :use-module (skribilo resolve)
+ :use-module (skribilo output)
+ :use-module (skribilo utils keywords)
+ :use-module (skribilo utils compat)
+ :use-module (skribilo utils syntax) ;; `when'
+
+ :use-module (skribilo documentation env)
+ :use-module (skribilo package base)
+ :use-module (skribilo prog)
+ :use-module (skribilo coloring lisp)
+ :use-module (skribilo coloring xml)
+
+ :use-module (ice-9 optargs))
+
+(fluid-set! current-reader (make-reader 'skribe))
+
+
+;*---------------------------------------------------------------------*/
+;* The various indexes */
+;*---------------------------------------------------------------------*/
+(define-public *markup-index* (make-index "markup"))
+(define-public *custom-index* (make-index "custom"))
+(define-public *function-index* (make-index "function"))
+(define-public *package-index* (make-index "package"))
+
+;*---------------------------------------------------------------------*/
+;* Base configuration */
+;*---------------------------------------------------------------------*/
+(let ((be (find-engine 'base)))
+ (markup-writer 'example be
+ :options '(:legend :number)
+ :action (lambda (n e)
+ (let ((ident (markup-ident n))
+ (number (markup-option n :number))
+ (legend (markup-option n :legend)))
+ (skribe-eval (mark ident) e)
+ (skribe-eval (center
+ (markup-body n)
+ (if number
+ (bold (format #f "Ex. ~a: " number)))
+ legend)
+ e)))))
+
+;*---------------------------------------------------------------------*/
+;* html-browsing-extra ... */
+;*---------------------------------------------------------------------*/
+(define (html-browsing-extra n e)
+ (let ((i1 (let ((m (find-markup-ident "Index")))
+ (and (pair? m) (car m))))
+ (i2 (let ((m (find-markup-ident "markups-index")))
+ (and (pair? m) (car m)))))
+ (cond
+ ((not i1)
+ (skribe-error 'left-margin "Can't find section" "Index"))
+ ((not i2)
+ (skribe-error 'left-margin "Can't find chapter" "Standard Markups"))
+ (else
+ (table :width 100.
+ :border 0
+ :cellspacing 0 :cellpadding 0
+ (tr (td :align 'left :valign 'top (bold "index:"))
+ (td :align 'right (ref :handle (handle i1) :text "Global")))
+ (tr (td :align 'left :valign 'top (bold "markups:"))
+ (td :align 'right (ref :handle (handle i2) :text "Index")))
+ (tr (td :align 'left :valign 'top (bold "extensions:"))
+ (td :align 'right (ref :url *skribe-dir-doc-url*
+ :text "Directory"))))))))
+
+;*---------------------------------------------------------------------*/
+;* Html configuration */
+;*---------------------------------------------------------------------*/
+(let* ((he (find-engine 'html))
+ (bd (markup-writer-get 'bold he)))
+ (markup-writer 'bold he
+ :class 'api-proto-ident
+ :before "<font color=\"red\">"
+ :action (lambda (n e) (output n e bd))
+ :after "</font>")
+ (engine-custom-set! he 'web-book-main-browsing-extra html-browsing-extra)
+ (engine-custom-set! he 'favicon "lambda.gif"))
+
+;*---------------------------------------------------------------------*/
+;* LaTeX */
+;*---------------------------------------------------------------------*/
+(let* ((le (find-engine 'latex))
+ (opckg (engine-custom le 'usepackage))
+ (lpckg "\\usepackage{fullpage}\n\\usepackage{eurosym}\n")
+ (npckg (if (string? opckg)
+ (string-append lpckg opckg)
+ lpckg)))
+ (engine-custom-set! le 'documentclass "\\documentclass{book}")
+ (engine-custom-set! le 'usepackage npckg))
+
+;*---------------------------------------------------------------------*/
+;* prgm ... */
+;*---------------------------------------------------------------------*/
+(define-markup (prgm #!rest opts #!key (language skribe) (line #f) (file #f) (definition #f))
+ (let* ((c (cond
+ ((eq? language skribe) *prgm-skribe-color*)
+ ((eq? language xml) *prgm-xml-color*)
+ (else *prgm-default-color*)))
+ (sc (cond
+ ((and file definition)
+ (source :language language :file file :definition definition))
+ (file
+ (source :language language :file file))
+ (else
+ (source :language language (the-body opts)))))
+ (pr (cond
+ (line
+ (prog :line line sc))
+ (else
+ (pre sc)))))
+ (center
+ (frame :margin 5 :border 0 :width *prgm-width*
+ (color :margin 5 :width 100. :bg c pr)))))
+
+;*---------------------------------------------------------------------*/
+;* disp ... */
+;*---------------------------------------------------------------------*/
+(define-markup (disp #!rest opts #!key (verb #f) (line #f) (bg *disp-color*))
+ (if (engine-format? "latex")
+ (if verb
+ (pre (the-body opts))
+ (the-body opts))
+ (center
+ (frame :margin 5 :border 0 :width *prgm-width*
+ (color :margin 5 :width 100. :bg bg
+ (if verb
+ (pre (the-body opts))
+ (the-body opts)))))))
+
+;*---------------------------------------------------------------------*/
+;* keyword ... */
+;*---------------------------------------------------------------------*/
+(define-markup (keyword arg)
+ (new markup
+ (markup '&source-key)
+ (body (cond
+ ((keyword? arg)
+ (with-output-to-string
+ (lambda ()
+ (write arg))))
+ ((symbol? arg)
+ (string-append ":" (symbol->string arg)))
+ (else
+ arg)))))
+
+;*---------------------------------------------------------------------*/
+;* param ... */
+;*---------------------------------------------------------------------*/
+(define-markup (param arg)
+ (cond
+ ((keyword? arg)
+ (keyword arg))
+ ((symbol? arg)
+ (code (symbol->string arg)))
+ (else
+ arg)))
+
+;*---------------------------------------------------------------------*/
+;* example ... */
+;*---------------------------------------------------------------------*/
+(define-markup (example #!rest opts #!key legend class)
+ (new container
+ (markup 'example)
+ (ident (symbol->string (gensym 'example)))
+ (class class)
+ (required-options '(:legend :number))
+ (options `((:number
+ ,(new unresolved
+ (proc (lambda (n e env)
+ (resolve-counter n env 'example #t)))))
+ ,@(the-options opts :ident :class)))
+ (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;* example-produce ... */
+;*---------------------------------------------------------------------*/
+(define-markup (example-produce example . produce)
+ (list (it "Example:")
+ example
+ (if (pair? produce)
+ (list (paragraph "Produces:") (car produce)))))
+
+;*---------------------------------------------------------------------*/
+;* markup-ref ... */
+;*---------------------------------------------------------------------*/
+(define-markup (markup-ref mk)
+ (ref :mark mk :text (code mk)))
+
+;*---------------------------------------------------------------------*/
+;* &the-index ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-index
+ :class 'markup-index
+ :options '(:column)
+ :before (lambda (n e)
+ (output (markup-option n 'header) e))
+ :action (lambda (n e)
+ (define (make-mark-entry n fst)
+ (let ((l (tr :class 'index-mark-entry
+ (td :colspan 2 :align 'left
+ (bold (it (sf n)))))))
+ (if fst
+ (list l)
+ (list (tr (td :colspan 2)) l))))
+ (define (make-primary-entry n p)
+ (let* ((note (markup-option n :note))
+ (b (markup-body n)))
+ (when p
+ (markup-option-add! b :text
+ (list (markup-option b :text)
+ ", p."))
+ (markup-option-add! b :page #t))
+ (tr :class 'index-primary-entry
+ (td :colspan 2 :valign 'top :align 'left b))))
+ (define (make-column ie p)
+ (let loop ((ie ie)
+ (f #t))
+ (cond
+ ((null? ie)
+ '())
+ ((not (pair? (car ie)))
+ (append (make-mark-entry (car ie) f)
+ (loop (cdr ie) #f)))
+ (else
+ (cons (make-primary-entry (caar ie) p)
+ (loop (cdr ie) #f))))))
+ (define (make-sub-tables ie nc p)
+ (define (split-list l num)
+ (let loop ((l l)
+ (i 0)
+ (acc '())
+ (res '()))
+ (cond
+ ((null? l)
+ (reverse! (cons (reverse! acc) res)))
+ ((= i num)
+ (loop l
+ 0
+ '()
+ (cons (reverse! acc) res)))
+ (else
+ (loop (cdr l)
+ (+ i 1)
+ (cons (car l) acc)
+ res)))))
+ (let* ((l (length ie))
+ (w (/ 100. nc))
+ (iepc (let ((d (/ l nc)))
+ (if (integer? d)
+ (inexact->exact d)
+ (+ 1 (inexact->exact (truncate d))))))
+ (split (split-list ie iepc)))
+ (tr (map (lambda (ies)
+ (td :valign 'top :width w
+ (if (pair? ies)
+ (table :width 100. (make-column ies p))
+ "")))
+ split))))
+ (let* ((ie (markup-body n))
+ (nc (markup-option n :column))
+ (pref (eq? (engine-custom e 'index-page-ref) #t))
+ (loc (ast-loc n))
+ ;; FIXME: Since we don't support
+ ;; `:&skribe-eval-location', we could set up a
+ ;; `parameterize' thing around `skribe-eval' to provide
+ ;; it with the right location information.
+ (t (cond
+ ((null? ie)
+ "")
+ ((or (not (integer? nc)) (= nc 1))
+ (table :width 100. ;;:&skribe-eval-location loc
+ (make-column ie pref)))
+ (else
+ (table :width 100. ;;:&skribe-eval-location loc
+ (make-sub-tables ie nc pref))))))
+ (output (skribe-eval t e) e))))
+
+;*---------------------------------------------------------------------*/
+;* compiler-command ... */
+;*---------------------------------------------------------------------*/
+(define-markup (compiler-command bin . opts)
+ (disp :verb #t
+ (color :fg "red" (bold bin))
+ (map (lambda (o)
+ (list " [" (it o) "]"))
+ opts)
+ "..."))
+
+;*---------------------------------------------------------------------*/
+;* compiler-options ... */
+;*---------------------------------------------------------------------*/
+(define-markup (compiler-options bin)
+ (skribe-message " [executing: ~a --options]\n" bin)
+ (let ((port (open-input-file (format #f "| ~a --options" bin))))
+ (let ((opts (read port)))
+ (close-input-port port)
+ (apply description (map (lambda (opt) (item :key (bold (car opt))
+ (cadr opt) "."))
+ opts)))))
--
cgit v1.2.3