From fc1393afb3a78e25eaeb5dc1380bfcde320c6937 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Fri, 14 Apr 2006 16:07:34 +0000 Subject: eq: Added the `inline?' keyword; fixed the Lout engine. * src/guile/skribilo/package/eq.scm (eq): Added the `inline?' keyword. * src/guile/skribilo/package/eq/lout.scm (eq): Support it. (simple-lout-markup-writer): Added a parameter specifying whether parentheses are needed. Fixed `-' with that respect. git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-79 --- src/guile/skribilo/package/eq.scm | 3 +- src/guile/skribilo/package/eq/lout.scm | 102 ++++++++++++++++----------------- 2 files changed, 52 insertions(+), 53 deletions(-) (limited to 'src/guile') diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm index 45a863f..06aa862 100644 --- a/src/guile/skribilo/package/eq.scm +++ b/src/guile/skribilo/package/eq.scm @@ -127,7 +127,8 @@ ;;; Markup. ;;; -(define-markup (eq :rest opts :key (ident #f) (renderer #f) (class "eq")) +(define-markup (eq :rest opts :key (ident #f) (inline? #f) + (renderer #f) (class "eq")) (new markup (markup 'eq) (ident (or ident (symbol->string (gensym "eq")))) diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm index 561e4cb..a23a2c7 100644 --- a/src/guile/skribilo/package/eq/lout.scm +++ b/src/guile/skribilo/package/eq/lout.scm @@ -53,63 +53,61 @@ (markup-writer 'eq (find-engine 'lout) - :before "{ @Eq { " + :options '(:inline?) + :before "{ " :action (lambda (node engine) - (let ((eq (markup-body node))) - ;(fprint (current-error-port) "eq=" eq) - (output eq engine))) + (display (if (markup-option node :inline?) + "@E { " + "@Eq { ")) + (let ((eq (markup-body node))) + ;;(fprint (current-error-port) "eq=" eq) + (output eq engine))) :after " } }") -;; -;; `+' and `-' have lower precedence than `*', `/', `=', etc., so their -;; operands do not need to be enclosed in braces. -;; -(markup-writer 'eq:+ (find-engine 'lout) - :action (lambda (node engine) - (let loop ((operands (markup-body node))) - (if (null? operands) - #t - (begin - ;; no braces - (output (car operands) engine) - (if (pair? (cdr operands)) - (display " + ")) - (loop (cdr operands))))))) - -(markup-writer 'eq:- (find-engine 'lout) - :action (lambda (node engine) - (let loop ((operands (markup-body node))) - (if (null? operands) - #t - (begin - ;; no braces - (output (car operands) engine) - (if (pair? (cdr operands)) - (display " - ")) - (loop (cdr operands))))))) - -(define-macro (simple-lout-markup-writer sym . lout-name) - `(markup-writer ',(symbol-append 'eq: sym) - (find-engine 'lout) - :action (lambda (node engine) - (let loop ((operands (markup-body node))) - (if (null? operands) - #t - (begin - (display " { ") - (output (car operands) engine) - (display " }") - (if (pair? (cdr operands)) - (display ,(string-append " " - (if (null? lout-name) - (symbol->string sym) - (car lout-name)) - " "))) - (loop (cdr operands)))))))) - -(simple-lout-markup-writer * "times") +(define-macro (simple-lout-markup-writer sym . args) + (let ((lout-name (if (null? args) + (symbol->string sym) + (car args))) + (parentheses? (if (or (null? args) (null? (cdr args))) + #f + (cadr args))) + (open-par '(if eq-op? "(" "")) + (close-par '(if eq-op? ")" ""))) + + `(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))) + (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 +;; operands do not need to be enclosed in parentheses. OTOH, since we use a +;; horizontal bar of `/', we don't need to parenthesize its arguments. + + +(simple-lout-markup-writer +) +(simple-lout-markup-writer *) +(simple-lout-markup-writer - "-" #t) (simple-lout-markup-writer / "over") (simple-lout-markup-writer =) (simple-lout-markup-writer <) -- cgit v1.2.3