From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Thu, 2 Feb 2017 11:30:07 +0000 (-0600)
Subject: Add anchor tags to SCRUBL
X-Git-Tag: fosdem-2017~16
X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=commitdiff_plain;h=0ca1dd65bdd2af9a23bcdb5ddf1ef6c49eceb100

Add anchor tags to SCRUBL
---

diff --git a/mudsync/scrubl.scm b/mudsync/scrubl.scm
index 2fdd922..de50108 100644
--- a/mudsync/scrubl.scm
+++ b/mudsync/scrubl.scm
@@ -130,10 +130,22 @@ Pass in optional extra ARGS to the main META-WRITE"
                      (scrubl-write-obj scrubl arg))
                    args))))
 
-(define (scrubl-pre scrubl 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))
@@ -142,7 +154,9 @@ Pass in optional extra ARGS to the main META-WRITE"
                  (em . ,(scrubl-sxml-simple-field 'em))
                  (i . ,(scrubl-sxml-simple-field 'em))
                  (br . ,(scrubl-sxml-simple-field 'br))
-                 (pre . ,scrubl-pre)  ;; "pre" style whitespace handling.
+                 (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))