permit multiple key-val pairs in `define-meta` (closes #215)

pull/218/head
Matthew Butterick 5 years ago
parent 16c11c6cda
commit 361e3446f8

@ -21,7 +21,7 @@
;; even though this error will happen after macro expansion, when metas are extracted ;; even though this error will happen after macro expansion, when metas are extracted
;; empty string will merge with surroundings ;; empty string will merge with surroundings
(provide define-meta) (provide define-meta)
(define-syntax-rule (define-meta k v) (begin)) (define-syntax-rule (define-meta k v kv ...) (begin))
(define+provide current-metas (make-parameter #f)) (define+provide current-metas (make-parameter #f))

@ -3,7 +3,6 @@
syntax/strip-context syntax/strip-context
"../setup.rkt" "../setup.rkt"
"split-metas.rkt") "split-metas.rkt")
racket/match
racket/list racket/list
"to-string.rkt" "to-string.rkt"
"../pagetree.rkt" "../pagetree.rkt"
@ -25,15 +24,15 @@
(define (parse xs-in parser-mode root-proc) (define (parse xs-in parser-mode root-proc)
(define xs (splice (strip-leading-newlines xs-in) (setup:splicing-tag))) (define xs (splice (strip-leading-newlines xs-in) (setup:splicing-tag)))
(match parser-mode (cond
[(== default-mode-pagetree eq?) (decode-pagetree xs)] [(eq? parser-mode default-mode-pagetree) (decode-pagetree xs)]
[(== default-mode-markup eq?) (apply root-proc (remove-voids xs))] [(eq? parser-mode default-mode-markup) (apply root-proc (remove-voids xs))]
[(== default-mode-markdown eq?) [(eq? parser-mode default-mode-markdown)
(let* ([xs (stringify xs)] (let* ([xs (stringify xs)]
[xs ((dynamic-require 'markdown 'parse-markdown) xs)] [xs ((dynamic-require 'markdown 'parse-markdown) xs)]
[xs (map strip-empty-attrs xs)]) [xs (map strip-empty-attrs xs)])
(apply root-proc xs))] (apply root-proc xs))]
[_ (stringify xs)])) ; preprocessor mode [else (stringify xs)])) ; preprocessor mode
(define-syntax (pollen-module-begin stx) (define-syntax (pollen-module-begin stx)
(syntax-case stx () (syntax-case stx ()

@ -4,7 +4,6 @@
racket/class racket/class
racket/string racket/string
racket/runtime-path racket/runtime-path
racket/match
setup/getinfo setup/getinfo
sugar/file sugar/file
(for-syntax racket/base) (for-syntax racket/base)
@ -19,14 +18,15 @@
((if (syntax? source-name) syntax-source values) source-name)) ((if (syntax? source-name) syntax-source values) source-name))
(define (infer-parser-mode reader-mode reader-here-path) (define (infer-parser-mode reader-mode reader-here-path)
(match reader-mode (cond
[(== default-mode-auto eq?) [(eq? reader-mode default-mode-auto)
(match (cond [(get-ext reader-here-path) => string->symbol]) (let ([val (cond [(get-ext reader-here-path) => string->symbol])])
[(== (setup:pagetree-source-ext) eq?) default-mode-pagetree] (cond
[(== (setup:markup-source-ext) eq?) default-mode-markup] [(eq? val (setup:pagetree-source-ext)) default-mode-pagetree]
[(== (setup:markdown-source-ext) eq?) default-mode-markdown] [(eq? val (setup:markup-source-ext)) default-mode-markup]
[_ default-mode-preproc])] [(eq? val (setup:markdown-source-ext)) default-mode-markdown]
[_ reader-mode])) [else default-mode-preproc]))]
[else reader-mode]))
(define (custom-read p) (syntax->datum (custom-read-syntax (object-name p) p))) (define (custom-read p) (syntax->datum (custom-read-syntax (object-name p) p)))
@ -88,12 +88,16 @@
(hash-ref! command-char-cache maybe-source-path (λ () (setup:command-char maybe-source-path)))) (hash-ref! command-char-cache maybe-source-path (λ () (setup:command-char maybe-source-path))))
(case key (case key
[(color-lexer) [(color-lexer)
(match (dynamic-require 'syntax-color/scribble-lexer 'make-scribble-inside-lexer (λ () #false)) (define maybe-lexer
[(? procedure? make-lexer) (make-lexer #:command-char my-command-char)] (dynamic-require 'syntax-color/scribble-lexer 'make-scribble-inside-lexer (λ () #false)))
[_ default])] (cond
[(procedure? maybe-lexer) (maybe-lexer #:command-char my-command-char)]
[else default])]
[(drracket:toolbar-buttons) [(drracket:toolbar-buttons)
(match (dynamic-require 'pollen/private/drracket-buttons 'make-drracket-buttons (λ () #false)) (define maybe-button-maker
[(? procedure? make-buttons) (make-buttons my-command-char)])])] (dynamic-require 'pollen/private/drracket-buttons 'make-drracket-buttons (λ () #false)))
(when (procedure? maybe-button-maker)
(maybe-button-maker my-command-char))])]
[(drracket:indentation) [(drracket:indentation)
(λ (text pos) (λ (text pos)
(define line-idx (send text position-line pos)) (define line-idx (send text position-line pos))
@ -114,12 +118,12 @@
(list (list "Pollen sources" (string-join filter-strings ";")))] (list (list "Pollen sources" (string-join filter-strings ";")))]
[(drracket:default-extension) [(drracket:default-extension)
(symbol->string (symbol->string
(match mode (cond
[(== default-mode-auto eq?) (setup:preproc-source-ext)] [(eq? mode default-mode-auto) (setup:preproc-source-ext)]
[(== default-mode-preproc eq?) (setup:preproc-source-ext)] [(eq? mode default-mode-preproc) (setup:preproc-source-ext)]
[(== default-mode-markdown eq?) (setup:markdown-source-ext)] [(eq? mode default-mode-markdown) (setup:markdown-source-ext)]
[(== default-mode-markup eq?) (setup:markup-source-ext)] [(eq? mode default-mode-markup) (setup:markup-source-ext)]
[(== default-mode-pagetree eq?) (setup:pagetree-source-ext)]))] [(eq? mode default-mode-pagetree) (setup:pagetree-source-ext)]))]
[else default]))) [else default])))
(define-syntax-rule (reader-module-begin mode . _) (define-syntax-rule (reader-module-begin mode . _)

@ -7,10 +7,16 @@
(apply hasheq (apply hasheq
(let loop ([x ((if (syntax? x) syntax->datum values) x)]) (let loop ([x ((if (syntax? x) syntax->datum values) x)])
(match x (match x
[(list (== meta-key eq?) key val) [(list (== meta-key eq?) kvs ...)
(unless (>= (length kvs) 2)
(raise-argument-error meta-key "at least one key-value pair" kvs))
(unless (even? (length kvs))
(raise-argument-error meta-key "equal number of keys and values" kvs))
(for ([(key idx) (in-indexed kvs)]
#:when (even? idx))
(unless (symbol? key) (unless (symbol? key)
(raise-argument-error meta-key "valid meta key" key)) (raise-argument-error meta-key "valid meta key" key)))
(list key val)] kvs]
[(? list? xs) (append-map loop xs)] [(? list? xs) (append-map loop xs)]
[_ null])))) [_ null]))))
@ -19,6 +25,7 @@
(check-equal? (split-metas 'root) (hasheq)) (check-equal? (split-metas 'root) (hasheq))
(check-equal? (split-metas '(root)) (hasheq)) (check-equal? (split-metas '(root)) (hasheq))
(check-exn exn:fail:contract? (λ () (split-metas '(root (define-meta 42 "bar"))))) (check-exn exn:fail:contract? (λ () (split-metas '(root (define-meta 42 "bar")))))
(check-exn exn:fail:contract? (λ () (split-metas '(root (define-meta foo "bar" zim)))))
(check-equal? (split-metas '(root (div #:kw #f (define-meta foo "bar") "hi") "zim" (define-meta foo "boing") "zam")) '#hasheq((foo . "boing"))) (check-equal? (split-metas '(root (div #:kw #f (define-meta foo "bar") "hi") "zim" (define-meta foo "boing") "zam")) '#hasheq((foo . "boing")))
(check-equal? (split-metas '(root (div #:kw #f (define-meta foo 'bar) "hi") "zim" (define-meta foo 'boing) "zam")) '#hasheq((foo . 'boing))) (check-equal? (split-metas '(root (div #:kw #f (define-meta foo 'bar) "hi") "zim" (define-meta foo 'boing) "zam")) '#hasheq((foo . 'boing)))
(check-equal? (split-metas #'(root (define-meta dog "Roxy") (define-meta dog "Lex"))) '#hasheq((dog . "Lex"))) (check-equal? (split-metas #'(root (define-meta dog "Roxy") (define-meta dog "Lex"))) '#hasheq((dog . "Lex")))

@ -1 +1 @@
1581033338 1581271696

@ -661,6 +661,32 @@ The title is ◊(select-from-metas 'title metas)
@repl-output{'(root "The title is " "Conclusion to " (em "Infinity War"))} @repl-output{'(root "The title is " "Conclusion to " (em "Infinity War"))}
To save a few keystrokes, you can consolidate multiple keyvalue pairs into one @racket[define-meta] form. So this:
@codeblock{
#lang pollen
◊(define-meta dog "Roxy")
◊(define-meta cat "Chopper")
◊(define-meta ape "Koko")
}
Is the same as this:
@codeblock{
#lang pollen
◊(define-meta dog "Roxy"
cat "Chopper"
ape "Koko")
}
In both cases, the resulting metas look like this:
@terminal{
> metas
'#hasheq((ape . "Koko") (cat . "Chopper") (dog . "Roxy") (here-path . "unsaved editor"))
}
@subsubsection{Retrieving metas} @subsubsection{Retrieving metas}
The @id{metas} hashtable is available immediately within the body of your source file. You can use @racket[select] to get values out of @id{metas}. The @id{metas} hashtable is available immediately within the body of your source file. You can use @racket[select] to get values out of @id{metas}.

Loading…
Cancel
Save