From 3b7f5ef4e6782dc613f77ae4a4df21a89a9f67e6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Wed, 4 Jul 2007 20:36:19 +0000 Subject: Moved SUI stuff from `html.scm' to `sui.scm'. * src/guile/skribilo/engine/html.scm: Use `(skribilo sui)'. Export `html-title-engine' and `html-file'. (document-sui, sui-referenced-file, sui-marks, sui-blocks): Moved. * src/guile/skribilo/sui.scm: Use required modules. (document-sui, sui-referenced-file, sui-marks, sui-blocks): New. git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-136 --- src/guile/skribilo/engine/html.scm | 63 +------------------------------ src/guile/skribilo/sui.scm | 77 ++++++++++++++++++++++++++++++++++++-- 2 files changed, 75 insertions(+), 65 deletions(-) (limited to 'src/guile') diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm index a16f01f..b6ab8a7 100644 --- a/src/guile/skribilo/engine/html.scm +++ b/src/guile/skribilo/engine/html.scm @@ -35,13 +35,14 @@ :autoload (skribilo evaluator) (evaluate-document) :autoload (skribilo output) (output) :autoload (skribilo debug) (*debug*) + :autoload (skribilo sui) (document-sui) :autoload (ice-9 rdelim) (read-line) :autoload (ice-9 regex) (regexp-substitute/global) :use-module (srfi srfi-13) :use-module (srfi srfi-14) :use-module ((srfi srfi-19) :renamer (symbol-prefix-proc 's19:)) - :export (html-engine + :export (html-engine html-title-engine html-file html-width html-class html-markup-class html-title-authors)) @@ -994,66 +995,6 @@ (else (html-title-authors (list authors) e)))) -;*---------------------------------------------------------------------*/ -;* document-sui ... */ -;*---------------------------------------------------------------------*/ -(define (document-sui n e) - (define (sui) - (display "(sui \"") - (evaluate-document (markup-option n :title) html-title-engine) - (display "\"\n") - (format #t " :file ~s\n" (sui-referenced-file n e)) - (sui-marks n e) - (sui-blocks 'chapter n e) - (sui-blocks 'section n e) - (sui-blocks 'subsection n e) - (sui-blocks 'subsubsection n e) - (display " )\n")) - (if (string? (*destination-file*)) - (let ((f (format #f "~a.sui" (file-prefix (*destination-file*))))) - (with-output-to-file f sui)) - (sui))) - -;*---------------------------------------------------------------------*/ -;* sui-referenced-file ... */ -;*---------------------------------------------------------------------*/ -(define (sui-referenced-file n e) - (let ((file (html-file n e))) - (if (member (file-suffix file) '("skb" "sui" "skr" "html")) - (string-append (strip-ref-base (file-prefix file)) ".html") - file))) - -;*---------------------------------------------------------------------*/ -;* sui-marks ... */ -;*---------------------------------------------------------------------*/ -(define (sui-marks n e) - (display " (marks") - (for-each (lambda (m) - (format #t "\n (~s" (markup-ident m)) - (format #t " :file ~s" (sui-referenced-file m e)) - (format #t " :mark ~s" (markup-ident m)) - (when (markup-class m) - (format #t " :class ~s" (markup-class m))) - (display ")")) - (search-down (lambda (n) (is-markup? n 'mark)) n)) - (display ")\n")) - -;*---------------------------------------------------------------------*/ -;* sui-blocks ... */ -;*---------------------------------------------------------------------*/ -(define (sui-blocks kind n e) - (format #t " (~as" kind) - (for-each (lambda (chap) - (display "\n (\"") - (evaluate-document (markup-option chap :title) html-title-engine) - (format #t "\" :file ~s" (sui-referenced-file chap e)) - (format #t " :mark ~s" (markup-ident chap)) - (when (markup-class chap) - (format #t " :class ~s" (markup-class chap))) - (display ")")) - (container-search-down (lambda (n) (is-markup? n kind)) n)) - (display ")\n")) - ;*---------------------------------------------------------------------*/ ;* author ... */ ;*---------------------------------------------------------------------*/ diff --git a/src/guile/skribilo/sui.scm b/src/guile/skribilo/sui.scm index 89dbb91..6535c66 100644 --- a/src/guile/skribilo/sui.scm +++ b/src/guile/skribilo/sui.scm @@ -20,15 +20,23 @@ ;;; USA. (define-module (skribilo sui) - :use-module (skribilo utils syntax) :use-module (skribilo lib) - :use-module (ice-9 match) - :use-module (srfi srfi-1) + :use-module (skribilo ast) :autoload (skribilo parameters) (*verbose*) :autoload (skribilo reader) (make-reader) + :autoload (skribilo engine) (find-engine) + :autoload (skribilo evaluator) (evaluate-document) + :autoload (skribilo engine html)(html-file) + :use-module (skribilo utils strings) + :use-module (skribilo utils syntax) + :use-module (skribilo utils files) + + :use-module (ice-9 match) + :use-module (srfi srfi-1) :export (load-sui sui-ref->url sui-title sui-file sui-key - sui-find-ref sui-search-ref sui-filter)) + sui-find-ref sui-search-ref sui-filter + document-sui sui-referenced-file sui-marks sui-blocks)) (fluid-set! current-reader %skribilo-module-reader) @@ -197,3 +205,64 @@ (reverse! res)))) (else (skribe-error 'sui-filter "Illegal `sui' format" sui)))) + +;*---------------------------------------------------------------------*/ +;* document-sui ... */ +;*---------------------------------------------------------------------*/ +(define (document-sui n e) + (define (sui) + (display "(sui \"") + (evaluate-document (markup-option n :title) (find-engine 'html)) + (display "\"\n") + (format #t " :file ~s\n" (sui-referenced-file n e)) + (sui-marks n e) + (sui-blocks 'chapter n e) + (sui-blocks 'section n e) + (sui-blocks 'subsection n e) + (sui-blocks 'subsubsection n e) + (display " )\n")) + (if (string? (*destination-file*)) + (let ((f (format #f "~a.sui" (file-prefix (*destination-file*))))) + (with-output-to-file f sui)) + (sui))) + +;*---------------------------------------------------------------------*/ +;* sui-referenced-file ... */ +;*---------------------------------------------------------------------*/ +(define (sui-referenced-file n e) + (let ((file (html-file n e))) + (if (member (file-suffix file) '("skb" "sui" "skr" "html")) + (string-append (strip-ref-base (file-prefix file)) ".html") + file))) + +;*---------------------------------------------------------------------*/ +;* sui-marks ... */ +;*---------------------------------------------------------------------*/ +(define (sui-marks n e) + (display " (marks") + (for-each (lambda (m) + (format #t "\n (~s" (markup-ident m)) + (format #t " :file ~s" (sui-referenced-file m e)) + (format #t " :mark ~s" (markup-ident m)) + (when (markup-class m) + (format #t " :class ~s" (markup-class m))) + (display ")")) + (search-down (lambda (n) (is-markup? n 'mark)) n)) + (display ")\n")) + +;*---------------------------------------------------------------------*/ +;* sui-blocks ... */ +;*---------------------------------------------------------------------*/ +(define (sui-blocks kind n e) + (format #t " (~as" kind) + (for-each (lambda (chap) + (display "\n (\"") + (evaluate-document (markup-option chap :title) + (find-engine 'html)) + (format #t "\" :file ~s" (sui-referenced-file chap e)) + (format #t " :mark ~s" (markup-ident chap)) + (when (markup-class chap) + (format #t " :class ~s" (markup-class chap))) + (display ")")) + (container-search-down (lambda (n) (is-markup? n kind)) n)) + (display ")\n")) -- cgit v1.2.3