X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=mudsync%2Fscrubl.scm;h=eca66056b408e591be7212f15af2c1791b84a7cf;hb=HEAD;hp=a3daa26b882bf258353ebb7696ca8e59d1cd199d;hpb=6f7c1d4f9a2043c16f83facef6b3216e45e14f40;p=mudsync.git

diff --git a/mudsync/scrubl.scm b/mudsync/scrubl.scm
index a3daa26..eca6605 100644
--- a/mudsync/scrubl.scm
+++ b/mudsync/scrubl.scm
@@ -1,5 +1,5 @@
 ;;; Mudsync --- Live hackable MUD
-;;; Copyright © 2017 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2017 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;;
 ;;; This file is part of Mudsync.
 ;;;
@@ -33,6 +33,7 @@
   #: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
@@ -119,7 +120,6 @@ Pass in optional extra ARGS to the main META-WRITE"
     (lambda (p)
       (sxml->xml
        (scrubl-write-obj scrubl obj)
-       ;; (list 'pre (scrubl-write-obj scrubl obj))
        p))))
 
 
@@ -131,6 +131,22 @@ 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))
@@ -138,7 +154,10 @@ Pass in optional extra ARGS to the main META-WRITE"
                  (b . ,(scrubl-sxml-simple-field 'strong))
                  (em . ,(scrubl-sxml-simple-field 'em))
                  (i . ,(scrubl-sxml-simple-field 'em))
-                 (br . ,(scrubl-sxml-simple-field 'br))  ;; is this useful?
+                 (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))