lambda spaces

pull/150/head
Matthew Butterick 7 years ago
parent 3862962562
commit c67c755c34

@ -23,8 +23,8 @@
(define-namespace-anchor cache-module-ns)
(define cached-require-base
(let ([ram-cache (make-hash)])
(λ(path-or-path-string subkey caller-name)
(define path (with-handlers ([exn:fail? (λ(e) (raise-argument-error caller-name "valid path or path-string" path-or-path-string))])
(λ (path-or-path-string subkey caller-name)
(define path (with-handlers ([exn:fail? (λ (e) (raise-argument-error caller-name "valid path or path-string" path-or-path-string))])
(path->complete-path (if (path? path-or-path-string)
path-or-path-string
(string->path path-or-path-string)))))

@ -10,7 +10,7 @@
(define is-meta-value? hash?)
(define is-doc-value? txexpr?)
(define identity (λ(x) x))
(define identity (λ (x) x))
(define not-false? identity)
(define+provide define-meta identity) ;; stub so it will be picked up for docs
@ -122,7 +122,7 @@
[(_ COND BODY ...)
(with-syntax ([SPLICING-TAG (datum->syntax stx (setup:splicing-tag))])
#'(if COND
(with-handlers ([exn:fail? (λ(exn) (error (format "within when/splice, ~a" (exn-message exn))))])
(with-handlers ([exn:fail? (λ (exn) (error (format "within when/splice, ~a" (exn-message exn))))])
(SPLICING-TAG BODY ...))
(SPLICING-TAG)))]))

@ -15,7 +15,7 @@
[else (list x)]))
(define decode-proc-output-contract (or/c txexpr-element? txexpr-elements?))
(define identity (λ(x) x))
(define identity (λ (x) x))
;; decoder wireframe
(define+provide/contract (decode tx-in
@ -45,7 +45,7 @@
(let loop ([x tx-in])
(cond
[(txexpr? x) (let-values([(tag attrs elements) (txexpr->values x)])
(if (or (member tag excluded-tags) (ormap (λ(attr) (member attr excluded-attrs)) attrs))
(if (or (member tag excluded-tags) (ormap (λ (attr) (member attr excluded-attrs)) attrs))
x ; because it's excluded
;; we apply processing here rather than do recursive descent on the pieces
;; because if we send them back through loop, certain element types are ambiguous
@ -68,7 +68,7 @@
(define (doubletag x) (txexpr (string->symbol (format "~a~a" (get-tag x) (get-tag x))) (get-attrs x) (get-elements x)))
(check-equal? (decode #:txexpr-elements-proc identity '(p "foo")) '(p "foo"))
;; can't use doubler on txexpr-elements because it needs a list, not list of lists
(check-equal? (decode #:txexpr-elements-proc (λ(elems) (append elems elems)) '(p "foo")) '(p "foo" "foo"))
(check-equal? (decode #:txexpr-elements-proc (λ (elems) (append elems elems)) '(p "foo")) '(p "foo" "foo"))
(check-equal? (decode #:block-txexpr-proc identity '(p "foo")) '(p "foo"))
(check-equal? (decode #:block-txexpr-proc doubler '(p "foo")) (list '(p "foo") '(p "foo")))
(check-equal? (decode #:block-txexpr-proc doubler '(p "foo")) (list '(p "foo") '(p "foo")))
@ -164,7 +164,7 @@
(if (newlines? (car xs))
(list (apply string-append xs))
xs))
(define not-empty-string? (λ(x) (not (and (string? x) (= (string-length x) 0)))))
(define not-empty-string? (λ (x) (not (and (string? x) (= (string-length x) 0)))))
(let loop ([x x])
(if (and (pair? x) (not (attrs? x)))
(let ([xs (map loop (filter not-empty-string? x))])
@ -204,7 +204,7 @@
(define wrap-proc (if (procedure? maybe-wrap-proc)
maybe-wrap-proc
(λ(elems) (list* maybe-wrap-proc elems))))
(λ (elems) (list* maybe-wrap-proc elems))))
(define (wrap-paragraph elems)
(if (andmap block-txexpr? elems)
@ -214,7 +214,7 @@
(let ([elements (prep-paragraph-flow elements)])
(if (ormap explicit-or-implicit-paragraph-break? elements) ; need this condition to prevent infinite recursion
;; use append-map on wrap-paragraph rather than map to permit return of multiple elements
(append-map wrap-paragraph (append-map (λ(es) (filter-split es paragraph-break?)) (slicef elements block-txexpr?))) ; split into ¶¶, using both implied and explicit paragraph breaks
(append-map wrap-paragraph (append-map (λ (es) (filter-split es paragraph-break?)) (slicef elements block-txexpr?))) ; split into ¶¶, using both implied and explicit paragraph breaks
(if force-paragraph
(append-map wrap-paragraph (slicef elements block-txexpr?)) ; upconverts non-block elements to paragraphs
elements))))
@ -231,7 +231,7 @@
(check-equal? (decode-paragraphs '("First para" "\n\n" "Second para") 'ns:p)
'((ns:p "First para") (ns:p "Second para")))
(check-equal? (decode-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line")
#:linebreak-proc (λ(x) (decode-linebreaks x '(newline))))
#:linebreak-proc (λ (x) (decode-linebreaks x '(newline))))
'((p "First para") (p "Second para" (newline) "Second line")))
(check-equal? (decode-paragraphs '("foo" "\n\n" (div "bar") (div "zam")))
'((p "foo") (div "bar") (div "zam")))

@ -37,8 +37,8 @@ Intractable problem, unavoiable limitation.
(match data
[(vector mod sym data2)
((dynamic-require mod sym) data2)]
[_ (λ(key default) default)]))
(λ(key default)
[_ (λ (key default) default)]))
(λ (key default)
(case key
[(configure-runtime)
(define config-vec '#[(submod pollen/mode runtime-config) configure #f])
@ -66,7 +66,7 @@ Intractable problem, unavoiable limitation.
(make-meta-reader
'pollen/mode
"language path"
(λ(bstr)
(λ (bstr)
(let* ([str (bytes->string/latin-1 bstr)]
[sym (string->symbol str)])
(and (module-path? sym)
@ -76,18 +76,18 @@ Intractable problem, unavoiable limitation.
;; fall back to /lang/reader:
(string->symbol (string-append str "/lang/reader"))))))
wrap-reader
(λ(orig-read-syntax)
(λ (orig-read-syntax)
(define read-syntax (wrap-reader orig-read-syntax))
(λ args
(define stx (apply read-syntax args))
(define old-prop (syntax-property stx 'module-language))
(define new-prop `#((submod pollen/mode language-info) get-language-info ,old-prop))
(syntax-property stx 'module-language new-prop)))
(λ(proc)
(λ(key defval)
(λ (proc)
(λ (key defval)
(define (fallback) (if proc (proc key defval) defval))
(define (try-dynamic-require mod export)
(or (with-handlers ([exn:fail? (λ(x) #f)])
(or (with-handlers ([exn:fail? (λ (x) #f)])
(dynamic-require mod export))
(fallback)))
(case key

@ -28,12 +28,12 @@
(define+provide (pagenodeish? x)
(with-handlers ([exn:fail? (λ(e) #f)])
(with-handlers ([exn:fail? (λ (e) #f)])
(and (->pagenode x) #t)))
(define+provide (->pagenode x)
(with-handlers ([exn:fail? (λ(e) (raise-argument-error '->pagenode "can't convert input to pagenode" x))])
(with-handlers ([exn:fail? (λ (e) (raise-argument-error '->pagenode "can't convert input to pagenode" x))])
(->symbol x)))
@ -47,7 +47,7 @@
(list x)))))
(validate-pagetree
(decode (cons pt-root-tag xs)
#:txexpr-elements-proc (compose1 splice-nested-pagetree (λ(xs) (filter-not whitespace? xs)))
#:txexpr-elements-proc (compose1 splice-nested-pagetree (λ (xs) (filter-not whitespace? xs)))
#:string-proc string->symbol))) ; because faster than ->pagenode
@ -57,13 +57,13 @@
(for ([p (in-list pagenodes)]
#:when (not (pagenode? p)))
(error 'validate-pagetree (format "\"~a\" is not a valid pagenode" p)))
(with-handlers ([exn:fail? (λ(e) (error 'validate-pagetree (format "~a" (exn-message e))))])
(with-handlers ([exn:fail? (λ (e) (error 'validate-pagetree (format "~a" (exn-message e))))])
(members-unique?/error pagenodes))
x)))
(define+provide (pagetree? x)
(with-handlers ([exn:fail? (λ(e) #f)])
(with-handlers ([exn:fail? (λ (e) #f)])
(and (validate-pagetree x) #t)))
(module-test-external
@ -81,7 +81,7 @@
(define (unique-sorted-output-paths xs)
(define output-paths (map ->output-path xs))
(define all-paths (filter path-visible? (remove-duplicates output-paths)))
(define path-is-directory? (λ(f) (directory-exists? (build-path dir f))))
(define path-is-directory? (λ (f) (directory-exists? (build-path dir f))))
(define-values (subdirectories files) (partition path-is-directory? all-paths))
(define-values (pagetree-sources other-files) (partition pagetree-source? files))
(define (sort-names xs) (sort xs #:key ->string string<?))
@ -112,7 +112,7 @@
;; Try loading from pagetree file, or failing that, synthesize pagetree.
(define+provide/contract (make-project-pagetree project-dir)
(pathish? . -> . pagetree?)
(with-handlers ([exn:fail? (λ(exn) (directory->pagetree project-dir))])
(with-handlers ([exn:fail? (λ (exn) (directory->pagetree project-dir))])
(define pagetree-source (build-path project-dir (setup:main-pagetree)))
(load-pagetree pagetree-source)))
@ -129,7 +129,7 @@
(define current-children (cdr subtree))
(if (memq pagenode (map topmost-node current-children))
current-parent
(ormap (λ(st) (loop pagenode st)) (filter subtree? current-children))))))
(ormap (λ (st) (loop pagenode st)) (filter subtree? current-children))))))
(if (eq? result (car pt))
(and allow-root? result)
result))
@ -149,8 +149,8 @@
(let ([pagenode (->pagenode p)]
[pt (get-pagetree pt-or-path)])
(if (eq? pagenode (car pt))
(map (λ(x) (if (list? x) (car x) x)) (cdr pt))
(ormap (λ(x) (children pagenode x)) (filter list? pt))))))
(map (λ (x) (if (list? x) (car x) x)) (cdr pt))
(ormap (λ (x) (children pagenode x)) (filter list? pt))))))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
@ -217,7 +217,7 @@
[pagetree-nodes (pagetree->list (get-pagetree pt-or-path))]
;; using `in-pagetree?` would require another flattening
[in-tree? (memq pagenode pagetree-nodes)]
[result (and in-tree? (proc pagetree-nodes (λ(x) (not (eq? pagenode x)))))])
[result (and in-tree? (proc pagetree-nodes (λ (x) (not (eq? pagenode x)))))])
(and (not (empty? result)) result))))
(module-test-internal

@ -15,7 +15,7 @@
(define poly-flag (and (has-inner-poly-ext? source-path) (current-poly-target)))
(define pollen-env (getenv default-env-name))
(define path+mod-time-pairs
(map (λ(ps) (and ps (let ([cp (->complete-path ps)])
(map (λ (ps) (and ps (let ([cp (->complete-path ps)])
(cons (path->string cp) (with-handlers ([exn:fail? (λ _ 0)])
(file-or-directory-modify-seconds cp)))))) path-strings))
(list* pollen-env poly-flag path+mod-time-pairs))

@ -14,7 +14,7 @@
(define (get-first-arg-or-current-dir [args (cdr (vector->list (current-command-line-arguments)))]) ; cdr to strip command name from front
(normalize-path
(with-handlers ([exn:fail? (λ(exn) (current-directory))])
(with-handlers ([exn:fail? (λ (exn) (current-directory))])
;; incoming path argument is handled as described in docs for current-directory
(very-nice-path (car args)))))
@ -167,7 +167,7 @@ version print the version" (current-server-port) (make-publish-di
(simplify-path (get-first-arg-or-current-dir other-args)))
(define dest-dir
(simplify-path
(with-handlers ([exn:fail? (λ(exn) (make-publish-dir-name command-name))])
(with-handlers ([exn:fail? (λ (exn) (make-publish-dir-name command-name))])
(path->complete-path (string->path (cadr other-args))))))
(define (delete-it path)

@ -28,7 +28,7 @@
(define+provide (make-datestamp)
(define date (current-date))
(define date-fields (map (λ(x) (zero-fill x 2))
(define date-fields (map (λ (x) (zero-fill x 2))
(list
(date-day date)
(list-ref months (sub1 (date-month date)))
@ -38,7 +38,7 @@
(define+provide (make-timestamp)
(define date (current-date))
(define time-fields (map (λ(x) (zero-fill x 2))
(define time-fields (map (λ (x) (zero-fill x 2))
(list
; (date-day date)
; (list-ref months (sub1 (date-month date)))
@ -66,7 +66,7 @@
#'(begin
;; does file have particular extension
(define+provide (message-stem . items)
(log-pollen-stem (string-join `(,(make-debug-timestamp) ,@(map (λ(x)(if (string? x) x (format "~v" x))) items)))))))]))
(log-pollen-stem (string-join `(,(make-debug-timestamp) ,@(map (λ (x)(if (string? x) x (format "~v" x))) items)))))))]))
(make-message-logger-functions fatal)
(make-message-logger-functions error)
@ -75,4 +75,4 @@
(make-message-logger-functions debug)
(define+provide (message . items)
(displayln (string-join `(,@(map (λ(x)(if (string? x) x (format "~v" x))) items)))))
(displayln (string-join `(,@(map (λ (x)(if (string? x) x (format "~v" x))) items)))))

@ -11,7 +11,7 @@
(define-syntax (*module-begin stx)
(syntax-case stx ()
[(_ id . body)
(with-syntax ([post-process #'(λ(x) x)]
(with-syntax ([post-process #'(λ (x) x)]
[exprs #'()])
#'(#%module-begin
(doc-begin id post-process exprs . body)))]))

@ -30,7 +30,7 @@
(define+provide (sourceish? x)
;(any/c . -> . coerce/boolean?)
(define sourceish-extensions (list "svg"))
(with-handlers ([exn:fail? (λ(e) #f)])
(with-handlers ([exn:fail? (λ (e) #f)])
(and (member (get-ext x) sourceish-extensions) #t)))
(module-test-external
@ -60,7 +60,7 @@
(define+provide (visible-files dir)
(let ([dir (->path dir)])
(filter path-visible?
(map (λ(p) (find-relative-path dir p))
(map (λ (p) (find-relative-path dir p))
(filter file-exists?
(directory-list dir #:build? #t))))))
@ -178,7 +178,7 @@
;; it's a file-ext source file, or a file that's the result of a file-ext source
(define+provide (has/is-stem-source? x)
(->boolean (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list stem-source? get-stem-source)))))
(->boolean (and (pathish? x) (ormap (λ (proc) (proc (->path x))) (list stem-source? get-stem-source)))))
;; get first possible source path (does not check filesystem)
(define+provide/contract (->stem-source-path x)
@ -222,7 +222,7 @@
(define+provide (->source+output-paths source-or-output-path)
;(complete-path? . -> . (values complete-path? complete-path?))
;; file-proc returns two values, but ormap only wants one
(define file-proc (ormap (λ(test file-proc) (and (test source-or-output-path) file-proc))
(define file-proc (ormap (λ (test file-proc) (and (test source-or-output-path) file-proc))
(list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? )
(list ->null-source+output-paths ->preproc-source+output-paths ->markup-source+output-paths ->scribble-source+output-paths ->markdown-source+output-paths )))
(file-proc source-or-output-path))
@ -267,7 +267,7 @@
(define+provide/contract (get-source path)
(coerce/path? . -> . (or/c #f path?))
(ormap (λ(proc) (proc path)) (list get-markup-source get-markdown-source get-preproc-source get-null-source get-scribble-source)))
(ormap (λ (proc) (proc path)) (list get-markup-source get-markdown-source get-preproc-source get-null-source get-scribble-source)))
;; for backward compatibility
(define+provide ->source-path get-source)
@ -286,7 +286,7 @@
(define+provide (project-files-with-ext ext)
;(coerce/symbol? . -> . complete-paths?)
(map ->complete-path (filter (λ(i) (has-ext? i (->symbol ext))) (directory-list (current-project-root)))))
(map ->complete-path (filter (λ (i) (has-ext? i (->symbol ext))) (directory-list (current-project-root)))))
(define (racket-source? x)
@ -320,7 +320,7 @@
(define+provide (omitted-path? file)
(ormap (λ(proc) (proc file)) (list
(ormap (λ (proc) (proc file)) (list
preproc-source?
markup-source?
markdown-source?
@ -333,6 +333,6 @@
(setup:unpublished-path?)))) ; deprecated name
(define+provide (extra-path? file)
(ormap (λ(proc) (proc file)) (list
(ormap (λ (proc) (proc file)) (list
(setup:extra-path?)
(setup:extra-published-path?)))) ; deprecated name

@ -49,11 +49,11 @@
(let* ([parser-mode (or 'PARSER-MODE-FROM-READER-PROPERTY PARSER-MODE-FROM-EXPANDER)]
[proc (case parser-mode
[(MODE-PAGETREE) decode-pagetree]
[(MODE-MARKUP) (λ(xs) (apply ROOT xs))] ; if `root` undefined, it becomes a default tag function
[(MODE-MARKDOWN) (λ(xs) (apply ROOT (map strip-empty-attrs ((dynamic-require 'markdown 'parse-markdown) (apply string-append (map to-string xs))))))]
[else (λ(xs) (apply string-append (map to-string xs)))])] ; string output for preprocessor
[(MODE-MARKUP) (λ (xs) (apply ROOT xs))] ; if `root` undefined, it becomes a default tag function
[(MODE-MARKDOWN) (λ (xs) (apply ROOT (map strip-empty-attrs ((dynamic-require 'markdown 'parse-markdown) (apply string-append (map to-string xs))))))]
[else (λ (xs) (apply string-append (map to-string xs)))])] ; string output for preprocessor
;; drop leading newlines, as they're often the result of `defines` and `requires`
[doc-elements (or (memf (λ(ln) (not (equal? ln NEWLINE))) DOC-RAW) null)]
[doc-elements (or (memf (λ (ln) (not (equal? ln NEWLINE))) DOC-RAW) null)]
[doc-elements-spliced (splice doc-elements 'SPLICING-TAG)])
(proc doc-elements-spliced)))

@ -18,7 +18,7 @@
;; if a file is already in the cache, no need to hit it again.
;; this allows partially completed preheat jobs to resume.
(define uncached-paths (filter
(λ(path)
(λ (path)
;; #t = not cached; #f = already cached
;; seems like it would be slow to load cache.rktd but it's not.
(define-values (_ private-cache-dir) (make-cache-dirs path))

@ -55,7 +55,7 @@
;; todo: fix outbound contract to be proc with (request? #:rest args . -> . response?)
(define/contract (route-wrapper route-proc)
(procedure? . -> . procedure?)
(λ(req . string-args)
(λ (req . string-args)
(logger req)
;; `flatten` here because servlet's route matcher might send a list of lists
;; for "before and after" matches, like `((string-arg) ... "in" (string-arg) ...)`
@ -104,7 +104,7 @@
`(div
(p "filename =" ,(->string relative-path))
(p "size = " ,(bytecount->string (file-size path)))
(ul ,@(map (λ(i) `(li ,(~a i))) ziplist))))
(ul ,@(map (λ (i) `(li ,(~a i))) ziplist))))
@ -155,10 +155,10 @@
(define dirs (cons title (if (not (equal? (current-project-root) dashboard-dir))
(explode-path (find-relative-path (current-project-root) dashboard-dir))
null)))
(define dirlinks (cons "/" (map (λ(ps) (format "/~a/" (apply build-path ps)))
(define dirlinks (cons "/" (map (λ (ps) (format "/~a/" (apply build-path ps)))
(for/list ([i (in-range (length (cdr dirs)))])
(take (cdr dirs) (add1 i))))))
`(tr (th ((colspan "3")) ,@(add-between (map (λ(dir dirlink) `(a ((href ,(format "~a~a" dirlink (setup:main-pagetree)))) ,(->string dir))) dirs dirlinks) "/"))))
`(tr (th ((colspan "3")) ,@(add-between (map (λ (dir dirlink) `(a ((href ,(format "~a~a" dirlink (setup:main-pagetree)))) ,(->string dir))) dirs dirlinks) "/"))))
(define (make-path-row filename source indent-level)
`(tr ,@(map make-link-cell
@ -175,8 +175,8 @@
(cond ; multi source. expand to multiple output files.
[(and source-second-ext (equal? source-second-ext (->string (setup:poly-source-ext (->complete-path source)))))
(define source-base (remove-ext source-minus-ext))
(define output-names (map (λ(ext) (->string (add-ext source-base ext))) (setup:poly-targets (->complete-path source))))
(cons #f `(span ,@(map (λ(on) `(a ((href ,on)) ,on (span ((class "file-ext")) "." ,source-first-ext ,(format " (from ~a)" (->string (find-relative-path dashboard-dir source)))))) output-names)))]
(define output-names (map (λ (ext) (->string (add-ext source-base ext))) (setup:poly-targets (->complete-path source))))
(cons #f `(span ,@(map (λ (on) `(a ((href ,on)) ,on (span ((class "file-ext")) "." ,source-first-ext ,(format " (from ~a)" (->string (find-relative-path dashboard-dir source)))))) output-names)))]
[else
(define extra-row-string
(if (equal? source-minus-ext (remove-ext source)) ; escaped and unescaped versions are equal
@ -229,7 +229,7 @@
[(not (null? project-paths))
(define path-source-pairs
(map
(λ(p) (define source
(λ (p) (define source
(let ([possible-source (get-source (build-path dashboard-dir p))])
(and possible-source (->string (find-relative-path dashboard-dir possible-source)))))
(cons p source))
@ -257,7 +257,7 @@
(define (get-query-value url key)
; query is parsed as list of pairs, key is symbol, value is string
; '((key . "value") ... )
(let ([result (memf (λ(x) (equal? (car x) key)) (url-query url))])
(let ([result (memf (λ (x) (equal? (car x) key)) (url-query url))])
(and result (cdar result))))

@ -15,7 +15,7 @@
(define (start-server servlet-path [open-browser-window? #f])
(define-values (pollen-servlet _)
(dispatch-rules
[((string-arg) ... (? (λ(x) (equal? "" x)))) route-index] ; last element of a "/"-terminated url is ""
[((string-arg) ... (? (λ (x) (equal? "" x)))) route-index] ; last element of a "/"-terminated url is ""
[((string-arg) ... (? pagetree-source?)) route-dashboard]
[((string-arg) ... "in" (string-arg) ...) route-in]
[((string-arg) ... "out" (string-arg) ...) route-out]

@ -5,11 +5,11 @@
"file-utils.rkt")
(define+provide/contract (get-directory-require-files source-arg)
(pathish? . -> . (or/c #f (λ(xs) (and (list? xs) (andmap complete-path? xs)))))
(pathish? . -> . (or/c #f (λ (xs) (and (list? xs) (andmap complete-path? xs)))))
(define source-path (->path source-arg))
(define require-filenames (list default-directory-require))
(define identity (λ(x) x))
(define possible-requires (filter identity (map (λ(f) (find-upward-from source-path f)) require-filenames)))
(define identity (λ (x) x))
(define possible-requires (filter identity (map (λ (f) (find-upward-from source-path f)) require-filenames)))
(and (pair? possible-requires) possible-requires))

@ -68,7 +68,7 @@
(λ (key default)
(case key
[(color-lexer drracket:toolbar-buttons) ; only do source-path searching if we have one of these keys
(define maybe-source-path (with-handlers ([exn:fail? (λ(exn) #f)])
(define maybe-source-path (with-handlers ([exn:fail? (λ (exn) #f)])
;; Robert Findler does not endorse `get-filename` here,
;; because it's sneaky and may not always work.
;; OTOH Scribble relies on it, so IMO it's highly unlikely to change.

@ -13,7 +13,7 @@
(if (memq parser-mode (list default-mode-preproc default-mode-template))
(display doc)
;; OK to use dynamic-require because runtime-config itself is dynamic-required
(print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error|
(print (with-handlers ([exn:fail? (λ (exn) ((error '|pollen markup error|
((dynamic-require 'racket/string 'string-join) (cdr ((dynamic-require 'racket/string 'string-split) (exn-message exn) ": ")) ": "))))])
((dynamic-require 'txexpr/base 'validate-txexpr) doc)))))))

@ -6,7 +6,7 @@
(define (attrs? x)
(and (list? x)
(andmap (λ(xi)
(andmap (λ (xi)
(and (list? xi)
(= (length xi) 2)
(symbol? (car xi))
@ -15,11 +15,11 @@
(define (splice x [splicing-tag splice-signal-tag])
; (listof txexpr-elements?) . -> . (listof txexpr-elements?))
(define spliceable? (λ(x) (and (pair? x) (eq? (car x) splicing-tag))))
(define not-null-string? (λ(x) (not (and (string? x) (zero? (string-length x))))))
(define spliceable? (λ (x) (and (pair? x) (eq? (car x) splicing-tag))))
(define not-null-string? (λ (x) (not (and (string? x) (zero? (string-length x))))))
(let loop ([x x])
(if (list? x) ; don't exclude `attrs?` here, because it will exclude valid splice input like '((@ "foo"))
(apply append (map (λ(x) (let ([proc (if (spliceable? x) ; drop the splice-signal from front with `cdr`
(apply append (map (λ (x) (let ([proc (if (spliceable? x) ; drop the splice-signal from front with `cdr`
cdr
list)]
[x (if (not (attrs? x)) ; don't recur on attributes, so null strings are not spliced within
@ -45,7 +45,7 @@
(if (list? x)
;; this will strip all empty lists.
;; in practice, they would only appear in attrs position
(map loop (filter (λ(x) (not (null? x))) x))
(map loop (filter (λ (x) (not (null? x))) x))
x)))

@ -12,7 +12,7 @@
(let loop ([x (if (list? tree) tree (list tree))])
(cond
[(meta? x) (set! matches (cons x matches)) missing-sym]
[(list? x) (filter (λ(x) (not (eq? x missing-sym))) (map loop x))]
[(list? x) (filter (λ (x) (not (eq? x missing-sym))) (map loop x))]
[else x])))
(values (apply hasheq (apply append (reverse (map cdr matches)))) rest))

@ -1 +1 @@
1496767905
1501884297

@ -17,7 +17,7 @@
(whitespace-base x #:nbsp-is-white? #f))
(define not-whitespace? (λ(x) (not (whitespace? x))))
(define not-whitespace? (λ (x) (not (whitespace? x))))
(define (whitespace/nbsp? x)

@ -25,7 +25,7 @@
(require racket/runtime-path)
(define-runtime-path sample-dir "test/data/samples")
(define samples (parameterize ([current-directory sample-dir])
(map path->complete-path (filter (λ(name) (regexp-match "sample-" name)) (directory-list ".")))))
(map path->complete-path (filter (λ (name) (regexp-match "sample-" name)) (directory-list ".")))))
(define-values (sample-01 sample-02 sample-03) (apply values samples)))
@ -53,7 +53,7 @@
;; And with render, they would be rendered repeatedly.
;; Using reset-modification-dates is sort of like session control.
(reset-mod-date-hash)
(for-each (λ(x) ((if (pagetree-source? x)
(for-each (λ (x) ((if (pagetree-source? x)
render-pagenodes
render-from-source-or-output-path) x)) xs))
@ -71,7 +71,7 @@
(pathish? . -> . void?)
(let ([so-path (->complete-path so-pathish)]) ; so-path = source or output path (could be either)
(cond
[(ormap (λ(test) (test so-path)) (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source?))
[(ormap (λ (test) (test so-path)) (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source?))
(let-values ([(source-path output-path) (->source+output-paths so-path)])
(render-to-file-if-needed source-path #f output-path))]
[(pagetree-source? so-path) (render-pagenodes so-path)]))
@ -111,7 +111,7 @@
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . (or/c string? bytes?))
(define render-proc
(cond
[(ormap (λ(test render-proc) (and (test source-path) render-proc))
[(ormap (λ (test render-proc) (and (test source-path) render-proc))
(list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source?)
(list render-null-source render-preproc-source render-markup-or-markdown-source render-scribble-source render-markup-or-markdown-source))]
[else (error (format "render: no rendering function found for ~a" source-path))]))
@ -202,12 +202,12 @@
(or (markup-source? path) (markdown-source? path)))
(define identity (λ(x) x))
(define identity (λ (x) x))
(define+provide/contract (get-template-for source-path [maybe-output-path #f])
((complete-path?)((or/c #f complete-path?)) . ->* . (or/c #f complete-path?))
(define (file-exists-or-has-source? p) ; p could be #f
(and p (ormap (λ(proc) (file-exists? (proc p))) (list identity ->preproc-source-path ->null-source-path)) p))
(and p (ormap (λ (proc) (file-exists? (proc p))) (list identity ->preproc-source-path ->null-source-path)) p))
(define (get-template)
(define source-dir (dirname source-path))
@ -221,7 +221,7 @@
[template-name (cond
[(list? template-name-or-names)
(define result
(memf (λ(tn) (eq? (get-ext tn) output-path-ext)) template-name-or-names)) ; #f or list
(memf (λ (tn) (eq? (get-ext tn) output-path-ext)) template-name-or-names)) ; #f or list
(and result (car result))]
[else template-name-or-names])])
(and template-name (build-path source-dir template-name))))))

@ -25,15 +25,15 @@ Another example is conversion of output into a particular data format. Most Poll
@defproc[
(decode
[tagged-xexpr txexpr?]
[#:txexpr-tag-proc txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?) (λ(tag) tag)]
[#:txexpr-attrs-proc txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?) (λ(attrs) attrs)]
[#:txexpr-elements-proc txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?) (λ(elements) elements)]
[#:txexpr-proc txexpr-proc (txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ(tx) tx)]
[#:block-txexpr-proc block-txexpr-proc (block-txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ(tx) tx)]
[#:inline-txexpr-proc inline-txexpr-proc (txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ(tx) tx)]
[#:string-proc string-proc (string? . -> . (or/c xexpr? (listof xexpr?))) (λ(str) str)]
[#:entity-proc entity-proc ((or/c symbol? valid-char?) . -> . (or/c xexpr? (listof xexpr?))) (λ(ent) ent)]
[#:cdata-proc cdata-proc (cdata? . -> . (or/c xexpr? (listof xexpr?))) (λ(cdata) cdata)]
[#:txexpr-tag-proc txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?) (λ (tag) tag)]
[#:txexpr-attrs-proc txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?) (λ (attrs) attrs)]
[#:txexpr-elements-proc txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?) (λ (elements) elements)]
[#:txexpr-proc txexpr-proc (txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ (tx) tx)]
[#:block-txexpr-proc block-txexpr-proc (block-txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ (tx) tx)]
[#:inline-txexpr-proc inline-txexpr-proc (txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ (tx) tx)]
[#:string-proc string-proc (string? . -> . (or/c xexpr? (listof xexpr?))) (λ (str) str)]
[#:entity-proc entity-proc ((or/c symbol? valid-char?) . -> . (or/c xexpr? (listof xexpr?))) (λ (ent) ent)]
[#:cdata-proc cdata-proc (cdata? . -> . (or/c xexpr? (listof xexpr?))) (λ (cdata) cdata)]
[#:exclude-tags tags-to-exclude (listof txexpr-tag?) null]
[#:exclude-attrs attrs-to-exclude txexpr-attrs? null]
)
@ -64,7 +64,7 @@ This illustrates another important point: even though @racket[decode] presents a
(decode tx)
]
Right — nothing. That's because the default value for the decoding arguments is the identity function, @racket[(λ(x)x)]. So all the input gets passed through intact unless another action is specified.
Right — nothing. That's because the default value for the decoding arguments is the identity function, @racket[(λ (x)x)]. So all the input gets passed through intact unless another action is specified.
The @racket[_*-proc] arguments of @racket[decode] take procedures that are applied to specific categories of elements within @racket[_txexpr].
@ -73,7 +73,7 @@ The @racket[_txexpr-tag-proc] argument is a procedure that handles X-expression
@examples[#:eval my-eval
(define tx '(p "I'm from a strange" (strong "namespace")))
(code:comment @#,t{Tags are symbols, so a tag-proc should return a symbol})
(decode tx #:txexpr-tag-proc (λ(t) (string->symbol (format "ns:~a" t))))
(decode tx #:txexpr-tag-proc (λ (t) (string->symbol (format "ns:~a" t))))
]
The @racket[_txexpr-attrs-proc] argument is a procedure that handles lists of X-expression attributes. (The @racketmodname[txexpr] module, included at no extra charge with Pollen, includes useful helper functions for dealing with these attribute lists.)
@ -81,7 +81,7 @@ The @racket[_txexpr-attrs-proc] argument is a procedure that handles lists of X-
@examples[#:eval my-eval
(define tx '(p ((id "first")) "If I only had a brain."))
(code:comment @#,t{Attrs is a list, so cons is OK for simple cases})
(decode tx #:txexpr-attrs-proc (λ(attrs) (cons '[class "PhD"] attrs )))
(decode tx #:txexpr-attrs-proc (λ (attrs) (cons '[class "PhD"] attrs )))
]
Note that @racket[_txexpr-attrs-proc] will change the attributes of every tagged X-expression, even those that don't have attributes. This is useful, because sometimes you want to add attributes where none existed before. But be careful, because the behavior may make your processing function overinclusive.
@ -90,10 +90,10 @@ Note that @racket[_txexpr-attrs-proc] will change the attributes of every tagged
(define tx '(div (p ((id "first")) "If I only had a brain.")
(p "Me too.")))
(code:comment @#,t{This will insert the new attribute everywhere})
(decode tx #:txexpr-attrs-proc (λ(attrs) (cons '[class "PhD"] attrs )))
(decode tx #:txexpr-attrs-proc (λ (attrs) (cons '[class "PhD"] attrs )))
(code:comment @#,t{This will add the new attribute only to non-null attribute lists})
(decode tx #:txexpr-attrs-proc
(λ(attrs) (if (null? attrs) attrs (cons '[class "PhD"] attrs ))))
(attrs) (if (null? attrs) attrs (cons '[class "PhD"] attrs ))))
]
@ -102,10 +102,10 @@ The @racket[_txexpr-elements-proc] argument is a procedure that operates on the
@examples[#:eval my-eval
(define tx '(div "Double" "\n" "toil" amp "trouble"))
(code:comment @#,t{Every element gets doubled ...})
(decode tx #:txexpr-elements-proc (λ(es) (append-map (λ(e) (list e e)) es)))
(decode tx #:txexpr-elements-proc (λ (es) (append-map (λ (e) (list e e)) es)))
(code:comment @#,t{... but only strings get capitalized})
(decode tx #:txexpr-elements-proc (λ(es) (append-map (λ(e) (list e e)) es))
#:string-proc (λ(s) (string-upcase s)))
(decode tx #:txexpr-elements-proc (λ (es) (append-map (λ (e) (list e e)) es))
#:string-proc (λ (s) (string-upcase s)))
]
So why do you need @racket[_txexpr-elements-proc]? Because some types of element decoding depend on context, thus it's necessary to handle the elements as a group. For instance, paragraph decodeion. The behavior is not merely a @racket[map] across each element, because elements are being removed and altered contextually:
@ -125,7 +125,7 @@ The @racket[_txexpr-proc], @racket[_block-txexpr-proc], and @racket[_inline-txex
@examples[#:eval my-eval
(define tx '(div "Please" (em "mind the gap") (h1 "Tuesdays only")))
(define add-ns (λ(tx) (txexpr
(define add-ns (λ (tx) (txexpr
(string->symbol (format "ns:~a" (get-tag tx)))
(get-attrs tx)
(get-elements tx))))
@ -144,7 +144,7 @@ The @racket[_string-proc], @racket[_entity-proc], and @racket[_cdata-proc] argum
@examples[#:eval my-eval
(code:comment @#,t{A div with string, entity, and cdata elements})
(define tx `(div "Moe" amp 62 ,(cdata #f #f "3 > 2;")))
(define rulify (λ(x) '(hr)))
(define rulify (λ (x) '(hr)))
(code:comment @#,t{The rulify function is selectively applied to each})
(print (decode tx #:string-proc rulify))
(print (decode tx #:entity-proc rulify))
@ -155,9 +155,9 @@ Note that entities come in two flavors — symbolic and numeric — and @racket
@examples[#:eval my-eval
(define tx `(div amp 62))
(define symbolic-detonate (λ(x) (if (symbol? x) 'BOOM x)))
(define symbolic-detonate (λ (x) (if (symbol? x) 'BOOM x)))
(print (decode tx #:entity-proc symbolic-detonate))
(define numeric-detonate (λ(x) (if (valid-char? x) 'BOOM x)))
(define numeric-detonate (λ (x) (if (valid-char? x) 'BOOM x)))
(print (decode tx #:entity-proc numeric-detonate))
]
@ -168,7 +168,7 @@ For instance, earlier we saw how to double elements by using @racket[_txexpr-ele
@examples[#:eval my-eval
(code:comment @#,t{A div with string, entity, and inline-txexpr elements})
(define tx `(div "Axl" amp (span "Slash")))
(define doubler (λ(x) (list x x)))
(define doubler (λ (x) (list x x)))
(code:comment @#,t{The doubler function is selectively applied to each type of element})
(print (decode tx #:string-proc doubler))
(print (decode tx #:entity-proc doubler))
@ -183,12 +183,12 @@ Caution: when returning list values, it's possible to trip over the unavoidable
(and (txexpr-elements? amb) (txexpr? amb))
(code:comment @#,t{Ambiguity in context})
(define x '(gnr "Izzy" "Slash"))
(define rockit (λ(str) (list 'guitar str)))
(define rockit (λ (str) (list 'guitar str)))
(code:comment @#,t{Expecting '(gnr guitar "Izzy" guitar "Slash") from next line,
but return value will be treated as tagged X-expression})
(decode x #:string-proc rockit)
(code:comment @#,t{Changing the order makes it unambiguous})
(define rockit2 (λ(str) (list str 'guitar)))
(define rockit2 (λ (str) (list str 'guitar)))
(decode x #:string-proc rockit2)
]
@ -221,15 +221,15 @@ Finally, the @racket[_attrs-to-exclude] argument works the same way as @racket[_
@defproc[
(decode-elements
[elements txexpr-elements?]
[#:txexpr-tag-proc txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?) (λ(tag) tag)]
[#:txexpr-attrs-proc txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?) (λ(attrs) attrs)]
[#:txexpr-elements-proc txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?) (λ(elements) elements)]
[#:txexpr-proc txexpr-proc (txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ(tx) tx)]
[#:block-txexpr-proc block-txexpr-proc (block-txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ(tx) tx)]
[#:inline-txexpr-proc inline-txexpr-proc (txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ(tx) tx)]
[#:string-proc string-proc (string? . -> . (or/c xexpr? (listof xexpr?))) (λ(str) str)]
[#:entity-proc entity-proc ((or/c symbol? valid-char?) . -> . (or/c xexpr? (listof xexpr?))) (λ(ent) ent)]
[#:cdata-proc cdata-proc (cdata? . -> . (or/c xexpr? (listof xexpr?))) (λ(cdata) cdata)]
[#:txexpr-tag-proc txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?) (λ (tag) tag)]
[#:txexpr-attrs-proc txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?) (λ (attrs) attrs)]
[#:txexpr-elements-proc txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?) (λ (elements) elements)]
[#:txexpr-proc txexpr-proc (txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ (tx) tx)]
[#:block-txexpr-proc block-txexpr-proc (block-txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ (tx) tx)]
[#:inline-txexpr-proc inline-txexpr-proc (txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ (tx) tx)]
[#:string-proc string-proc (string? . -> . (or/c xexpr? (listof xexpr?))) (λ (str) str)]
[#:entity-proc entity-proc ((or/c symbol? valid-char?) . -> . (or/c xexpr? (listof xexpr?))) (λ (ent) ent)]
[#:cdata-proc cdata-proc (cdata? . -> . (or/c xexpr? (listof xexpr?))) (λ (cdata) cdata)]
[#:exclude-tags tags-to-exclude (listof txexpr-tag?) null]
[#:exclude-attrs attrs-to-exclude txexpr-attrs? null]
)
@ -295,7 +295,7 @@ The @racket[_linebreaker] argument can either be @racket[#f] (which will delete
(decode-linebreaks '(div "Two items:" "\n" (em "Eggs") "\n" (em "Bacon")) #f)
(decode-linebreaks '(div "Two items:" "\n" (div "Eggs") "\n" (div "Bacon")))
(decode-linebreaks '(div "Two items:" "\n" (em "Eggs") "\n" (em "Bacon"))
(λ(prev next) (if (and (txexpr? prev) (member "Eggs" prev)) '(egg-br) '(br))))
(prev next) (if (and (txexpr? prev) (member "Eggs" prev)) '(egg-br) '(br))))
]
@defproc[
@ -332,14 +332,14 @@ The @racket[_paragraph-wrapper] argument can either be an X-expression, or a fun
@examples[#:eval my-eval
(decode-paragraphs '("First para" "\n\n" "Second para") 'ns:p)
(decode-paragraphs '("First para" "\n\n" "Second para")
(λ(elems) `(ns:p ,@elems "!?!")))
(elems) `(ns:p ,@elems "!?!")))
]
The @racket[_linebreak-proc] argument allows you to use a different linebreaking procedure other than the usual @racket[decode-linebreaks].
@examples[#:eval my-eval
(decode-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line")
#:linebreak-proc (λ(x) (decode-linebreaks x '(newline))))
#:linebreak-proc (λ (x) (decode-linebreaks x '(newline))))
]
The @racket[#:force?] option will wrap a paragraph tag around @racket[_elements], even if no explicit or implicit paragraph breaks are found. The @racket[#:force?] option is useful for when you want to guarantee that you always get a list of blocks.

@ -27,7 +27,7 @@
(decode-flow inside)))))
(define (convert-newlines args)
(map (λ(arg) (if (equal? arg "\n") (linebreak) arg)) args))
(map (λ (arg) (if (equal? arg "\n") (linebreak) arg)) args))
(define (repl-output . args)
(nested (racketvalfont (racketfont* (convert-newlines args)))))

@ -110,7 +110,7 @@ Because a pagetree is just an X-expression, you can synthesize a pagetree using
(require pollen/pagetree)
(define node-names '(index introduction main_argument conclusion))
(define pt `(pagetree-root
,@"@"(map (λ(n) (string->symbol (format "~a.html" n))) node-names)))
,@"@"(map (λ (n) (string->symbol (format "~a.html" n))) node-names)))
(if (pagetree? pt) pt "Oops, not a pagetree")
}]

@ -110,11 +110,11 @@
(define-settable render-cache-active #t)
(define-settable compile-cache-max-size (* 10 1024 1024)) ; = 10 megabytes
(define-settable unpublished-path? (λ(path) #f)) ; deprecated in favor of `omitted-path?`
(define-settable omitted-path? (λ(path) #f))
(define-settable unpublished-path? (λ (path) #f)) ; deprecated in favor of `omitted-path?`
(define-settable omitted-path? (λ (path) #f))
(define-settable extra-published-path? (λ(path) #f)) ; deprecated in favor of `extra-path?`
(define-settable extra-path? (λ(path) #f))
(define-settable extra-published-path? (λ (path) #f)) ; deprecated in favor of `extra-path?`
(define-settable extra-path? (λ (path) #f))

@ -34,7 +34,7 @@
(let ([attr-name maybe-attr-name][attr-value (second xs)])
(cons (list attr-name attr-value) (parse-one-colon-attr (cddr xs))))
(list xs))))
(define kw-symbols (map (λ(kw) (string->symbol (string-trim (keyword->string kw) "#:"))) kws))
(define kw-symbols (map (λ (kw) (string->symbol (string-trim (keyword->string kw) "#:"))) kws))
(define attrs (append (map list kw-symbols kw-args) colon-attrs leading-attrs))
;; construct the xexpr result "manually" (i.e., not with `make-txexpr` because it may not be a legit txexpr for now

@ -52,7 +52,7 @@
(define x "hello")
(check-equal? (->html x) "hello")
(check-equal? (->html #:tag 'brennan x) "<brennan>hello</brennan>")
(check-exn exn:fail? (λ() (->html #:attrs '((id "dale")) x) "hello")) ;; won't work without tag
(check-exn exn:fail? (λ () (->html #:attrs '((id "dale")) x) "hello")) ;; won't work without tag
(check-equal? (->html #:splice? #t x) "hello")
(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) x) "<brennan id=\"dale\">hello</brennan>")
(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice? #t x) "hello")

@ -14,7 +14,7 @@
(define (render path)
;; need to cd first to pick up directory require correctly
(define cmd-string (format "cd '~a' ; '~a' pollen render '~a'" test-dir raco-path path))
(with-output-to-string (λ() (system cmd-string))))
(with-output-to-string (λ () (system cmd-string))))
(when (file-exists? result-file) (delete-file result-file))
(render test-file)
(check-true (file-exists? result-file))

@ -54,7 +54,7 @@
(when racket-path
(define (run path)
(define cmd-string (format "'~a' ~a" racket-path path))
(with-output-to-string (λ() (system cmd-string))))
(with-output-to-string (λ () (system cmd-string))))
(check-equal? (run test.ptree) "'(pagetree-root test ====)")
(check-equal? (run test.html.pm) @string-append{'(root "test" "\n" "====")})
(check-equal? (run test-import.html.pm) @string-append{'(root "test" "\n" "====" "\n" (root "This is sample 01."))})

@ -25,7 +25,7 @@
(when racket-path
(define (run path)
(define cmd-string (format "'~a' ~a" racket-path path))
(with-output-to-string (λ() (system cmd-string))))
(with-output-to-string (λ () (system cmd-string))))
;; raco is in same dir as racket
(define path-to-raco (path->string (simplify-path (build-path (find-exe) 'up "raco"))))
;; files with ordinary extensions will not be recognized in override dir, and thus behave like preproc

@ -53,7 +53,7 @@ You are kitty}")
(check-equal? (xexpr->pollen '(p ((class "foo")) "You are " (em "so") " puppy")) "◊p[#:class \"foo\"]{You are ◊em{so} puppy}"))
(define (conjoin . fs)
(λ(x) (andmap (λ(f) (f x)) fs)))
(λ (x) (andmap (λ (f) (f x)) fs)))
(define/contract+provide (html->xexpr html-string)
(string? . -> . xexpr?)

@ -288,4 +288,4 @@
(hearts . 9829)
(diams . 9830)))
(define chars (make-hash (hash-map entities (λ(k v) (cons v k))))) ; flip the hash
(define chars (make-hash (hash-map entities (λ (k v) (cons v k))))) ; flip the hash

@ -7,7 +7,7 @@
(let ([queries (map car query+replacement)]
[replacements (map second query+replacement)])
;; reverse because first in list should be first applied to str (and compose1 works right-to-left)
(apply compose1 (reverse (map (λ(query replacement) (λ(str) (regexp-replace* query str replacement))) queries replacements)))))
(apply compose1 (reverse (map (λ (query replacement) (λ (str) (regexp-replace* query str replacement))) queries replacements)))))
(define+provide/contract (smart-dashes str)
(string? . -> . string?)
@ -84,7 +84,7 @@
#:double-prepend [double-pp '(dquo)])
((txexpr?) (#:single-prepend list? #:double-prepend list?) . ->* . txexpr?)
(define two-or-more-char-string? (λ(i) (and (string? i) (>= (string-length i) 2))))
(define two-or-more-char-string? (λ (i) (and (string? i) (>= (string-length i) 2))))
(define-values (tag attr elements) (txexpr->values nx))
(make-txexpr tag attr
(if (and (list? elements) (not (empty? elements)))
@ -117,7 +117,7 @@
;; insert nbsp between last two words
(define+provide/contract (nonbreaking-last-space x #:nbsp [nbsp (->string #\u00A0)]
#:minimum-word-length [minimum-word-length 6]
#:last-word-proc [last-word-proc (λ(x) x)])
#:last-word-proc [last-word-proc (λ (x) x)])
((txexpr?) (#:nbsp string? #:minimum-word-length integer? #:last-word-proc procedure?) . ->* . txexpr?)
;; todo: parameterize this, as it will be different for each project
@ -128,7 +128,7 @@
(let ([reversed-str-list (reverse (string->list str))]
[reversed-nbsp (reverse (string->list (->string nbsp)))])
(define-values (last-word-chars other-chars)
(splitf-at reversed-str-list (λ(i) (not (eq? i #\space)))))
(splitf-at reversed-str-list (λ (i) (not (eq? i #\space)))))
(define front-chars (if (< (len last-word-chars) minimum-word-length) ; OK for long words to be on their own line
; first char of other-chars will be the space, so use cdr

Loading…
Cancel
Save