From 80e465ec094b1276596b267c132901b5b3cd0675 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Sun, 23 Nov 2008 17:40:21 +0100
Subject: Add the new Info-related modules to the distribution.
* src/guile/Makefile.am (nobase_dist_module_DATA): Add.
(engines): Add `info.scm'.
---
src/guile/Makefile.am | 6 ++-
src/guile/skribilo/engine/info.scm | 84 +++++++++++++++++++-------------------
2 files changed, 47 insertions(+), 43 deletions(-)
(limited to 'src/guile')
diff --git a/src/guile/Makefile.am b/src/guile/Makefile.am
index ab9c3b5..28266e0 100644
--- a/src/guile/Makefile.am
+++ b/src/guile/Makefile.am
@@ -39,7 +39,9 @@ nobase_dist_module_DATA = \
skribilo/reader.scm skribilo/resolve.scm \
skribilo/source.scm skribilo/parameters.scm skribilo/verify.scm \
skribilo/writer.scm skribilo/ast.scm skribilo/location.scm \
- skribilo/condition.scm skribilo/sui.scm
+ skribilo/condition.scm skribilo/sui.scm \
+ skribilo/table.scm skribilo/utils/justify.scm \
+ skribilo/utils/text-table.scm
nobase_dist_module_DATA += \
$(readers) $(engines) $(packages)
@@ -51,7 +53,7 @@ engines = \
skribilo/engine/base.scm skribilo/engine/context.scm \
skribilo/engine/html.scm skribilo/engine/html4.scm \
skribilo/engine/latex.scm skribilo/engine/lout.scm \
- skribilo/engine/xml.scm
+ skribilo/engine/xml.scm skribilo/engine/info.scm
packages = \
skribilo/package/acmproc.scm skribilo/package/french.scm \
diff --git a/src/guile/skribilo/engine/info.scm b/src/guile/skribilo/engine/info.scm
index 08c969c..acbbd5d 100644
--- a/src/guile/skribilo/engine/info.scm
+++ b/src/guile/skribilo/engine/info.scm
@@ -28,7 +28,7 @@
:use-module (skribilo package base)
:autoload (skribilo parameters) (*destination-file*)
:autoload (skribilo output) (output)
- :autoload (skribilo utils justify) (make-justifier)
+ :autoload (skribilo utils justify) (make-justifier with-justification)
:autoload (skribilo utils text-table) (table->ascii)
:use-module (srfi srfi-8)
:use-module (srfi srfi-13)
@@ -59,7 +59,8 @@
;;
(define (print . args)
- (for-each display args))
+ (for-each display args)
+ (newline))
(define (%block? obj)
(and (markup? obj)
@@ -70,7 +71,7 @@
;* info-node ... */
;*---------------------------------------------------------------------*/
(define (info-node node next prev up)
- (print " ")
+ (print "\n ")
(print "File: " (info-dest)
", Node: " node
", Next: " next
@@ -78,44 +79,39 @@
", Up: " up)
(newline))
-;*---------------------------------------------------------------------*/
-;* node-next+prev+top ::%document ... */
-;*---------------------------------------------------------------------*/
-(markup-writer 'document info-engine
- :action (lambda (doc e)
- (let loop ((c (markup-body doc)))
- (cond
- ((null? c)
- (values "Top" "(dir)" "(dir)"))
- ((or (is-markup? (car c) 'chapter)
- (is-markup? (car c) 'section))
- (values (block-title (car c) e) "(dir)" "(dir)"))
- (else
- (loop (cdr c)))))))
-
;*---------------------------------------------------------------------*/
;* node-next+prev+top ... */
;*---------------------------------------------------------------------*/
(define (node-next+prev+top section e)
- (let ((parent (ast-parent section)))
- (let ((top (if (document? parent)
- "Top"
- (block-title parent e))))
- (let loop ((els (markup-body parent))
- (prev #f))
+ (if (document? section)
+ (let loop ((c (markup-body section)))
+ (cond
+ ((null? c)
+ (values "Top" "(dir)" "(dir)"))
+ ((or (is-markup? (car c) 'chapter)
+ (is-markup? (car c) 'section))
+ (values (block-title (car c) e) "(dir)" "(dir)"))
+ (else
+ (loop (cdr c)))))
+ (let ((parent (ast-parent section)))
+ (let ((top (if (document? parent)
+ "Top"
+ (block-title parent e))))
+ (let loop ((els (markup-body parent))
+ (prev #f))
(cond
- ((null? els)
- (values top top top))
- ((eq? (car els) section)
- (let ((p (if prev
- (block-title prev e)
- top))
- (n (if (null? (cdr els))
- top
- (block-title (cadr els) e))))
- (values p n top)))
- (else
- (loop (cdr els) (car els))))))))
+ ((null? els)
+ (values top top top))
+ ((eq? (car els) section)
+ (let ((p (if prev
+ (block-title prev e)
+ top))
+ (n (if (null? (cdr els))
+ top
+ (block-title (cadr els) e))))
+ (values n p top)))
+ (else
+ (loop (cdr els) (car els)))))))))
;*---------------------------------------------------------------------*/
;* node-menu ... */
@@ -123,8 +119,9 @@
(define (node-menu container e)
(let ((children (markup-body container)))
(if (pair? (filter (lambda (x)
- (memq (markup-markup x)
- '(chapter section)))
+ (and (markup? x)
+ (memq (markup-markup x)
+ '(chapter section))))
children))
(begin
(newline)
@@ -133,7 +130,7 @@
(for-each (lambda (c)
(if (%block? c)
(print "* " (block-title c e) "::")))
- (reverse children))))
+ children)))
(newline)))
;*---------------------------------------------------------------------*/
@@ -152,6 +149,7 @@
;* info ::%document ... */
;*---------------------------------------------------------------------*/
(markup-writer 'document info-engine
+ :options '(:title :author :ending)
:action (lambda (doc e)
(let ((title (markup-option doc :title))
(authors (markup-option doc :author))
@@ -171,7 +169,6 @@
(newline)
(newline)
(print "-------------")
- ;; FIXME: Handle footnotes.
(for-each (lambda (fn)
(let ((label (markup-option fn :label))
(note (markup-body fn))
@@ -180,7 +177,9 @@
(output note e)
(output-newline)))
footnotes)
- )))))))
+ ))))
+ ;; FIXME: Handle `:ending'.
+ )))
;*---------------------------------------------------------------------*/
;* scribe-document->info ... */
@@ -281,6 +280,9 @@
;* info ::%author ... */
;*---------------------------------------------------------------------*/
(markup-writer 'author info-engine
+ :options '(:name :title :affiliation :email :url :address :phone
+ :photo :align) ;; XXX: These two aren't actually supported.
+
:action (lambda (n e)
(let ((name (markup-option n :name))
(title (markup-option n :title))
--
cgit v1.2.3