X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fscrubl.scm;h=917b3a935a31b57751547aefb5055fa9ecccc616;hp=88438be8f14ff26c03d63ee95243250a59c09959;hb=06be02f9062d42074520e8d4ade894beadf8011e;hpb=467af07b765d0e2f6863a1028ce696414c6cfc74

diff --git a/mudsync/scrubl.scm b/mudsync/scrubl.scm
index 88438be..917b3a9 100644
--- a/mudsync/scrubl.scm
+++ b/mudsync/scrubl.scm
@@ -30,8 +30,13 @@
   #:use-module (srfi srfi-9)
   #:use-module (sxml simple)
   #:use-module (oop goops)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 hash-table)
+  #:use-module (web uri)
   #:export (make-scrubl
             scrubl? scrubl-extend-fields
+            scrubl-write
             scrubl-sxml scrubl-sxml-simple-field))
 
 (define (order-symlist-args symlist-args)
@@ -113,7 +118,9 @@ Pass in optional extra ARGS to the main META-WRITE"
 (define (scrubl-sxml-write scrubl obj)
   (call-with-output-string
     (lambda (p)
-      (sxml->xml (scrubl-write-obj scrubl obj) p))))
+      (sxml->xml
+       (scrubl-write-obj scrubl obj)
+       p))))
 
 
 (define (scrubl-sxml-simple-field sym)
@@ -124,9 +131,33 @@ Pass in optional extra ARGS to the main META-WRITE"
                      (scrubl-write-obj scrubl arg))
                    args))))
 
+(define (scrubl-sxml-pre scrubl args)
+  `(span (@ (class "pre-ish"))
+         ,args))
+
+;; @@: For a text-only interface, we could put links at end of rendered
+;;  text, similar to how orgmode does.
+(define (scrubl-sxml-anchor scrubl args)
+  (define (maybe-uri->string obj)
+    (if (uri? obj)
+        (uri->string obj)
+        obj))
+  (match args
+    (((= maybe-uri->string href) body1 body ...)
+     `(a (@ (href ,href))
+         ,body1 ,@body))))
+
 (define scrubl-sxml
   (make-scrubl `((p . ,(scrubl-sxml-simple-field 'p))
-                 (strong . ,(scrubl-sxml-simple-field 'strong)) ; usually bold
-                 (emph . ,(scrubl-sxml-simple-field 'em))
-                 (br . ,(scrubl-sxml-simple-field 'br))) ; usually italicized
+                 (strong . ,(scrubl-sxml-simple-field 'strong))
+                 (bold . ,(scrubl-sxml-simple-field 'strong))
+                 (b . ,(scrubl-sxml-simple-field 'strong))
+                 (em . ,(scrubl-sxml-simple-field 'em))
+                 (i . ,(scrubl-sxml-simple-field 'em))
+                 (br . ,(scrubl-sxml-simple-field 'br))
+                 (anchor . ,scrubl-sxml-anchor)
+                 (a . ,scrubl-sxml-anchor)
+                 (pre . ,scrubl-sxml-pre)  ;; "pre" style whitespace handling.
+                 (ul . ,(scrubl-sxml-simple-field 'ul))
+                 (li . ,(scrubl-sxml-simple-field 'li)))
                scrubl-sxml-write))