From 57fa8c46016cf60acf6f7893a23829d85191ac19 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Thu, 30 Aug 2007 15:54:10 +0000
Subject: lout: Added support for drop capitals.
* src/guile/skribilo/engine/lout.scm (lout-engine)[drop-capital?,
drop-capital-lines]: New customs.
(first-paragraph?, make-drop-capital?, output-with-drop-capital): New.
(paragraph)[first-paragraph?]: Moved outside.
Use an `:action' to support drop capitals.
git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-102
---
src/guile/skribilo/engine/lout.scm | 87 +++++++++++++++++++++++++++++++++-----
1 file changed, 76 insertions(+), 11 deletions(-)
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index d2a34e2..70d8f97 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -634,6 +634,15 @@
;; (e.g., the first paragraph of a chapter).
(first-paragraph-gap "\n@LP\n")
+ ;; A boolean or predicate indicating whether drop
+ ;; capitals should be used at the beginning of
+ ;; paragraphs.
+ (drop-capital? #f)
+
+ ;; Number of lines over which drop capitals span.
+ ;; Only 2 and 3 are currently supported.
+ (drop-capital-lines 2)
+
;; For multi-page tables, it may be
;; useful to set this to `#t'. However,
;; this looks kind of buggy.
@@ -1521,6 +1530,65 @@
:after lout-end-large-scale-structure)
+;*---------------------------------------------------------------------*/
+;* support for paragraphs ... */
+;*---------------------------------------------------------------------*/
+
+(define (first-paragraph? n)
+ ;; Return true if N is the first paragraph in this container.
+ (let* ((parent (ast-parent n))
+ (siblings (markup-body parent)))
+ (and (pair? siblings)
+ (eq? n (find (lambda (n)
+ (is-markup? n 'paragraph))
+ siblings)))))
+
+(define (make-drop-capital? n e)
+ ;; Return true if the first letter of N's body should be output as a drop
+ ;; capital.
+ (let ((pred (engine-custom e 'drop-capital?)))
+ (cond ((procedure? pred)
+ (pred n e))
+ ((not pred)
+ #f)
+ (else
+ (and (is-markup? (ast-parent n) 'chapter)
+ (first-paragraph? n))))))
+
+(define (output-with-drop-capital n e)
+ ;; Assuming N is a paragraph, try producing a drop capital.
+
+ (define (drop-capital-function)
+ (let ((lines (engine-custom e 'drop-capital-lines)))
+ (if (integer? lines)
+ (case lines
+ ((3) "@DropCapThree")
+ (else "@DropCapTwo"))
+ "@DropCapTwo")))
+
+ (define (try)
+ (let loop ((body (markup-body n)))
+ (cond ((string? body)
+ (let ((body (string-trim body)))
+ (and (not (string=? body ""))
+ (begin
+ (display "{ ")
+ (output (string (string-ref body 0)) e)
+ (format #t " } ~a { " (drop-capital-function))
+ (output (string-drop body 1) e)
+ #t))))
+ ((pair? body)
+ (let ((did-it? (loop (car body))))
+ (output (cdr body) e)
+ did-it?))
+ (else
+ (output body e)
+ #f))))
+
+ (let ((did-it? (try)))
+ (if did-it?
+ (display " } "))))
+
;*---------------------------------------------------------------------*/
;* paragraph ... */
;*---------------------------------------------------------------------*/
@@ -1532,20 +1600,17 @@
(markup-markup (ast-parent n)))
'(chapter section subsection subsubsection slide))))
:before (lambda (n e)
- (define (first-paragraph?)
- ;; Return true if N is the first paragraph in this container.
- (let* ((parent (ast-parent n))
- (siblings (markup-body parent)))
- (and (pair? siblings)
- (eq? n (find (lambda (n)
- (is-markup? n 'paragraph))
- siblings)))))
-
- (let ((gap (if (first-paragraph?)
+ (let ((gap (if (first-paragraph? n)
(engine-custom e 'first-paragraph-gap)
(engine-custom e 'paragraph-gap))))
- (display (if (string? gap) gap "\n@PP\n")))))
+ (display (if (string? gap) gap "\n@PP\n"))))
+ :action (lambda (n e)
+ (if (make-drop-capital? n e)
+ (output-with-drop-capital n e)
+ (output (markup-body n) e))))
+
+
;*---------------------------------------------------------------------*/
;* footnote ... */
;*---------------------------------------------------------------------*/
--
cgit v1.2.3