diff options
| -rw-r--r-- | ChangeLog | 20 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/lout.scm | 87 |
2 files changed, 96 insertions, 11 deletions
@@ -2,6 +2,26 @@ # arch-tag: automatic-ChangeLog--skribilo@sv.gnu.org--2006/skribilo--devo--1.2 # +2007-08-30 16:56:12 GMT Ludovic Court`es <ludovic.courtes@laas.fr> patch-160 + + Summary: + lout: Added support for drop capitals. + Revision: + skribilo--devo--1.2--patch-160 + + * 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. + + modified files: + ChangeLog src/guile/skribilo/engine/lout.scm + + new patches: + lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-102 + + 2007-08-29 13:23:11 GMT Ludovic Court`es <ludovic.courtes@laas.fr> patch-159 Summary: 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. @@ -1522,6 +1531,65 @@ ;*---------------------------------------------------------------------*/ +;* 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 ... */ ;*---------------------------------------------------------------------*/ (markup-writer '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 ... */ ;*---------------------------------------------------------------------*/ |