diff options
| -rw-r--r-- | src/guile/skribilo/package/eq.scm | 22 | ||||
| -rw-r--r-- | src/guile/skribilo/package/eq/lout.scm | 89 |
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 " } ")))) |