diff options
| -rw-r--r-- | src/guile/skribilo/package/eq.scm | 62 | ||||
| -rw-r--r-- | src/guile/skribilo/package/eq/lout.scm | 86 |
2 files changed, 95 insertions, 53 deletions
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 |