From 362047ce067c665d7f7e63de362a9e9f5dd50dbf Mon Sep 17 00:00:00 2001
From: Ludovic Courtes
Date: Sat, 2 Dec 2006 10:44:57 +0000
Subject: eq: Added `eq-display' and the `:align-with' option for `eq'.
* src/guile/skribilo/package/eq.scm: Use `srfi-39'.
(*embedded-renderer*): New.
(eq-display): New.
(eq)[:align-with]: New option.
(eq-display): New text-based writer.
(eq): Parameterize `*embedded-renderer*'.
* src/guile/skribilo/package/eq/lout.scm (eq-display): New writer.
(eq): Support `:align-with'.
(simple-lout-markup-writer): Honor `:align-with'.
git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-26
---
src/guile/skribilo/package/eq.scm | 62 +++++++++++++++++-------
src/guile/skribilo/package/eq/lout.scm | 86 ++++++++++++++++++++--------------
2 files changed, 95 insertions(+), 53 deletions(-)
(limited to 'src/guile')
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index a3eb99c..76bbf6c 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -29,6 +29,8 @@
:use-module (skribilo utils keywords) ;; `the-options', etc.
:autoload (skribilo package base) (it symbol sub sup)
:autoload (skribilo engine lout) (lout-illustration)
+
+ :use-module (srfi srfi-39)
:use-module (ice-9 optargs))
;;; Author: Ludovic Court�s
@@ -52,6 +54,11 @@
;;; Utilities.
;;;
+(define-public *embedded-renderer*
+ ;; Tells whether an engine is invoked as an embedded renderer or as the
+ ;; native engine.
+ (make-parameter #f))
+
(define %operators
'(/ * + - = != ~= < > <= >= sqrt expt sum product script
in notin apply limit combinations))
@@ -178,15 +185,25 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
;;; Markup.
;;;
+(define-markup (eq-display :rest opts :key (ident #f) (class "eq-display"))
+ (new container
+ (markup 'eq-display)
+ (ident (or ident (symbol->string (gensym "eq-display"))))
+ (class class)
+ (options (the-options opts :ident :class :div-style))
+ (body (the-body opts))))
+
(define-markup (eq :rest opts :key (ident #f) (class "eq")
- (inline? #f)
+ (inline? #f) (align-with #f)
(renderer #f) (div-style 'over))
(new container
(markup 'eq)
(ident (or ident (symbol->string (gensym "eq"))))
(class class)
- (options `((:div-style ,div-style)
- ,@(the-options opts :ident :class :div-style)))
+ (options `((:div-style ,div-style) (:align-with ,align-with)
+ ,@(the-options opts
+ :ident :class
+ :div-style :align-with)))
(body (let loop ((body (the-body opts))
(result '()))
(if (null? body)
@@ -199,6 +216,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
;; passed
))))))
+
(define-markup (eq:/ :rest opts :key (ident #f) (div-style #f))
;; If no `:div-style' is specified here, obey the top-level one.
(new markup
@@ -295,6 +313,15 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
;;;
+(markup-writer 'eq-display (find-engine 'base)
+ :action (lambda (node engine)
+ (for-each (lambda (node)
+ (let ((eq? (is-markup? node 'eq)))
+ (if eq? (output (linebreak) engine))
+ (output node engine)
+ (if eq? (output (linebreak) engine))))
+ (markup-body node))))
+
(markup-writer 'eq (find-engine 'base)
:action (lambda (node engine)
;; The `:renderer' option should be a symbol (naming an engine
@@ -306,20 +333,21 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
(cond ((not renderer) ;; default: use the current engine
(output (it (markup-body node)) engine))
((symbol? renderer)
- (case renderer
- ;; FIXME: We should have an `embed' slot for each
- ;; engine class similar to `lout-illustration'.
- ((lout)
- (let ((lout-code
- (with-output-to-string
- (lambda ()
- (output node (find-engine 'lout))))))
- (output (lout-illustration
- :ident (markup-ident node)
- lout-code)
- engine)))
- (else
- (skribe-error 'eq "invalid renderer" renderer))))
+ (parameterize ((*embedded-renderer* #t))
+ (case renderer
+ ;; FIXME: We should have an `embed' slot for each
+ ;; engine class similar to `lout-illustration'.
+ ((lout)
+ (let ((lout-code
+ (with-output-to-string
+ (lambda ()
+ (output node (find-engine 'lout))))))
+ (output (lout-illustration
+ :ident (markup-ident node)
+ lout-code)
+ engine)))
+ (else
+ (skribe-error 'eq "invalid renderer" renderer)))))
;; FIXME: `engine?' and `engine-class?'
(else
(skribe-error 'eq "`:renderer' -- wrong argument type"
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
index 9cd594b..b1ff7ae 100644
--- a/src/guile/skribilo/package/eq/lout.scm
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -51,10 +51,18 @@
;;; Simple markup writers.
;;;
+(markup-writer 'eq-display (find-engine 'lout)
+ :before "\n@BeginAlignedDisplays\n"
+ :after "\n@EndAlignedDisplays\n")
(markup-writer 'eq (find-engine 'lout)
- :options '(:inline? :div-style)
- :before "{ "
+ :options '(:inline? :align-with :div-style)
+ :before (lambda (node engine)
+ (let* ((parent (ast-parent node))
+ (displayed? (is-markup? parent 'eq-display)))
+ (format #t "~a{ "
+ (if (and displayed? (not (*embedded-renderer*)))
+ "\n@IAD " ""))))
:action (lambda (node engine)
(display (if (markup-option node :inline?)
"@E { "
@@ -92,40 +100,46 @@
`(if need-paren? "{ @VScale ) }" "")
"")))
- `(markup-writer ',(symbol-append 'eq: sym)
- (find-engine 'lout)
- :action (lambda (node engine)
- (let ((lout-name ,(if (string? lout-name)
- lout-name
- `(,lout-name node
- engine))))
- (let loop ((operands (markup-body node)))
- (if (null? operands)
- #t
- (let* ((op (car operands))
- (eq-op? (equation-markup? op))
- (need-paren?
- (and eq-op?
- (>= (operator-precedence
- (equation-markup-name->operator
- (markup-markup op)))
- ,precedence)))
- (column (port-column
- (current-output-port))))
-
- ;; Work around Lout's limitations...
- (if (> column 1000) (display "\n"))
-
- (display
- (string-append " { " ,open-par))
- (output op engine)
- (display
- (string-append ,close-par " }"))
- (if (pair? (cdr operands))
- (display (string-append " "
- lout-name
- " ")))
- (loop (cdr operands))))))))))
+ `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout)
+ :action (lambda (node engine)
+ (let* ((lout-name ,(if (string? lout-name)
+ lout-name
+ `(,lout-name node
+ engine)))
+ (eq (ast-parent node))
+ (eq-parent (ast-parent eq)))
+
+ (let loop ((operands (markup-body node))
+ (first? #t))
+ (if (null? operands)
+ #t
+ (let* ((align?
+ (and first?
+ (is-markup? eq-parent 'eq-display)
+ (eq? ',sym
+ (markup-option eq :align-with))))
+ (op (car operands))
+ (eq-op? (equation-markup? op))
+ (need-paren?
+ (and eq-op?
+ (>= (operator-precedence
+ (equation-markup-name->operator
+ (markup-markup op)))
+ ,precedence)))
+ (column (port-column (current-output-port))))
+
+ ;; Work around Lout's limitations...
+ (if (> column 1000) (display "\n"))
+
+ (display (string-append " { " ,open-par))
+ (output op engine)
+ (display (string-append ,close-par " }"))
+ (if (pair? (cdr operands))
+ (display (string-append " "
+ (if align? "^" "")
+ lout-name
+ " ")))
+ (loop (cdr operands) #f)))))))))
;; `+' and `*' have higher precedence than `-', `/', `=', etc., so their
--
cgit v1.2.3