permit multiple-valued meta tags (closes #51)

main-base.rkt

@@ -25,69 +25,30 @@
                       ;; Change behavior of undefined identifiers with #%top
                       ;; Get project values from world
                       (require pollen/top pollen/world)
-                      (provide (all-from-out pollen/top pollen/world))
-                      
-                      (provide (all-defined-out))
+                      (provide (all-defined-out) (all-from-out pollen/top pollen/world))
                       
                       body-exprs (... ...))
                     
-                    (require 'inner racket/list)
-                    
+                    (require 'inner racket/list pollen/metas)
                     
                     ;; in an inline module, reader-here-path and parser-mode are undefined 
                     ;; (because there's no reader)
                     ;; but they'll become tag functions courtesy of #%top
                     ;; so that's how we can detect if they are undefined
-                    (define here-path 
-                      (if (procedure? inner:reader-here-path) "anonymous-module" inner:reader-here-path))
-                    (define parser-mode 
-                      (if (procedure? inner:parser-mode) mode-arg inner:parser-mode))
-                    
-                    
-                    ;; Split out the metas.   
-                    (define (split-metas-to-hash x)
-                      (define (first-attribute x) (caadr x))
-                      (define (meta-key x) (first (first-attribute x)))
-                      (define (meta-value x) (second (first-attribute x)))
-                      (define (properly-formed-meta-payload? x) (and (list? (second x))
-                                                                     (pair? (first-attribute x))
-                                                                     (symbol? (meta-key x)) ; attribute key is symbol
-                                                                     (string? (meta-value x)))) ; attribute value is string
-                      (define is-meta-element?
-                        (λ(x)
-                          (define possible-meta (and (list? x) ; possible txexpr
-                                                     (>= (length x) 2) ; = tag + attribute + other elements (which are ignored)
-                                                     (equal? 'meta (car x)))) ; tag is 'meta
-                          (if possible-meta
-                              (if (properly-formed-meta-payload? x)
-                                  #t
-                                  (error 'is-meta-element? "error: meta must be a symbol / string pair, instead got: ~v" x))
-                              #f)))
-                      (define (splitter x)
-                        (define meta-acc empty)
-                        (define (split-metas x)
-                          (cond
-                            [(list? x) (define-values (new-metas rest) (partition is-meta-element? x))
-                                       (set! meta-acc (append new-metas meta-acc))
-                                       (map split-metas rest)]
-                            [else x]))
-                        (define result (split-metas x))
-                        (values result meta-acc))
-                      
-                      (define-values (doc-without-metas meta-elements) (splitter x))
-                      (define metas-xexpr (apply metaroot meta-elements))
-                      (define meta-element->assoc (λ(me) (cons (meta-key me) (meta-value me))))
-                      (define metas (make-hash (map meta-element->assoc (cdr metas-xexpr))))
-                      (values doc-without-metas metas))
+                    (define here-path (if (procedure? inner:reader-here-path)
+                                          "anonymous-module"
+                                          inner:reader-here-path))
+                    (define parser-mode (if (procedure? inner:parser-mode)
+                                            mode-arg
+                                            inner:parser-mode))
                     
                     (define doc-with-metas
                       `(placeholder-root 
                         ,@(cons (meta 'here-path: here-path) 
                                 (if (list? doc-raw) 
                                     (dropf doc-raw (λ(i) (equal? i "\n"))) ; discard all newlines at front of file
-                                    doc-raw)))) 
-                    
-                    (define-values (doc-without-metas metas) (split-metas-to-hash doc-with-metas))
+                                    doc-raw))))
+                    (define-values (doc-without-metas metas) (split-metas-to-hash doc-with-metas)) ; split out the metas
                     
                     ;; set up the 'doc export
                     (require pollen/decode)
@@ -101,7 +62,5 @@
                                          [else (λ xs (apply string-append (map to-string xs)))]) ; default mode is preprocish
                                        (cdr doc-without-metas))) ;; cdr strips placeholder-root tag
                     
-                    
-                    (provide metas doc
-                             ;; hide the exports that were only for internal use.
-                             (except-out (all-from-out 'inner) doc-raw #%top))))]))))]))
+                    ;; hide the exports that were only for internal use.
+                    (provide metas doc (except-out (all-from-out 'inner) doc-raw #%top))))]))))]))

metas.rkt

@@ -0,0 +1,58 @@
+#lang racket/base
+(require racket/list pollen/top txexpr) ; pollen/top needed for metaroot
+(provide split-metas-to-hash)
+
+(define (meta-element? x)
+  (or (trivial-meta-element? x) (nontrivial-meta-element? x)))
+
+(define (trivial-meta-element? x) ; trivial meta has no attributes.
+  (and (possible-meta-element? x) (empty? (get-attrs x))))
+
+(define (nontrivial-meta-element? x) ; nontrivial meta has attributes that are valid.
+  (and (possible-meta-element? x)
+       (let ([attrs (get-attrs x)])
+         (and (not (empty? attrs)) (andmap valid-meta-attr? attrs)))))
+
+(define (possible-meta-element? x)
+  (and (txexpr? x) (equal? 'meta (get-tag x))))
+
+(define (valid-meta-attr? x)
+  (or (and (list? x) (symbol? (first x)) (string? (second x)))
+      (error 'is-meta-element? "error: meta must be a symbol / string pair, instead got: ~v" x)))
+
+(define (explode-meta-element me)
+  ;; convert a meta with multiple key/value pairs into multiple metas with a single key/value pair
+  ;; only gets nontrivial metas to start.
+  (let loop ([me me][acc empty])
+    (cond
+      [(not (trivial-meta-element? me)) ; meta might become trivial during loop (no attrs)
+       (define attrs (get-attrs me))
+       (loop `(meta ,(cdr attrs)) (cons `(meta ,(list (car attrs))) acc))]
+      [else (reverse acc)])))
+
+(define (split-meta-elements x) ; pull metas out of doc and put them into meta-elements accumulator
+  (define meta-elements empty)
+  (define (extract-meta-elements x)
+    (cond
+      [(list? x) (define-values (new-metas rest) (partition meta-element? x))
+                 (set! meta-elements (append (filter nontrivial-meta-element? new-metas) meta-elements)) ; trivial metas are discarded
+                 (map extract-meta-elements rest)]
+      [else x]))
+  (define thing-without-meta-elements (extract-meta-elements x))
+  (values thing-without-meta-elements (append-map explode-meta-element meta-elements)))
+
+(define (split-metas-to-hash x)
+  (define-values (doc-without-metas meta-elements) (split-meta-elements x))
+  ;; 'metaroot is the hook for the meta decoder function.
+  ;; If it's not a defined identifier, it just hits #%top and becomes `(metaroot ,@metas ...)
+  ;; because of `explode-meta-element`, meta-elements will be a list of metas with a single key/value pair
+  ;; metaroot can rely on this
+  (define metas-xexpr (apply metaroot meta-elements))
+  (define (first-attribute x) (car (get-attrs x)))
+  (define (meta-key x) (first (first-attribute x)))
+  (define (meta-value x) (second (first-attribute x)))
+  (define (meta-element->assoc me) (cons (meta-key me) (meta-value me)))
+  (define metas (make-hash (map meta-element->assoc (cdr metas-xexpr))))
+  (values doc-without-metas metas))
+
+

scribblings/command.scrbl

@@ -474,7 +474,7 @@ When you mark a meta like this, two things happen. First, when you run the file,
 '(some-tag ((key "value")) "Another normal tag")
 }
 
-@margin-note{If your @code{meta} includes a text argument between curly braces — or any other arguments aside from the initial key–value pair — they will be ignored.}
+@margin-note{If your @code{meta} includes a text argument between curly braces, it will be ignored.}
 
 Second, the meta is collected into a hash table that is exported with the name @code{metas}. To see this hash table, run the file above in DrRacket, then move to the interactions window and type @exec{metas} at the prompt:
 
@@ -503,7 +503,7 @@ When you run this code, the result will be the same as before, but this time the
 '#hash((dog . "Roxy") (here-path . "nowhere"))
 }
 
-It doesn't matter how many metas you put in a source file or where you put them. They'll all be extracted and put into the @code{metas} hash table. The order of the metas is not preserved (because order is not preserved in a hash table). But if you have two metas with the same key, the later one will supersede the earlier one:
+It doesn't matter how many metas you put in a source file, or where you put them. They'll all be extracted into the @code{metas} hash table. The order of the metas is not preserved (because order is not preserved in a hash table). But if you have two metas with the same key, the later one will supersede the earlier one:
 
 @codeblock{
 #lang pollen
@@ -521,6 +521,20 @@ Though there are two metas named @racket['dog], only the second one persists:
 '#hash((dog . "Lex") (here-path . "unsaved-editor167056"))
 }
 
+You're allowed to put multiple keys and values within a single @code{meta} tag. As above, later keys supersede earlier ones.
+
+@codeblock{
+#lang pollen
+
+◊some-tag['key: "value"]{Normal tag}
+◊meta['dog: "Roxy" 'lion: "P22" 'dog: "Lex"]
+◊some-tag['key: "value"]{Another normal tag}
+}
+
+@terminal{
+> metas
+'#hash((dog . "Lex") (here-path . "unsaved-editor167056") (lion . "P22"))
+}
 
 @;--------------------------------------------------------------------
 @subsubsection{Inserting a comment}