summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Court`es2006-11-28 10:47:28 +0000
committerLudovic Court`es2006-11-28 10:47:28 +0000
commit56bd1e10d39a97f53f0c8ebefcdef909d99260bb (patch)
tree46bd26814327edb5437bba33a0b210ea27f74f18
parentc23335b3c7ee9f48a7f68fc8828e5b6546649a1a (diff)
downloadskribilo-56bd1e10d39a97f53f0c8ebefcdef909d99260bb.tar.gz
skribilo-56bd1e10d39a97f53f0c8ebefcdef909d99260bb.tar.lz
skribilo-56bd1e10d39a97f53f0c8ebefcdef909d99260bb.zip
eq: Added the `:div-style' option.
* src/guile/skribilo/package/eq.scm (eq): New `:div-style' option. Return a container rather than a markup. (eq:/): Added support for `:div-style'. * src/guile/skribilo/package/eq/lout.scm (eq): List `:div-style' as supported. (div-style->lout): New. (simple-lout-markup-writer): Handle LOUT-NAME as procedure. (eq:/): Use the `:div-style' option. (eq:script): Only use "on" when SUP is passed. git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-80
-rw-r--r--src/guile/skribilo/package/eq.scm22
-rw-r--r--src/guile/skribilo/package/eq/lout.scm89
2 files changed, 72 insertions, 39 deletions
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 4f5020e..58fb77c 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -169,12 +169,15 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
;;; Markup.
;;;
-(define-markup (eq :rest opts :key (ident #f) (inline? #f)
- (renderer #f) (class "eq"))
- (new markup
+(define-markup (eq :rest opts :key (ident #f) (class "eq")
+ (inline? #f)
+ (renderer #f) (div-style 'over))
+ (new container
(markup 'eq)
(ident (or ident (symbol->string (gensym "eq"))))
- (options (the-options opts))
+ (class class)
+ (options `((:div-style ,div-style)
+ ,@(the-options opts :ident :class :div-style)))
(body (let loop ((body (the-body opts))
(result '()))
(if (null? body)
@@ -187,7 +190,16 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
;; passed
))))))
-(define-simple-markup eq:/)
+(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
+ (markup 'eq:/)
+ (ident (or ident (symbol->string (gensym "eq:/"))))
+ (class #f)
+ (options `((:div-style ,div-style)
+ ,@(the-options opts :ident :class :div-style)))
+ (body (the-body opts))))
+
(define-simple-markup eq:*)
(define-simple-markup eq:+)
(define-simple-markup eq:-)
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
index c487b85..cce5124 100644
--- a/src/guile/skribilo/package/eq/lout.scm
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -53,7 +53,7 @@
(markup-writer 'eq (find-engine 'lout)
- :options '(:inline?)
+ :options '(:inline? :div-style)
:before "{ "
:action (lambda (node engine)
(display (if (markup-option node :inline?)
@@ -65,6 +65,14 @@
:after " } }")
+(define (div-style->lout style)
+ (case style
+ ((over) "over")
+ ((fraction) "frac")
+ ((div) "div")
+ ((slash) "slash")
+ (else
+ (error "unsupported div style" style))))
(define-macro (simple-lout-markup-writer sym . args)
(let* ((lout-name (if (null? args)
@@ -83,37 +91,41 @@
`(markup-writer ',(symbol-append 'eq: sym)
(find-engine 'lout)
:action (lambda (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 " { "
- ,(if parentheses?
- open-par
- "")))
- (output op engine)
- (display (string-append ,(if parentheses?
- close-par
- "")
- " }"))
- (if (pair? (cdr operands))
- (display ,(string-append " "
- lout-name
- " ")))
- (loop (cdr operands)))))))))
+ (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 " { "
+ ,(if parentheses?
+ open-par
+ "")))
+ (output op engine)
+ (display (string-append ,(if parentheses?
+ close-par
+ "")
+ " }"))
+ (if (pair? (cdr operands))
+ (display (string-append " "
+ lout-name
+ " ")))
+ (loop (cdr operands))))))))))
;; `+' and `*' have higher precedence than `-', `/', `=', etc., so their
@@ -124,7 +136,16 @@
(simple-lout-markup-writer +)
(simple-lout-markup-writer * "times")
(simple-lout-markup-writer - "-")
-(simple-lout-markup-writer / "over" #f)
+(simple-lout-markup-writer /
+ (lambda (n e)
+ ;; Obey either the per-node `:div-style' or the
+ ;; top-level one.
+ (or (markup-option n :div-style)
+ (let* ((eq (ast-parent n))
+ (div-style
+ (markup-option eq :div-style)))
+ (div-style->lout div-style))))
+ #f)
(simple-lout-markup-writer =)
(simple-lout-markup-writer <)
(simple-lout-markup-writer >)
@@ -208,7 +229,7 @@
(display " } ")))
(if sub
(begin
- (display " on { ")
+ (display (if sup " on { " " sub { "))
(output sub engine)
(display " } ")))
(display " } "))))