aboutsummaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/package/eq.scm113
-rw-r--r--src/guile/skribilo/package/eq/lout.scm38
2 files changed, 111 insertions, 40 deletions
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 06aa862..1b0b4aa 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -76,10 +76,6 @@
sim cong approx neq equiv le ge subset supset subseteq supseteq
oplus otimes perp mid lceil rceil lfloor rfloor langle rangle))
-(define %rebindings
- (map (lambda (sym)
- (list sym (symbol-append 'eq: sym)))
- %operators))
(define (make-fast-member-predicate lst)
(let ((h (make-hash-table)))
@@ -93,15 +89,60 @@
(define-public known-operator? (make-fast-member-predicate %operators))
(define-public known-symbol? (make-fast-member-predicate %symbols))
+(define-public equation-markup-name?
+ (make-fast-member-predicate (map (lambda (s)
+ (symbol-append 'eq: s))
+ %operators)))
+
(define-public (equation-markup? m)
"Return true if @var{m} is an instance of one of the equation sub-markups."
- (define eq-sym?
- (make-fast-member-predicate (map (lambda (s)
- (symbol-append 'eq: s))
- %operators)))
(and (markup? m)
- (eq-sym? (markup-markup m))))
+ (equation-markup-name? (markup-markup m))))
+
+(define-public (equation-markup-name->operator m)
+ "Given symbol @var{m} (an equation markup name, e.g., @code{eq:+}), return
+a symbol representing the mathematical operator denoted by @var{m} (e.g.,
+@code{+})."
+ (if (equation-markup-name? m)
+ (string->symbol (let ((str (symbol->string m)))
+ (substring str
+ (+ 1 (string-index str #\:))
+ (string-length str))))
+ #f))
+
+
+;;;
+;;; Operator precedence.
+;;;
+
+(define %operator-precedence
+ ;; FIXME: This needs to be augmented.
+ '((+ . 1)
+ (- . 1)
+ (* . 2)
+ (/ . 2)
+ (sum . 3)
+ (product . 3)
+ (= . 0)
+ (< . 0)
+ (> . 0)
+ (<= . 0)
+ (>= . 0)))
+
+(define-public (operator-precedence op)
+ (let ((p (assq op %operator-precedence)))
+ (if (pair? p) (cdr p) 0)))
+
+
+
+;;;
+;;; Turning an S-exp into an `eq' markup.
+;;;
+(define %rebindings
+ (map (lambda (sym)
+ (list sym (symbol-append 'eq: sym)))
+ %operators))
(define (eq:symbols->strings equation)
"Turn symbols located in non-@code{car} positions into strings."
@@ -122,6 +163,7 @@
(eval `(let ,%rebindings ,(eq:symbols->strings equation))
(current-module)))
+
;;;
;;; Markup.
@@ -209,13 +251,13 @@
body))
(loop (cdr body) (cons first result)))))))))
+
;;;
-;;; Base and text-only implementation.
+;;; Text-based rendering.
;;;
-
(markup-writer 'eq (find-engine 'base)
:action (lambda (node engine)
;; The `:renderer' option should be a symbol (naming an engine
@@ -247,24 +289,37 @@
renderer))))))
(define-macro (simple-markup-writer op . obj)
- `(markup-writer ',(symbol-append 'eq: op) (find-engine 'base)
- :action (lambda (node engine)
- (let loop ((operands (markup-body node)))
- (if (null? operands)
- #t
- (let ((o (car operands)))
- (display (if (equation-markup? o) "(" ""))
- (output o engine)
- (display (if (equation-markup? o) ")" ""))
- (if (pair? (cdr operands))
- (begin
- (display " ")
- (output ,(if (null? obj)
- (symbol->string op)
- (car obj))
- engine)
- (display " ")))
- (loop (cdr operands))))))))
+ ;; Note: The text-only rendering is less ambiguous if we parenthesize
+ ;; without taking operator precedence into account.
+ (let ((precedence (operator-precedence op)))
+ `(markup-writer ',(symbol-append 'eq: op) (find-engine 'base)
+ :action (lambda (node engine)
+ (let loop ((operands (markup-body node)))
+ (if (null? operands)
+ #t
+ (let* ((o (car operands))
+ (nested-eq? (equation-markup? o))
+ (need-paren?
+ (and nested-eq?
+; (< (operator-precedence
+; (equation-markup-name->operator
+; (markup-markup o)))
+; ,precedence)
+ )
+ ))
+
+ (display (if need-paren? "(" ""))
+ (output o engine)
+ (display (if need-paren? ")" ""))
+ (if (pair? (cdr operands))
+ (begin
+ (display " ")
+ (output ,(if (null? obj)
+ (symbol->string op)
+ (car obj))
+ engine)
+ (display " ")))
+ (loop (cdr operands)))))))))
(simple-markup-writer +)
(simple-markup-writer -)
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
index 1df96c1..4de515e 100644
--- a/src/guile/skribilo/package/eq/lout.scm
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -67,14 +67,18 @@
(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? ")" "")))
+ (let* ((lout-name (if (null? args)
+ (symbol->string sym)
+ (car args)))
+ (parentheses? (if (or (null? args) (null? (cdr args)))
+ #t
+ (cadr args)))
+ (precedence (operator-precedence sym))
+
+ ;; Note: We could use `pmatrix' here but it precludes line-breaking
+ ;; within equations.
+ (open-par `(if need-paren? "{ @VScale ( }" ""))
+ (close-par `(if need-paren? "{ @VScale ) }" "")))
`(markup-writer ',(symbol-append 'eq: sym)
(find-engine 'lout)
@@ -83,7 +87,19 @@
(if (null? operands)
#t
(let* ((op (car operands))
- (eq-op? (equation-markup? op)))
+ (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
@@ -107,8 +123,8 @@
(simple-lout-markup-writer +)
(simple-lout-markup-writer * "times")
-(simple-lout-markup-writer - "-" #t)
-(simple-lout-markup-writer / "over")
+(simple-lout-markup-writer - "-")
+(simple-lout-markup-writer / "over" #f)
(simple-lout-markup-writer =)
(simple-lout-markup-writer <)
(simple-lout-markup-writer >)