Compare commits

..

53 Commits

Author SHA1 Message Date
Matthew Butterick 1fa3f236c2 add module-language key to get-info 8 months ago
Matthew Butterick 1d1cc0df84 fix comparison operator (fixes #271)
arguments are strings, so we need `equal?`
1 year ago
Matthew Butterick c182a30f57 change forum name to `typesetting` 2 years ago
Matthew Butterick 99c43e6ad3 migration to mb servers 2 years ago
Matthew Butterick 7a7b7d49ee suppress obsolete tests 2 years ago
Matthew Butterick 173f9376ea respect the setting of `setup:render-cache-active` for template caching
templates were being cached regardless of the value of `setup:render-cache-active` because its value wasn’t being tested
2 years ago
Matthew Butterick d019908a93 update link in docs 3 years ago
Matthew Butterick 446c5fd39f render-batch: add explicit `output-paths` keyword argument 3 years ago
Matthew Butterick 00a96f4fda report the exception message when an error occurs
When a cache preheat or render fails, print the exception message that arose, which might be more helpful than the current policy of silence
3 years ago
Matthew Butterick 39cfc2ed54 in cache key, treat environment variables as case-sesnsitive
The cache is supposed to take note of the `POLLEN` environment variable, but due to the spurious `string-downcase` here, was instead looking at `pollen`, which is a different key on case-sensitive systems. Windows environment variables are not case-sensitive, but it seems Racket’s `getenv` function will handle the case conversion as needed.
3 years ago
Matthew Butterick 816ce0f7af fix link in docs 3 years ago
Matthew Butterick 58e02d4eee add note about DrRacket appending a `rkt` file extension to `p` files (addresses #264) 3 years ago
Joel Dueck 678371688f
Add docs for `external-renderer` (closes #262) (#263) 3 years ago
Matthew Butterick cf7fbccc90 manually propagate `current-project-root` to parallel threads
When recursive mode is used, `current-project-root` changes during the extent of a render operation. But if parallel rendering is also used, when the main thread re-parameterizes `current-project-root`, it will have no effect on the parallel threads, because they freshly instantiate `current-project-root` (with its default value). This patch moves the parameterization inside the parallel thread by passing the `current-project-root` value as part of the job message, thereby handling it the same way as `current-poly-target`.
3 years ago
Joel Dueck ec4da2e679
fix CoC link (#258) 3 years ago
newelldev 1548546225
Fix typo (#257)
mainpulate -> manipulate
3 years ago
Matthew Butterick 9a92ceaf19 contributor covenant 3 years ago
Matthew Butterick c46bee02cd add tip about current-metas 3 years ago
Matthew Butterick e73517315c
suppress test-project-port.rkt
Doesn’t work with GH actions consistently
4 years ago
Matthew Butterick 453536650b
Update README.md 4 years ago
Matthew Butterick 7f2fbc11cc
Update render.rkt 4 years ago
Joel Dueck 85ad971b88
Specify external renderer via module and id (related to mbutterick/pollen-users#94) (#253)
* Specify external renderer via module and id

* faster external render check

* Update render.rkt

* rely on default exception messages, which are informative
4 years ago
Matthew Butterick a4910a86dc hook for external renderer 4 years ago
Matthew Butterick a7b55e230a raise filesystem errors 4 years ago
Matthew Butterick 36f075edba handle 'relative directory correctly (fixes #252) 4 years ago
Matthew Butterick 6adebb8368 suppress testing of mode-indentation 4 years ago
Matthew Butterick 293fd274f8 expose `find-nearest-default-directory-require` (#251) 4 years ago
Matthew Butterick 63a92b2953 fix pagetree->path (closes #249)
Pagetree promises that its nodes will be resolved relative to the directory where the pagetree lives. For path-based pagetrees, make sure this directory is set correctly.
4 years ago
Joel Dueck 7c348dde44 CONTRIBUTING.md: Google groups → Pollen users repo 4 years ago
Joel Dueck 3924a18f67 Connect some dots (fixes #248)
Clarify three things:

1. You can use pagetree files with `raco pollen render`
2. `--target` doesn’t prevent other file types from being rendered
3. The generated pagetree includes more than just source files
4 years ago
Matthew Butterick 1210e1b31d move more help docs to end of installation docs 4 years ago
Matthew Butterick 665e390f4b remove CS note 4 years ago
Matthew Butterick 902956feaf better explanation of splicing tag 4 years ago
Matthew Butterick 4ec5172acc update margin note (#246) 4 years ago
Matthew Butterick 10b392c503 remove obsolete example (#246) 4 years ago
Matthew Butterick 5c86250cc8
Update README.md 4 years ago
Matthew Butterick d86d0a00e8 trap fewer exceptions 4 years ago
Matthew Butterick 9a838418e7 clean up pollen/mode 4 years ago
Matthew Butterick bd23f651fb omit DS_Store 4 years ago
Matthew Butterick 29b05dbddb
Swap out Travis badge 4 years ago
Bogdan Popa 87f5e8d937
CI: build using Racket 6.6 and up, drop Travis CI config (#245)
* ci: run CI for Racket 6.6 and up

Racket 6.5 has an SSL issue that makes it unable to install packages.
That might be why it was not included in the Travis build either.

* ci: drop travis config
4 years ago
Bogdan Popa 6cd57203c1
start command: fix default value for port (#244)
* start command: fix default value for port

Defaulting the port to "8080" at the `command-line' level breaks
customization via `pollen.rkt'.

* test-project-port: connect to server to verify that it's up
4 years ago
Bogdan Popa 62b19a07d8
build: add GH Actions CI (#243) 4 years ago
Bogdan Popa c02eab7b90
improve failure handling in `start' command (#242)
* project-server: detect and report failures during startup

* start command: display [<dir>] and [<port>] in help text
4 years ago
Matthew Butterick cb2930eafe adjust 4 years ago
Matthew Butterick ae4aaefba1 simplify more paths 4 years ago
Matthew Butterick 5e5dc5d9fd handle relative path correctly (fixes #241) 4 years ago
Matthew Butterick 9bd067552d adjustment 4 years ago
Matthew Butterick 3160a46beb
track render by source+output jobs (#240) 4 years ago
Matthew Butterick 1f1bee90fd correct pagetree rendering (fixes #237) 4 years ago
Matthew Butterick e434406b46 more flexible test 4 years ago
Matthew Butterick 8a8e497bfe correction: that fixes #237 4 years ago
Matthew Butterick 8d443ba8e5
track ouput paths separately in batch render (fixes #236) (#238) 4 years ago

@ -0,0 +1,43 @@
name: CI
on: [push, pull_request]
jobs:
run:
name: "Build using Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }})"
runs-on: ubuntu-latest
strategy:
fail-fast: false
matrix:
racket-version: ["6.6", "6.7", "6.8", "6.9", "6.10.1", "6.11", "6.12", "7.0", "7.1", "7.2", "7.3", "7.4", "7.5", "7.6", "7.7", "7.8", "7.9", "current"]
racket-variant: ["BC", "CS"]
# CS builds are only provided for versions 7.4 and up so avoid
# running the job for prior versions.
exclude:
- {racket-version: "6.6", racket-variant: "CS"}
- {racket-version: "6.7", racket-variant: "CS"}
- {racket-version: "6.8", racket-variant: "CS"}
- {racket-version: "6.9", racket-variant: "CS"}
- {racket-version: "6.10.1", racket-variant: "CS"}
- {racket-version: "6.11", racket-variant: "CS"}
- {racket-version: "6.12", racket-variant: "CS"}
- {racket-version: "7.0", racket-variant: "CS"}
- {racket-version: "7.1", racket-variant: "CS"}
- {racket-version: "7.2", racket-variant: "CS"}
- {racket-version: "7.3", racket-variant: "CS"}
steps:
- name: Checkout
uses: actions/checkout@master
- uses: Bogdanp/setup-racket@v0.11
with:
distribution: 'full'
version: ${{ matrix.racket-version }}
variant: ${{ matrix.racket-variant }}
- name: Install Pollen and its dependencies
run: raco pkg install --auto --batch
- name: Run the tests
run: xvfb-run raco test -j 4 -p pollen

@ -1,46 +0,0 @@
# adapted from
# https://github.com/greghendershott/travis-racket/blob/master/.travis.yml
# Thanks Greg!
dist: trusty
language: c
sudo: false
env:
global:
- RACKET_DIR=~/racket
matrix:
- RACKET_VERSION=6.3
- RACKET_VERSION=6.6
- RACKET_VERSION=6.9
- RACKET_VERSION=6.12
- RACKET_VERSION=7.0
- RACKET_VERSION=7.3
- RACKET_VERSION=7.4
- RACKET_VERSION=7.5
- RACKET_VERSION=7.6
- RACKET_VERSION=HEAD
- RACKET_VERSION=HEADCS
# You may want to test against certain versions of Racket, without
# having them count against the overall success/failure.
matrix:
allow_failures:
- env: RACKET_VERSION=HEAD
- env: RACKET_VERSION=HEADCS
# Fast finish: Overall build result is determined as soon as any of
# its rows have failed, or, all of its rows that aren't allowed to
# fail have succeeded.
fast_finish: true
before_install:
- "export DISPLAY=:99.0" # needed for testing with `racket/gui`
- "sh -e /etc/init.d/xvfb start" # needed for testing with `racket/gui`
- git clone https://github.com/mbutterick/travis-racket.git
- cat travis-racket/install-racket.sh | bash # pipe to bash not sh!
- export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us
script:
- cd .. # Travis did a cd into the dir. Back up, for the next:
- travis_retry raco pkg install --deps search-auto https://github.com/mbutterick/pollen.git
- raco test -p pollen

@ -0,0 +1,134 @@
# Contributor Covenant Code of Conduct
## Our Pledge
We as members, contributors, and leaders pledge to make participation in our
community a harassment-free experience for everyone, regardless of age, body
size, visible or invisible disability, ethnicity, sex characteristics, gender
identity and expression, level of experience, education, socio-economic status,
nationality, personal appearance, race, caste, color, religion, or sexual identity
and orientation.
We pledge to act and interact in ways that contribute to an open, welcoming,
diverse, inclusive, and healthy community.
## Our Standards
Examples of behavior that contributes to a positive environment for our
community include:
* Demonstrating empathy and kindness toward other people
* Being respectful of differing opinions, viewpoints, and experiences
* Giving and gracefully accepting constructive feedback
* Accepting responsibility and apologizing to those affected by our mistakes,
and learning from the experience
* Focusing on what is best not just for us as individuals, but for the
overall community
Examples of unacceptable behavior include:
* The use of sexualized language or imagery, and sexual attention or
advances of any kind
* Trolling, insulting or derogatory comments, and personal or political attacks
* Public or private harassment
* Publishing others' private information, such as a physical or email
address, without their explicit permission
* Other conduct which could reasonably be considered inappropriate in a
professional setting
## Enforcement Responsibilities
Community leaders are responsible for clarifying and enforcing our standards of
acceptable behavior and will take appropriate and fair corrective action in
response to any behavior that they deem inappropriate, threatening, offensive,
or harmful.
Community leaders have the right and responsibility to remove, edit, or reject
comments, commits, code, wiki edits, issues, and other contributions that are
not aligned to this Code of Conduct, and will communicate reasons for moderation
decisions when appropriate.
## Scope
This Code of Conduct applies within all community spaces, and also applies when
an individual is officially representing the community in public spaces.
Examples of representing our community include using an official e-mail address,
posting via an official social media account, or acting as an appointed
representative at an online or offline event.
## Enforcement
Instances of abusive, harassing, or otherwise unacceptable behavior may be
reported to the community leaders responsible for enforcement at
mb@mbtype.com (= Matthew Butterick).
All complaints will be reviewed and investigated promptly and fairly.
All community leaders are obligated to respect the privacy and security of the
reporter of any incident.
## Enforcement Guidelines
Community leaders will follow these Community Impact Guidelines in determining
the consequences for any action they deem in violation of this Code of Conduct:
### 1. Correction
**Community Impact**: Use of inappropriate language or other behavior deemed
unprofessional or unwelcome in the community.
**Consequence**: A private, written warning from community leaders, providing
clarity around the nature of the violation and an explanation of why the
behavior was inappropriate. A public apology may be requested.
### 2. Warning
**Community Impact**: A violation through a single incident or series
of actions.
**Consequence**: A warning with consequences for continued behavior. No
interaction with the people involved, including unsolicited interaction with
those enforcing the Code of Conduct, for a specified period of time. This
includes avoiding interactions in community spaces as well as external channels
like social media. Violating these terms may lead to a temporary or
permanent ban.
### 3. Temporary Ban
**Community Impact**: A serious violation of community standards, including
sustained inappropriate behavior.
**Consequence**: A temporary ban from any sort of interaction or public
communication with the community for a specified period of time. No public or
private interaction with the people involved, including unsolicited interaction
with those enforcing the Code of Conduct, is allowed during this period.
Violating these terms may lead to a permanent ban.
### 4. Permanent Ban
**Community Impact**: Demonstrating a pattern of violation of community
standards, including sustained inappropriate behavior, harassment of an
individual, or aggression toward or disparagement of classes of individuals.
**Consequence**: A permanent ban from any sort of public interaction within
the community.
## Attribution
This Code of Conduct is adapted from the [Contributor Covenant][homepage],
version 2.0, available at
[https://www.contributor-covenant.org/version/2/0/code_of_conduct.html][v2.0].
Community Impact Guidelines were inspired by
[Mozilla's code of conduct enforcement ladder][Mozilla CoC].
For answers to common questions about this code of conduct, see the FAQ at
[https://www.contributor-covenant.org/faq][FAQ]. Translations are available
at [https://www.contributor-covenant.org/translations][translations].
[homepage]: https://www.contributor-covenant.org
[v2.0]: https://www.contributor-covenant.org/version/2/0/code_of_conduct.html
[Mozilla CoC]: https://github.com/mozilla/diversity
[FAQ]: https://www.contributor-covenant.org/faq
[translations]: https://www.contributor-covenant.org/translations

@ -6,11 +6,11 @@ I welcome pull requests. But accepting a PR obligates me to maintain that code f
* PRs for simple documentation fixes (e.g., spelling and grammar corrections) are always welcome. For more substantial changes, I dont necessarily prefer PRs to issues or feature requests. A good description of the problem with a working example is better than a half-baked PR. I can often fix it in less time than it would take to review the PR. (= Principle of Efficiency)
* If you want feedback on a potential PR, I recommend posting to the [Pollen mailing list](http://groups.google.com/forum/#!forum/pollenpub) rather than here. Because more people will see it. (= Principle of Exposure)
* If you want feedback on a potential PR, I recommend posting to the [Pollen forum](https://forums.matthewbutterick.com/c/typesetting/) rather than here. Because more people will see it. (= Principle of Exposure)
* Small PRs are easier to accept than large ones. Large PRs should have a benefit worthy of their complexity. PRs that want to amend Pollens public interface receive the highest scrutiny. (= Principle of Proportionality)
* I consider every PR, but I cant promise detailed code reviews or comments. Helpful Racketeers can be found on the [Pollen mailing list](http://groups.google.com/forum/#!forum/pollenpub), the [Racket mailing list](https://lists.racket-lang.org/), and the Racket [Slack channel](https://racket.slack.com/). (= Principle of Specialization)
* I consider every PR, but I cant promise detailed code reviews or comments. Helpful Racketeers can be found on the [Pollen forum](https://forums.matthewbutterick.com/c/pollen/), the [Racket mailing list](https://lists.racket-lang.org/), and the Racket [Slack channel](https://racket.slack.com/). (= Principle of Specialization)
* PRs should be necessary, in the sense that the proposed change can only be accomplished by patching this repo. (Corollary: features that can live in a separate [package](https://pkgs.racket-lang.org/) probably should.) (= Principle of Necessity)

@ -1,4 +1,4 @@
## Pollen: the book is a program [![Build Status](https://travis-ci.org/mbutterick/pollen.svg?branch=master)](https://travis-ci.org/mbutterick/pollen)
## Pollen: the book is a program [![Contributor Covenant](https://img.shields.io/badge/Contributor%20Covenant-2.0-4baaaa.svg)](CODE_OF_CONDUCT.md)
A book-publishing system written in [Racket](http://racket-lang.org). This is the software I use to publish & maintain my web-based books [Beautiful Racket](http://beautifulracket.com), [Practical Typography](http://practicaltypography.com), and [Typography for Lawyers](http://typographyforlawyers.com).
@ -23,8 +23,12 @@ And update like so:
raco pkg update --update-deps pollen
Official discussion area: https://github.com/mbutterick/pollen-users
Official forum: https://forums.matthewbutterick.com/c/typesetting/
## License
MIT
## Project status
Actively developed, though the pace has slowed now that Pollen is arguably feature complete and stable. I use it almost every day so it's not going anywhere. But I have no plans to substantially enlarge or extend it.

@ -1,7 +1,7 @@
#lang info
(define collection 'multi)
(define version "3.1")
(define version "3.2")
(define deps '(["base" #:version "6.3"]
["txexpr" #:version "0.2"]
["sugar" #:version "0.2"]

@ -39,7 +39,7 @@
(λ (path-or-path-string subkey caller-name)
(define path
(with-handlers ([exn:fail? (path-error-handler caller-name path-or-path-string)])
(path->complete-path (if (path? path-or-path-string)
(simple-form-path (if (path? path-or-path-string)
path-or-path-string
(string->path path-or-path-string)))))
(unless (file-exists? path)

@ -4,6 +4,6 @@
(define raco-commands '(("pollen" (submod pollen/private/command raco) "issue Pollen command" #f)))
(define compile-omit-paths '("test" "tools" "server-extras" "scribblings/third-tutorial-files"))
;; it's redundant to test "pollen.scrbl" because it incorporates the other scribble sources by reference
(define test-omit-paths '("test/data" "tools" "server-extras" "scribblings/third-tutorial-files"))
(define test-omit-paths '("test/data" "tools" "server-extras" "scribblings/third-tutorial-files" "test/test-project-port.rkt"))
;; don't put #"p" in this list because it's not a #lang
(define module-suffixes '(#"pp" #"pm" #"pmd" #"ptree"))

@ -1,12 +1,7 @@
#lang racket/base
#|
Implements the pollen/mode metalanguage.
Problem is that scribble/reader, and the at-exp metalanguage, changed after 6.1.
So this file
a) adapts the at-exp metalang from 6.2
b) incorporates the scribble/reader from 6.2
so that everything will work correctly in 6.0.
Implements the pollen/mode metalanguage. Certain values are hardcoded inside the Racket source, so we have to copy & paste, a little.
Note that pollen/mode uses a hardcoded #\◊, as the command char, NOT (setup:command-char),
because importing `pollen/setup` will create a loading loop
@ -15,41 +10,20 @@ Intractable problem; unavoidable limitation.
|#
(module* runtime-config racket/base
(provide configure)
(require (only-in (submod ".." at-reader) make-at-readtable))
(define (configure data)
(define old-read (current-read-interaction))
(define (new-read src in)
(parameterize ([current-readtable (make-at-readtable #:readtable (current-readtable))])
(old-read src in)))
(current-read-interaction new-read)))
;; because the reader "boots" from `pollen/mode`,
;; Racket looks for the `language-info` submodule in `pollen/mode`
;; so we just re-export the default.
(module language-info racket/base
(require at-exp/lang/language-info)
(provide (all-from-out at-exp/lang/language-info)))
(module* language-info racket/base
(provide get-language-info)
(require racket/match)
(define (get-language-info data)
(define other-get-info
(match data
[(vector mod sym data2)
((dynamic-require mod sym) data2)]
[_ (λ (key default) default)]))
(λ (key default)
(case key
[(configure-runtime)
(define config-vec '#[(submod pollen/mode runtime-config) configure #f])
(define other-config (other-get-info key default))
(cond [(list? other-config) (cons config-vec other-config)]
[else (list config-vec)])]
[else (other-get-info key default)]))))
;; adapted from
;; https://github.com/racket/racket/blob/master/pkgs/at-exp-lib/at-exp/lang/reader.rkt
(module* reader racket/base
(require syntax/module-reader
(only-in (submod ".." at-reader) make-at-readtable))
(only-in scribble/reader make-at-readtable))
(provide (rename-out [at-read read]
[at-read-syntax read-syntax]
@ -81,7 +55,7 @@ Intractable problem; unavoidable limitation.
(λ 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))
(define new-prop `#(at-exp/lang/language-info get-language-info ,old-prop))
(syntax-property stx 'module-language new-prop)))
(λ (proc)
(λ (key defval)
@ -99,675 +73,3 @@ Intractable problem; unavoidable limitation.
[(drracket:indentation)
(dynamic-require 'pollen/private/external/mode-indentation 'determine-spaces)]
[else (fallback)]))))))
(module at-reader racket/base
;; ============================================================================
;; Implements the @-reader macro for embedding text in Racket code.
(require syntax/readerr)
;; ----------------------------------------------------------------------------
;; utilities for syntax specifications below
;; regexps
(define (px . args)
(let* ([args (let loop ([xs args])
(if (list? xs) (apply append (map loop xs)) (list xs)))]
[args (map (lambda (x)
(cond [(bytes? x) x]
[(string? x) (string->bytes/utf-8 x)]
[(char? x) (regexp-quote (string->bytes/utf-8 (string x)))]
[(not x) #""]
[else (internal-error 'px)]))
args)])
(byte-pregexp (apply bytes-append args))))
(define (^px . args) (px #"^" args))
;; reverses a byte string visually
(define reverse-bytes
(let ([pairs (let ([xs (bytes->list #"([{<")]
[ys (bytes->list #")]}>")])
(append (map cons xs ys) (map cons ys xs)))])
(define (rev-byte b)
(cond [(assq b pairs) => cdr]
[else b]))
(lambda (bs) (list->bytes (map rev-byte (reverse (bytes->list bs)))))))
;; ----------------------------------------------------------------------------
;; syntax
;; basic syntax customization
(define ch:command #\@)
(define ch:comment #\;)
(define ch:expr-escape #\|)
(define ch:datums-begin #\[)
(define ch:datums-end #\])
(define ch:lines-begin #\{)
(define ch:lines-end #\})
(define str:lines-begin* #"(\\|[^a-zA-Z0-9 \t\r\n\f@\\\177-\377{]*)\\{")
(define str:end-of-line "[ \t]*\r?\n[ \t]*") ; eat spaces on the next line
;; regexps based on the above (more in make-dispatcher)
(define re:whitespaces (^px "\\s+"))
(define re:comment-start (^px ch:comment))
(define re:comment-line (^px "[^\n]*(?:\n|$)[ \t]*")) ; like tex's `%'
(define re:expr-escape (^px ch:expr-escape))
(define re:datums-begin (^px ch:datums-begin))
(define re:datums-end (^px ch:datums-end))
(define re:lines-begin (^px ch:lines-begin))
(define re:lines-begin* (^px str:lines-begin*))
(define re:lines-end (^px ch:lines-end))
(define re:end-of-line (^px str:end-of-line))
;; ----------------------------------------------------------------------------
;; utilities
(define (internal-error label)
(error 'scribble-reader "internal error [~a]" label))
;; like `regexp-try-match', without extras; the regexp that is used
;; must be anchored -- nothing is dropped
(define (*regexp-match-peek-positions pattern input-port)
#; ; sanity checks, not needed unless this file is edited
(unless (and (byte-regexp? pattern)
(regexp-match? #rx#"^\\^" (object-name pattern)))
(internal-error 'invalid-bregexp))
(regexp-match-peek-positions pattern input-port))
;; the following doesn't work -- must peek first
;; (define (*regexp-match-positions pattern input-port)
;; #; ; sanity checks, not needed unless this file is edited
;; (unless (and (byte-regexp? pattern)
;; (regexp-match? #rx#"^\\^" (object-name pattern)))
;; (internal-error 'invalid-bregexp))
;; (regexp-match-peek-positions pattern input-port))
(define (*regexp-match pattern input-port)
(let ([m (*regexp-match-peek-positions pattern input-port)])
(and m (let ([s (read-bytes (cdar m) input-port)])
(cons s (map (lambda (p) (and p (subbytes s (car p) (cdr p))))
(cdr m)))))))
;; like regexp-match, but returns the whole match
(define (*regexp-match1 pattern input-port)
(let ([m (*regexp-match-peek-positions pattern input-port)])
(and m (read-bytes (cdar m) input-port))))
;; Utility for readtable-based caches
(define (readtable-cached fun)
(let ([cache (make-weak-hasheq)])
(letrec ([readtable-cached
(case-lambda
[(rt) (hash-ref cache rt
(lambda ()
(let ([r (fun rt)])
(hash-set! cache rt r)
r)))]
[() (readtable-cached (current-readtable))])])
readtable-cached)))
;; Skips whitespace characters, sensitive to the current readtable's
;; definition of whitespace; optimizes common spaces when possible
(define skip-whitespace
(let* ([plain-readtables (make-weak-hasheq)]
[plain-spaces " \t\n\r\f"]
[plain-spaces-list (string->list " \t\n\r\f")]
[plain-spaces-re (^px "[" plain-spaces "]*")])
(define (skip-plain-spaces port)
;; hack: according to the specs, this might consume more characters
;; than needed, but it works fine with a simple <ch>* regexp (because
;; it can always match an empty string)
(*regexp-match-peek-positions plain-spaces-re port))
(define (whitespace? ch rt)
(if rt
(let-values ([(like-ch/sym _1 _2) (readtable-mapping rt ch)])
;; if like-ch/sym is whitespace, then ch is whitespace
(and (char? like-ch/sym) (char-whitespace? like-ch/sym)))
;; `char-whitespace?' is fine for the default readtable
(char-whitespace? ch)))
(define plain-readtable?
(readtable-cached
(lambda (rt)
(andmap (lambda (ch) (whitespace? ch rt)) plain-spaces-list))))
(lambda (port)
(let* ([rt (current-readtable)] [plain? (plain-readtable? rt)])
(let loop ()
(when plain? (skip-plain-spaces port))
(let ([ch (peek-char port)])
(unless (eof-object? ch)
(when (whitespace? ch rt) (read-char port) (loop)))))))))
;; make n spaces, cached for n
(define make-spaces
(let ([t (make-hasheq)])
(lambda (n)
(hash-ref t n
(lambda ()
(let ([s (make-string n #\space)])
(hash-set! t n s) s))))))
(define (bytes-width bs start)
(let ([len (bytes-length bs)])
(if (regexp-match? #rx"^ *$" bs start)
(- (bytes-length bs) start)
(let loop ([i start] [w 0])
(if (= i len)
w
(loop (add1 i)
(+ w (if (eq? 9 (bytes-ref bs i)) (- 8 (modulo w 8)) 1))))))))
;; A syntax object that has the "original?" property:
(define orig-stx (read-syntax #f (open-input-string "dummy")))
;; ----------------------------------------------------------------------------
;; main reader function for @ constructs
(define (dispatcher char inp source-name line-num col-num position
start-inside? command-readtable ch:command
re:command re:line-item* re:line-item
re:line-item-no-nests datum-readtable
syntax-post-processor)
(define (read-error line col pos msg . xs)
(let* ([eof? (and (eq? 'eof msg) (pair? xs))]
[msg (apply format (if eof? xs (cons msg xs)))])
((if eof? raise-read-error raise-read-eof-error)
msg (or source-name (object-name inp)) line col pos (span-from pos))))
(define (read-error* . xs)
(apply read-error line-num col-num position xs))
(define (read-stx) (read-syntax/recursive source-name inp))
(define (read-stx/rt rt) (read-syntax/recursive source-name inp #f rt))
;; use this to avoid placeholders
(define (read-stx*)
;; (read-syntax/recursive source-name inp #f (current-readtable) #f)
(read-syntax source-name inp))
(define (*match rx) (*regexp-match rx inp))
(define (*match1 rx) (*regexp-match1 rx inp))
;; (define (*skip rx) (*regexp-match-positions rx inp)) ; <- see above
(define (*skip rx) (*regexp-match1 rx inp))
(define (*peek rx) (*regexp-match-peek-positions rx inp))
(define (span-from start)
(and start (let-values ([(line col pos) (port-next-location inp)])
(- pos start))))
(define (read-delimited-list begin-re end-re end-ch)
(let-values ([(line col pos) (port-next-location inp)])
(and (*skip begin-re)
(let loop ([r '()])
(skip-whitespace inp)
(if (*skip end-re)
(reverse r)
(let ([x (read-stx)])
(if (eof-object? x)
(read-error line col pos 'eof "expected a '~a'" end-ch)
(loop (if (special-comment? x) r (cons x r))))))))))
;; identifies newlines in text
(define (eol-syntax? x)
(let ([p (and (syntax? x) (syntax-property x 'scribble))])
(and (pair? p) (eq? 'newline (car p)))))
;; gets an accumulated (reversed) list of syntaxes and column markers, and
;; sorts things out (remove prefix and suffix newlines, adds indentation if
;; needed)
(define (done-items xs)
;; a column marker is either a non-negative integer N (saying the following
;; code came from at column N), or a negative integer -N (saying that the
;; following code came from column N but no need to add indentation at this
;; point because it is at the openning of a {...}); `get-lines*' is careful
;; not to include column markers before a newline or the end of the text,
;; and a -N marker can only come from the beginning of the text (and it's
;; never there if the text began with a newline)
(if (andmap eol-syntax? xs)
;; nothing to do
(reverse xs)
(let ([mincol (let loop ([xs xs] [m #f])
(if (null? xs)
m
(let ([x (car xs)])
(loop (cdr xs)
(if (integer? x)
(let ([x (abs x)]) (if (and m (< m x)) m x))
m)))))])
(let loop ([xs (if (and (not start-inside?) (eol-syntax? (car xs)))
(cdr xs) ; trim last eol
xs)]
[r '()])
(if (or (null? xs)
(and (not start-inside?)
;; trim first eol
(null? (cdr xs)) (eol-syntax? (car xs))))
r
(loop
(cdr xs)
(let ([x (car xs)])
(cond [(integer? x)
(if (or (< x 0) (= x mincol))
r ; no indentation marker, or zero indentation
(let ([eol (cadr xs)]
[spaces (make-spaces (- x mincol))])
;; markers always follow end-of-lines
(unless (eol-syntax? eol)
(internal-error 'done-items))
(cons (syntax-property
(datum->syntax eol spaces eol)
'scribble 'indentation)
r)))]
;; can have special comment values from "@||"
[(special-comment? x) r]
[else (cons x r)]))))))))
;; cons stx (new syntax) to the list of stxs, merging it if both are
;; strings, except for newline markers
(define (maybe-merge stx stxs)
(let* ([2nd (and (syntax? stx) (syntax-e stx))]
[stx0 (and (pair? stxs) (car stxs))]
[1st (and (syntax? stx0) (syntax-e stx0))])
(if (and (string? 1st) (not (eol-syntax? stx0))
(string? 2nd) (not (eol-syntax? stx)))
(cons (datum->syntax stx0
(string-append 1st 2nd)
(vector (syntax-source stx0)
(syntax-line stx0)
(syntax-column stx0)
(syntax-position stx0)
;; this is called right after reading stx
(span-from (syntax-position stx0)))
stx0)
(cdr stxs))
(cons stx stxs))))
;; helper for `get-lines*' drop a column marker if the previous item was also
;; a newline (or the beginning)
(define (maybe-drop-marker r)
(if (and (pair? r) (integer? (car r))
(or (null? (cdr r)) (eol-syntax? (cadr r))))
(cdr r)
r))
(define (get-lines* re:begin re:end re:cmd-pfx re:item end-token)
;; re:begin, re:end, end-token can be false if start-inside? is #t;
;; re:cmd-pfx is a regexp when we do sub-@-reads only after a prefix
(let loop ([lvl 0]
[r (let-values ([(l c p) (port-next-location inp)])
;; marker for the beginning of the text
(if c (list (- c)) '()))])
;; this loop collects lines etc for the body, and also puts in column
;; markers (integers) after newlines -- the result is handed off to
;; `done-items' to finish the job
(define-values (line col pos) (port-next-location inp))
(define (make-stx sexpr)
(datum->syntax #f
(if (bytes? sexpr) (bytes->string/utf-8 sexpr) sexpr)
(vector source-name line col pos (span-from pos))
orig-stx))
(cond
[(and re:begin (*match1 re:begin))
=> (lambda (m) (loop (add1 lvl) (maybe-merge (make-stx m) r)))]
[(and re:end (*match1 re:end))
=> (lambda (m)
(if (and (zero? lvl) (not start-inside?))
;; drop a marker if it's after a last eol item
(done-items (maybe-drop-marker r))
(loop (sub1 lvl) (maybe-merge (make-stx m) r))))]
[(*match1 re:end-of-line)
=> (lambda (m)
(let ([n (car (regexp-match-positions #rx#"\n" m))])
(loop lvl (list* ; no merge needed
(bytes-width m (cdr n))
(syntax-property
(make-stx "\n")
'scribble `(newline ,(bytes->string/utf-8 m)))
(maybe-drop-marker r)))))]
[(if re:cmd-pfx
(and (*skip re:cmd-pfx) (*peek re:command))
(*peek re:command))
;; read the next value
=> (lambda (m)
(define x (cond [(cadr m)
;; the command is a string escape, use
;; `read-stx*' to not get a placeholder, so we
;; can merge the string to others
(read-stx*)]
[(caddr m)
;; it's an expression escape, get multiple
;; expressions and put them all here
(read-bytes (caaddr m) inp)
(get-escape-expr #f)]
[else (read-stx)])) ; otherwise: a plain sub-read
(loop lvl (cond [(eof-object? x)
;; shouldn't happen -- the sub-read would
;; raise an error
(internal-error 'get-lines*-sub-read)]
;; throw away comments
[(special-comment? x) r]
;; escaped expressions: no merge, and add a
;; comment to prevent merges with later stuff
[(pair? x)
`(,(make-special-comment #f) ,@(reverse x) ,@r)]
[(null? x) (cons (make-special-comment #f) r)]
[else (maybe-merge x r)])))]
;; must be last, since it will always succeed with 1 char
[(*peek re:item) ; don't read: regexp grabs the following text
=> (lambda (m)
(loop lvl
(maybe-merge (make-stx (read-bytes (cdadr m) inp)) r)))]
[(*peek #rx#"^$")
(if end-token
(read-error* 'eof "missing closing `~a'" end-token)
(done-items r))]
[else (internal-error 'get-lines*)])))
(define (get-lines)
(cond [(*skip re:lines-begin) (get-lines* re:lines-begin re:lines-end #f
re:line-item ch:lines-end)]
[(*match re:lines-begin*)
=> (lambda (m)
(let* ([bgn (car m)]
[end (reverse-bytes bgn)]
[bgn* (regexp-quote bgn)]
[end* (regexp-quote end)]
[cmd-pfx* (regexp-quote (cadr m))])
(get-lines* (^px bgn*) (^px end*)
(^px cmd-pfx* "(?=" ch:command ")")
(re:line-item* bgn* end* cmd-pfx*)
end)))]
[else #f]))
(define (get-datums)
(parameterize ([current-readtable datum-readtable])
(read-delimited-list re:datums-begin re:datums-end ch:datums-end)))
(define (get-escape-expr single?)
;; single? means expect just one expression (or none, which is returned as
;; a special-comment)
(let ([get (lambda ()
(parameterize ([current-readtable command-readtable])
(read-delimited-list re:expr-escape re:expr-escape
ch:expr-escape)))])
(if single?
(let*-values ([(line col pos) (port-next-location inp)]
[(xs) (get)])
(cond [(not xs) xs]
[(or (null? xs) (not (null? (cdr xs))))
(read-error line col pos
"a ~a|...| form in Racket mode must have ~a"
ch:command
"exactly one escaped expression")]
[else (car xs)]))
(get))))
;; called only when we must see a command in the input
(define (get-command)
(let ([cmd (read-stx/rt command-readtable)])
(cond [(special-comment? cmd)
(read-error* "expecting a command expression, got a comment")]
[(eof-object? cmd)
(read-error* 'eof "missing command")]
;; we have a command: adjust its location to include the dispatch
;; character
[else
;; (datum->syntax #f (syntax-e cmd)
;; (vector (syntax-source cmd)
;; (syntax-line cmd)
;; (cond [(syntax-column cmd) => sub1] [else #f])
;; (cond [(syntax-position cmd) => sub1] [else #f])
;; (cond [(syntax-span cmd) => add1] [else #f]))
;; orig-stx)
;; The reasoning for the above is that in `@foo' the `@' is part
;; of the syntax of the identifier, in a similar way to including
;; the double quotes in the position information for a string
;; syntax or the backslash in a mzscheme \foo identifier. Another
;; feature of this is that there needs to be some way to know what
;; was the actual source of some syntax. However, this is
;; problematic in two ways: (a) it can be confusing that
;; highlighting an identifier highlights the `@' too, and more
;; importantly, it makes `@|foo|' be treated differently than
;; `@foo'. So we'll try to not do this adjusting.
cmd])))
(define (get-rprefixes) ; return punctuation prefixes in reverse
(let loop ([r '()])
(let-values ([(line col pos) (port-next-location inp)])
(cond [(*match1 #rx#"^#?(?:'|`|,@?)")
=> (lambda (m)
(let ([sym (cond [(assoc m '([#"'" quote]
[#"`" quasiquote]
[#"," unquote]
[#",@" unquote-splicing]
[#"#'" syntax]
[#"#`" quasisyntax]
[#"#," unsyntax]
[#"#,@" unsyntax-splicing]))
=> cadr]
[else (internal-error 'get-rprefixes)])])
(loop (cons (datum->syntax #f sym
(vector source-name line col
pos (span-from pos))
orig-stx)
r))))]
[(*skip re:whitespaces)
(read-error* "unexpected whitespace after ~a" ch:command)]
[else r]))))
(cond
[start-inside?
(datum->syntax #f (get-lines* #f #f #f re:line-item-no-nests #f)
(vector source-name line-num col-num position (span-from position))
orig-stx)]
[(*skip re:whitespaces)
(read-error* "unexpected whitespace after ~a" ch:command)]
[(*skip re:comment-start)
(unless (get-lines) (*skip re:comment-line))
(make-special-comment #f)]
[else
(let*-values
([(rpfxs) (get-rprefixes)]
[(cmd datums lines)
(cond [(get-lines)
;; try get-lines first -- so @|{...}| is not used as a simple
;; expression escape, same for get-datums
=> (lambda (lines) (values #f #f lines))]
[(get-datums)
=> (lambda (datums) (values #f datums (get-lines)))]
[(get-escape-expr #t) => (lambda (expr) (values expr #f #f))]
[else (values (get-command) (get-datums) (get-lines))])]
[(stx) (and (or datums lines)
(append (or datums '()) (or lines '())))]
[(stx) (or (and cmd stx (cons cmd stx)) ; all parts
stx ; no cmd part => just a parenthesized expression
cmd ; no datums/lines => simple expression (no parens)
;; impossible: either we saw []s or {}s, or we read a
;; racket expression
(internal-error 'dispatcher))]
[(stx) (let ([ds (and datums (length datums))]
[ls (and lines (length lines))])
(syntax-property
(if (syntax? stx)
stx
(datum->syntax #f stx
(vector source-name line-num col-num position
(span-from position))
orig-stx))
'scribble (list 'form ds ls)))]
[(stx) (syntax-post-processor stx)]
[(stx)
;; wrap the prefixes around the result
(let loop ([rpfxs rpfxs] [stx stx])
(if (null? rpfxs)
stx
(loop (cdr rpfxs) (list (car rpfxs) stx))))])
(datum->syntax #f stx (vector source-name line-num col-num position
(span-from position))
orig-stx))]))
(define (make-dispatcher start-inside? ch:command
get-command-readtable get-datum-readtable
syntax-post-processor)
(define re:command (^px ch:command
;; the following identifies string and expression
;; escapes, see how it is used above
"(?:(\")|("ch:expr-escape"))?"))
(define (re:line-item* bgn end cmd-prefix)
(^px "(.+?)(?:" (and bgn `(,bgn"|")) (and end `(,end"|"))
cmd-prefix ch:command"|"str:end-of-line"|$)"))
(define re:line-item (re:line-item* ch:lines-begin ch:lines-end #f))
(define re:line-item-no-nests (and start-inside? (re:line-item* #f #f #f)))
(lambda (char inp source-name line-num col-num position)
(dispatcher char inp source-name line-num col-num position
start-inside? (get-command-readtable) ch:command
re:command re:line-item* re:line-item re:line-item-no-nests
(get-datum-readtable) syntax-post-processor)))
;; ----------------------------------------------------------------------------
;; minor utilities for the below
(define default-src (gensym 'scribble-reader))
(define (src-name src port)
(if (eq? src default-src) (object-name port) src))
(define-syntax-rule (named-lambda (name . args) . body)
(let ([name (lambda args . body)]) name))
;; ----------------------------------------------------------------------------
;; readtable and reader
(provide make-at-readtable make-at-reader)
(define ((make-at-readtable-or-inside-reader inside-reader?)
readtable command-char command-readtable datum-readtable syntax-post-processor)
(define (get-cmd-rt)
(if (readtable? cmd-rt)
cmd-rt
(cmd-rt)))
(define (get-datum-rt)
(if (eq? datum-rt 'dynamic)
(current-readtable)
datum-rt))
(define dispatcher
(make-dispatcher #f command-char get-cmd-rt get-datum-rt
syntax-post-processor))
(define (make-inside-reader)
(define dispatcher
(make-dispatcher #t command-char get-cmd-rt get-datum-rt
syntax-post-processor))
;; use a name consistent with `make-at-reader'
(named-lambda (at-read-syntax/inside [src default-src]
[inp (current-input-port)])
(define-values [line col pos] (port-next-location inp))
(parameterize ([current-readtable at-rt])
(dispatcher #f inp (src-name src inp) line col pos))))
(define at-rt
(make-readtable readtable command-char 'non-terminating-macro dispatcher))
(define command-bar
(lambda (char inp source-name line-num col-num position)
(let ([m (*regexp-match #rx#"^([^|]*)\\|" inp)])
(unless m
(raise-read-error "unbalanced `|'" source-name
line-num col-num position #f))
(datum->syntax
#f (string->symbol (bytes->string/utf-8 (cadr m)))
(vector source-name line-num col-num position
(add1 (bytes-length (car m))))
orig-stx))))
(define (make-cmd-rt command-readtable)
;; similar to plain Racket (scribble, actually), but with `@' as usual and
;; and `|' as a terminating macro characters (otherwise it behaves the
;; same; the only difference is that `a|b|c' is three symbols)
(make-readtable command-readtable
command-char 'non-terminating-macro dispatcher
#\| 'terminating-macro command-bar))
(define cmd-rt
(if (eq? command-readtable 'dynamic)
(readtable-cached make-cmd-rt)
(make-cmd-rt command-readtable)))
(define datum-rt
(cond [(or (not datum-readtable) (readtable? datum-readtable))
datum-readtable]
[(eq? #t datum-readtable) at-rt]
[(procedure? datum-readtable) (datum-readtable at-rt)]
[(eq? datum-readtable 'dynamic) 'dynamic]
[else (error 'make-at-readtable
"bad datum-readtable: ~e" datum-readtable)]))
(if inside-reader? (make-inside-reader) at-rt))
(define (make-at-readtable
#:readtable [readtable (current-readtable)]
#:command-char [command-char ch:command]
#:command-readtable [command-readtable readtable]
#:datum-readtable [datum-readtable #t]
#:syntax-post-processor [syntax-post-processor values])
((make-at-readtable-or-inside-reader #f)
readtable command-char command-readtable datum-readtable syntax-post-processor))
(define (make-at-reader
#:readtable [readtable (current-readtable)]
#:command-char [command-char ch:command]
#:datum-readtable [datum-readtable #t]
#:command-readtable [command-readtable readtable]
#:syntax-post-processor [syntax-post-processor values]
#:syntax? [syntax-reader? #t]
#:inside? [inside-reader? #f])
(let ([r ((make-at-readtable-or-inside-reader inside-reader?)
readtable command-char command-readtable datum-readtable syntax-post-processor)])
;; the result can be a readtable or a syntax reader, depending on inside?,
;; convert it now to the appropriate reader
(if inside-reader?
;; if it's a function, then it already is a syntax reader, convert it to
;; a plain reader if needed (note: this only happens when r is a reader)
(if syntax-reader?
r
(named-lambda (at-read/inside [in (current-input-port)])
;; can't be eof, since it returns a list of expressions (as a syntax)
(syntax->datum (r (object-name in) in))))
;; if it's a readtable, then just wrap the standard functions
(if syntax-reader?
(named-lambda (at-read-syntax [src default-src]
[inp (current-input-port)])
(parameterize ([current-readtable r])
(read-syntax src inp)))
(named-lambda (at-read [inp (current-input-port)])
(parameterize ([current-readtable r])
(let ([r (read-syntax (object-name inp) inp)])
;; it might be eof
(if (syntax? r) (syntax->datum r) r))))))))
(provide use-at-readtable)
(define use-at-readtable
(make-keyword-procedure
(lambda (kws kw-args . rest)
(port-count-lines! (current-input-port))
(current-readtable
(keyword-apply make-at-readtable kws kw-args rest)))))
;; utilities for below
(define make-default-at-readtable
(readtable-cached (lambda (rt) (make-at-readtable #:readtable rt
#:command-readtable 'dynamic
#:datum-readtable 'dynamic))))
(define make-default-at-reader/inside
(readtable-cached
(lambda (rt) (make-at-reader #:inside? #t #:readtable rt
#:command-readtable 'dynamic
#:datum-readtable 'dynamic))))
;; ----------------------------------------------------------------------------
;; readers
(provide (rename-out [*read read] [*read-syntax read-syntax]))
(define (*read [inp (current-input-port)])
(parameterize ([current-readtable (make-default-at-readtable)])
(read inp)))
(define (*read-syntax [src default-src] [inp (current-input-port)])
(parameterize ([current-readtable (make-default-at-readtable)])
(read-syntax (src-name src inp) inp)))
(provide read-inside read-syntax-inside)
(define (read-inside [inp (current-input-port)])
(syntax->datum ((make-default-at-reader/inside) default-src inp)))
(define (read-syntax-inside [src default-src] [inp (current-input-port)]
#:command-char [command-char ch:command])
(((readtable-cached
(lambda (rt) (make-at-reader #:inside? #t #:command-char command-char #:readtable rt))))
src inp)))

@ -48,9 +48,9 @@
(define pt-root-tag (setup:pagetree-root-node))
(define (splice-nested-pagetree xs)
(apply append (for/list ([x (in-list xs)])
(if (and (txexpr? x) (eq? (get-tag x) pt-root-tag))
(get-elements x)
(list x)))))
(if (and (txexpr? x) (eq? (get-tag x) pt-root-tag))
(get-elements x)
(list x)))))
(validate-pagetree
(decode (cons pt-root-tag xs)
#:txexpr-elements-proc (compose1 splice-nested-pagetree (λ (xs) (filter-not whitespace? xs)))
@ -63,7 +63,7 @@
(define pagenodes (pagetree-strict->list x))
(for ([p (in-list pagenodes)]
#:unless (pagenode? p))
(raise-argument-error 'validate-pagetree "valid pagenodes" p))
(raise-argument-error 'validate-pagetree "valid pagenodes" p))
(with-handlers ([exn:fail? (λ (e) (error 'validate-pagetree "~a" (exn-message e)))])
(members-unique?/error pagenodes))
x)))
@ -137,7 +137,7 @@
(if (memq pagenode (map topmost-node current-children))
current-parent
(for/or ([st (in-list (filter list? current-children))])
(loop pagenode st))))))
(loop pagenode st))))))
(if (eq? result (first pt))
(and allow-root? result)
result))
@ -159,7 +159,7 @@
(match pagenode
[(== (first pt) eq?) (map topmost-node (rest pt))]
[_ (for/or ([subtree (in-list (filter pair? pt))])
(loop pagenode subtree))]))))
(loop pagenode subtree))]))))
(module-test-external
@ -190,7 +190,7 @@
(((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?))
(match (for/list ([sib (in-list (or (siblings pnish pt-or-path) empty))]
#:unless (eq? sib (->pagenode pnish)))
sib)
sib)
[(? pair? sibs) sibs]
[_ #false]))
@ -220,11 +220,15 @@
(define+provide/contract (pagetree->paths pt-or-path)
((or/c pagetree? pathish?) . -> . (listof complete-path?))
(parameterize ([current-directory (current-project-root)])
(map ->complete-path (pagetree->list (match pt-or-path
[(? pagetree? pt) pt]
[_ (cached-doc pt-or-path)])))))
(define-values (dir-for-resolving-paths pt)
(match pt-or-path
[(? pagetree?) (values (current-project-root) pt-or-path)]
[_ (define dir (match (dirname (->path pt-or-path))
['relative (current-project-root)]
[dir dir]))
(values dir (cached-doc pt-or-path))]))
(parameterize ([current-directory dir-for-resolving-paths])
(map ->complete-path (pagetree->list pt))))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
@ -304,7 +308,17 @@
(define starting-dir (match starting-path
[(? directory-exists?) starting-path]
[_ (dirname starting-path)]))
(->output-path (find-relative-path (->complete-path starting-dir) (->complete-path path))))
(define relpath (if (eq? starting-dir 'relative)
path
(find-relative-path (->complete-path starting-dir) (->complete-path path))))
(->output-path relpath))
(module-test-external
(check-equal? (path->pagenode "/foo/bar/index.html" "/foo") 'foo/bar/index.html)
(check-equal? (path->pagenode "/foo/bar/index.html" "/foo/bar") 'bar/index.html)
(check-equal? (path->pagenode "/foo/bar/index.html" (string->path "/foo/bar")) 'bar/index.html)
(check-equal? (path->pagenode "/foo/bar/index.html" "/foo/bar/other.html") 'index.html)
(check-equal? (path->pagenode "assets" 'index.html) 'assets))
(define+provide/contract (in-pagetree? pnish [pt-or-path (current-pagetree)])

@ -36,7 +36,7 @@
;; user-designated files to track
(map ->string (setup:cache-watchlist source-path)))))
(define env-rec (for/list ([env-name (in-list (cons default-env-name (sort (setup:envvar-watchlist source-path) bytes<?)))])
(cons env-name (match (getenv (string-downcase (->string env-name)))
(cons env-name (match (getenv (->string env-name))
[#false #false]
[str (string-downcase (->string str))]))))
(define poly-flag (and (has-inner-poly-ext? source-path) (current-poly-target)))

@ -52,7 +52,7 @@
'pollen)]))
(define (very-nice-path x)
(path->complete-path (simplify-path (cleanse-path (->path x)))))
(simple-form-path (cleanse-path (->path x))))
(define (handle-test)
(displayln "raco pollen is installed correctly"))
@ -175,21 +175,23 @@ version print the version" (current-server-port) (make-publish-di
(define (handle-start)
(define launch-wanted #f)
(define localhost-wanted #f)
(define clargs
(command-line #:program "raco pollen start"
#:argv (vector-drop (current-command-line-arguments) 1) ; snip the 'start' from the front
#:once-each
[("--launch" "-l") "Launch browser after start" (set! launch-wanted #t)]
[("--local") "Restrict access to localhost" (set! localhost-wanted #t)]
#:args other-args
other-args))
(define dir (path->directory-path (get-first-arg-or-current-dir clargs)))
(unless (directory-exists? dir)
(error (format "~a is not a directory" dir)))
(define http-port (with-handlers ([exn:fail? (λ (e) #f)])
(string->number (cadr clargs))))
(when (and http-port (not (exact-positive-integer? http-port)))
(error (format "~a is not a valid port number" http-port)))
(define-values (dir http-port)
(command-line
#:program "raco pollen start"
#:argv (vector-drop (current-command-line-arguments) 1) ; snip the 'start' from the front
#:once-each
[("--launch" "-l") "Launch browser after start" (set! launch-wanted #t)]
[("--local") "Restrict access to localhost" (set! localhost-wanted #t)]
#:args ([dir (current-directory)] [port #f])
(define parsed-dir
(path->directory-path (normalize-path (very-nice-path dir))))
(unless (directory-exists? parsed-dir)
(error (format "~a is not a directory" parsed-dir)))
(define parsed-port (and port (string->number port)))
(when (and parsed-port (not (exact-positive-integer? parsed-port)))
(error (format "~a is not a valid port number" parsed-port)))
(values parsed-dir parsed-port)))
(parameterize ([current-project-root dir]
[current-server-port (or http-port (setup:project-server-port))]
[current-server-listen-ip (and localhost-wanted "127.0.0.1")]

@ -0,0 +1,10 @@
#lang info
;; 210309
;; for unknown reason "mode-indentation.rkt"
;; started causing CI failures since 210215
;; consistently on 6.7, 6.8, 6.9, 7.7CS, 7.8CS, 7.9CS
;; I assume it has something to do with the fact that
;; it imports `framework` and `racket/gui`,
;; OTOH why does it fail in these?
(define test-omit-paths '("mode-indentation.rkt"))

@ -6,7 +6,9 @@
framework)
#|
Identical to scribble/private/indentation except it uses #\◊ rather than #\@ as the command char.
Identical to scribble/private/indentation except it uses #\◊ rather than #\@ as the command char, because these values are hard-coded within the indentation module.
https://github.com/racket/gui/blob/master/gui-lib/scribble/private/indentation.rkt
In the unit tests, `scribble/base` became `pollen/markup`
and `scribble/manual` became `pollen/markdown`

@ -19,10 +19,9 @@
(parameterize ([current-directory (dirname (->complete-path starting-path))])
(let loop ([dir (current-directory)][path filename-to-find])
(and dir ; dir is #f when it hits the top of the filesystem
(let ([completed-path (path->complete-path path)])
(if (exists-proc completed-path)
(simplify-path completed-path)
(loop (dirname dir) (build-path 'up path))))))))
(match (simple-form-path path)
[(? exists-proc sfp) sfp]
[_ (loop (dirname dir) (build-path 'up path))])))))
;; for files like svg that are not source in pollen terms,
@ -294,7 +293,7 @@
(define+provide (special-path? path)
(define special-paths (append default-cache-names '("compiled" ".git" ".gitignore" ".hg" ".svn" "CVS" "Makefile")))
(define special-paths (append default-cache-names '("compiled" ".git" ".gitignore" ".hg" ".svn" "CVS" "Makefile" ".DS_Store")))
(and (member (path->string (last (explode-path path))) special-paths) #t))
(module-test-internal

@ -31,7 +31,7 @@
pagetree-source?))])
(proc path))
#:unless (path-cached? path))
(path->complete-path path)))
(simple-form-path path)))
(cond
[wants-dry-run? (for-each message uncached-paths)]
@ -53,7 +53,7 @@
(let loop ()
(define path (place-channel-put/get ch (list 'want-job)))
(place-channel-put ch (list 'job-finished path
(with-handlers ([exn:fail? (λ (e) #f)])
(with-handlers ([exn:fail? (λ (e) (cons #false (exn-message e)))])
(path->hash path))))
(loop))))
(handle-evt wp (λ (val) (list* wpidx wp val)))))
@ -69,12 +69,12 @@
(message (format "caching @ job ~a: ~a" (~r (add1 wpidx) #:min-width (string-length (~r job-count)) #:pad-string " ") (find-relative-path starting-dir path)))
(loop rest (cons wpidx actives))])]
[(list wpidx wp 'job-finished path result)
(if result
(cache-ref! (paths->key 'source path) (λ () result))
(message (format "caching failed on job ~a: ~a" (add1 wpidx) (find-relative-path starting-dir path))))
(match result
[(cons #false exn-msg) (message (format "caching failed on job ~a: ~a\n because ~a" (add1 wpidx) (find-relative-path starting-dir path) exn-msg))]
[_ (cache-ref! (paths->key 'source path) (λ () result))])
(loop paths (remq wpidx actives))])))]
[else (for ([path (in-list uncached-paths)])
(message (format "caching: ~a" (find-relative-path starting-dir path)))
(match (with-handlers ([exn:fail? (λ (e) #f)]) (path->hash path))
[#false (message (format "caching failed: ~a" (find-relative-path starting-dir path)))]
(match (with-handlers ([exn:fail? (λ (e) (cons #false (exn-message e)))]) (path->hash path))
[(cons #false exn-msg) (message (format "caching failed: ~a\n because ~a" (find-relative-path starting-dir path) exn-msg))]
[result (cache-ref! (paths->key 'source path) (λ () result))]))]))

@ -1,5 +1,6 @@
#lang racket/base
(require racket/runtime-path
(require racket/async-channel
racket/runtime-path
web-server/dispatch
web-server/web-server
web-server/servlet-dispatch
@ -49,11 +50,11 @@
[("127.0.0.1") "localhost"]
[else clsi]))
"project server permitting access to all clients")))
(message "ready to rock")
(define ch (make-async-channel))
(define stop-func
(parameterize ([error-print-width 1000])
(serve
#:confirmation-channel ch
#:dispatch (sequencer:make
(dispatch/servlet pollen-servlet)
(make-static-dispatcher-sequence
@ -62,9 +63,16 @@
(dispatch/servlet route-404))
#:listen-ip (current-server-listen-ip)
#:port (current-server-port))))
(define exn-or-port
(sync ch))
(when (exn? exn-or-port)
(message "project server failed to start")
(sync (system-idle-evt))
(exit 1))
(message "ready to rock")
(when open-browser-window?
(send-url (string-append server-name servlet-path)))
(if return?
stop-func
(with-handlers ([exn:break? (λ (e) (stop-func) (message "project server stopped"))])
(do-not-return))))
(do-not-return))))

@ -124,6 +124,7 @@
[(eq? mode default-mode-markdown) pollen-markdown-source-ext]
[(eq? mode default-mode-markup) pollen-markup-source-ext]
[(eq? mode default-mode-pagetree) pollen-pagetree-source-ext]))]
[(module-language) 'pollen]
[else default])))
(define-syntax-rule (reader-module-begin mode . _)

@ -1 +1 @@
1601236971
1710316839

@ -2,6 +2,7 @@
(require racket/file
racket/path
racket/match
racket/string
racket/format
racket/place
racket/list
@ -33,7 +34,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 simple-form-path (filter (λ (name) (regexp-match "sample-" name)) (directory-list ".")))))
(define-values (sample-01 sample-02 sample-03) (apply values samples)))
;; each key for mod-date-hash is a list of file / mod-date pairs (using pollen/cache keymaking function)
@ -48,73 +49,84 @@
(define (mod-date-missing-or-changed? source-path template-path)
(not (hash-has-key? mod-date-hash (paths->key 'output source-path template-path))))
(define (parallel-render source-paths-in output-paths-in job-count-arg)
(struct $job (source output) #:transparent)
(struct $jobresult (job finished-successfully) #:transparent)
(define (parallel-render jobs-in worker-count-arg)
;; if jobs are already in the cache, pull them out before assigning workers
;; using worker to fetch from cache is slower
(define source-to-output-path-table (map cons source-paths-in output-paths-in))
(define-values (uncached-source-paths previously-cached-jobs)
(for/fold ([usps null]
[pcjs null])
([source-path (in-list source-paths-in)]
[output-path (in-list output-paths-in)])
(define-values (uncached-jobs previously-cached-jobs)
(for/fold ([ujobs null]
[pcjobs null])
([job (in-list jobs-in)])
(match (let/ec exit
(define template-path
(cache-ref! (template-cache-key source-path output-path) (λ () (exit 'template-miss))))
(render-to-file-if-needed source-path template-path output-path (λ () (exit 'render-miss))))
[(? symbol? sym) (values (cons source-path usps) pcjs)]
[_ (values usps (cons (cons source-path #true) pcjs))])))
(define job-count
(cache-ref! (template-cache-key ($job-source job) ($job-output job)) (λ () (exit 'template-miss))))
(render-to-file-if-needed ($job-source job) template-path ($job-output job) (λ () (exit 'render-miss))))
[(? symbol? sym) (values (cons job ujobs) pcjobs)]
[_ (values ujobs (cons ($jobresult job #true) pcjobs))])))
(define worker-count
(min
(length uncached-source-paths)
(match job-count-arg
(length uncached-jobs)
(match worker-count-arg
[#true (processor-count)]
[(? exact-positive-integer? count) count]
[_ (raise-user-error 'render-batch "~a is not an exact positive integer or #true" job-count-arg)])))
[_ (raise-user-error 'render-batch "~a is not an exact positive integer or #true" worker-count-arg)])))
;; initialize the workers
(define worker-evts
(for/list ([wpidx (in-range job-count)])
(define wp (place ch
(let loop ()
(match-define (list path output-path poly-target)
(place-channel-put/get ch (list 'wants-job)))
(parameterize ([current-poly-target poly-target])
(place-channel-put/get ch (list 'wants-lock output-path))
;; trap any exceptions and pass them back as crashed jobs.
;; otherwise, a crashed rendering place can't recover, and the parallel job will be stuck.
(with-handlers ([exn:fail? (λ (e) (place-channel-put ch (list 'crashed-job path #f)))])
(match-define-values (_ _ ms _)
;; we don't use `render-to-file-if-needed` because we've already checked the render cache
;; if we reached this point, we know we need a render
(time-apply render-to-file (list path #f output-path)))
(place-channel-put ch (list 'finished-job path ms))))
(loop))))
(for/list ([wpidx (in-range worker-count)])
(define wp
(place ch
(let loop ()
(match-define (list project-root source-path output-path poly-target)
(place-channel-put/get ch (list 'wants-job)))
;; we manually propagate our parameter values for
;; current-project-root and current-poly-target
;; because parameter values are not automatically shared
;; between parallel threads.
(parameterize ([current-project-root project-root]
[current-poly-target poly-target])
(place-channel-put/get ch (list 'wants-lock output-path))
;; trap any exceptions and pass them back as crashed jobs.
;; otherwise, a crashed rendering place can't recover, and the parallel job will be stuck.
(place-channel-put ch
(cons
;; when rendering fails, first argument is the exception message
(with-handlers ([exn:fail? (λ (e) (exn-message e))])
(match-define-values (_ _ ms _)
;; we don't use `render-to-file-if-needed` because we've already checked the render cache
;; if we reached this point, we know we need a render
(time-apply render-to-file (list source-path #f output-path)))
;; when rendering succeeds, first argument is rendering time in ms
ms)
(list source-path output-path))))
(loop))))
(handle-evt wp (λ (val) (list* wpidx wp val)))))
(define poly-target (current-poly-target))
;; `locks` and `blocks` are (listof (cons/c evt? path?))
(let loop ([source-paths (reverse uncached-source-paths)]
(struct $lock (worker path) #:transparent)
;; `locks` and `blocks` are (listof $lock)
(let loop ([jobs (reverse uncached-jobs)]
[locks-in null]
[blocks-in null]
;; `completed-jobs` is (listof (cons/c path? boolean?))
[completed-jobs previously-cached-jobs]
[completed-job-results previously-cached-jobs] ; (listof jobresult)
[completed-job-count (length previously-cached-jobs)])
;; try to unblock blocked workers
(define-values (locks blocks)
(for/fold ([locks locks-in]
[blocks null])
([block (in-list blocks-in)])
(match-define (cons wp path) block)
(match-define ($lock wp path) block)
(cond
[(member path (dict-values locks))
[(member path (map $lock-path locks))
(values locks (cons block blocks))]
[else
(place-channel-put wp 'lock-approved)
(values (cons block locks) blocks)])))
(cond
[(eq? completed-job-count (length source-paths-in))
[(eq? completed-job-count (length jobs-in))
;; second bite at the apple for crashed jobs.
;; 1) many crashes that arise in parallel rendering are
;; a result of concurrency issues (e.g. shared files not being readable at the right moment).
@ -126,48 +138,55 @@
;; if it was a concurrency-related error, it will disappear.
;; if it was a legit error, the render will stop and print a trace.
;; crashed jobs are completed jobs that weren't finished
(define failed-source-paths (for/list ([(path finished?) (in-dict completed-jobs)]
#:unless finished?)
path))
(define failed-output-paths (for/list ([source-path (in-list failed-source-paths)])
(dict-ref source-to-output-path-table source-path)))
(list failed-source-paths failed-output-paths)]
(for/list ([jr (in-list completed-job-results)]
#:unless ($jobresult-finished-successfully jr))
($jobresult-job jr))]
[else
(match (apply sync worker-evts)
[(list wpidx wp 'wants-job)
(match source-paths
[(? null?) (loop null locks blocks completed-jobs completed-job-count)]
[(cons source-path rest)
(place-channel-put wp (list source-path (dict-ref source-to-output-path-table source-path) poly-target))
(loop rest locks blocks completed-jobs completed-job-count)])]
[(list wpidx wp (and (or 'finished-job 'crashed-job) tag) source-path ms)
(match tag
['finished-job
(message
(format "rendered @ job ~a /~a ~a"
(~r (add1 wpidx) #:min-width (string-length (~r job-count)) #:pad-string " ")
(find-relative-path (current-project-root) (dict-ref source-to-output-path-table source-path))
(if (< ms 1000) (format "(~a ms)" ms) (format "(~a s)" (/ ms 1000.0)))))]
[_
(match jobs
[(? null?) (loop null locks blocks completed-job-results completed-job-count)]
[(cons ($job source-path output-path) rest)
(place-channel-put wp (list (current-project-root) source-path output-path poly-target))
(loop rest locks blocks completed-job-results completed-job-count)])]
[(list wpidx wp status-arg source-path output-path)
;; if the render was successful, the status arg is a number representing milliseconds spent rendering.
;; if not, the status argument is the exception message.
(define job-finished? (exact-nonnegative-integer? status-arg))
(match status-arg
[ms #:when job-finished?
(message
(format "rendered @ job ~a /~a ~a"
(~r (add1 wpidx) #:min-width (string-length (~r worker-count)) #:pad-string " ")
(find-relative-path (current-project-root) output-path)
(if (< ms 1000) (format "(~a ms)" ms) (format "(~a s)" (/ ms 1000.0)))))]
[(? string? exn-msg)
(message
(format "render crash @ job ~a /~a (retry pending)"
(format "render crash @ job ~a /~a (retry pending)\n because ~a"
(add1 wpidx)
(find-relative-path (current-project-root) (dict-ref source-to-output-path-table source-path))))])
(loop source-paths
(match (assoc wp locks)
(find-relative-path (current-project-root) output-path)
exn-msg))]
[_ (raise-result-error 'render "exact-nonnegative-integer or string" status-arg)])
(loop jobs
(match (findf (λ (lock) (equal? ($lock-worker lock) wp)) locks)
[#false locks]
[lock (remove lock locks)])
blocks
(cons (cons source-path (eq? tag 'finished-job)) completed-jobs)
(let ([jr ($jobresult ($job source-path output-path) job-finished?)])
(cons jr completed-job-results))
(add1 completed-job-count))]
[(list wpidx wp 'wants-lock path)
(loop source-paths locks (append blocks (list (cons wp path))) completed-jobs completed-job-count)])])))
[(list wpidx wp 'wants-lock output-path)
(loop jobs locks (append blocks (list ($lock wp output-path))) completed-job-results completed-job-count)])])))
(define current-null-output? (make-parameter #f))
(define+provide/contract (render-batch #:parallel [wants-parallel-render? #false]
#:special [special-output #false] . paths-in)
((#:parallel any/c) (#:special (or/c boolean? symbol?)) #:rest (listof pathish?) . ->* . void?)
#:special [special-output #false]
#:output-paths [output-paths-in #false] . paths-in)
(() (#:parallel any/c
#:special (or/c boolean? symbol?)
#:output-paths (or/c #false (listof pathish?)))
#:rest (listof pathish?) . ->* . void?)
;; Why not just (for-each render ...)?
;; Because certain files will pass through multiple times (e.g., templates)
;; And with render, they would be rendered repeatedly.
@ -178,32 +197,53 @@
;; meaning, if source is "test.poly.pm" and we get `raco pollen render test.txt`,
;; then the output path argument should force .txt rendering, regardless of `current-poly-target` setting
;; so the output path may contain information we need that we can't necessarily derive from the source path.
(define expanded-source-paths
(let loop ([paths paths-in] [acc null])
(match paths
[(? null?) (sort (remove-duplicates acc) string<? #:key path->string)]
[(cons path rest)
(match (->complete-path path)
[(? pagetree-source? pt)
(loop (append (pagetree->paths pt) rest) acc)]
[(app ->source-path (and (not #false) (? file-exists?) sp))
(loop rest (cons sp acc))]
[_ (loop rest acc)])])))
(define expanded-output-paths
(for/list ([path (in-list paths-in)]
[sp (in-list expanded-source-paths)])
(if (equal? (->output-path path) path)
path
(->output-path sp))))
(define all-jobs
;; we generate the output paths in parallel with the source paths
;; rather than afterward, because
;; for poly files we want to be able to look at
;; the original path provided as an argument
;; but the path arguments might also include pagetrees,
;; which expand to multiple files.
;; so this keeps everything correlated correctly.
(cond
[(and output-paths-in (= (length paths-in) (length output-paths-in)))
;; explicit list of paths: create jobs directly
(for/list ([path (in-list paths-in)]
[output-path (in-list output-paths-in)])
($job path output-path))]
[else
(let loop ([paths paths-in] [sps null] [ops null])
(match paths
[(? null?)
;; it's possible that we have multiple output names for one poly file
;; so after we expand, we only remove duplicates where both the source and dest in the pair
;; are the same
(let* ([pairs (remove-duplicates (map cons sps ops))]
[pairs (sort pairs path<? #:key car)]
[pairs (sort pairs path<? #:key cdr)])
(for/list ([pr (in-list pairs)])
($job (car pr) (cdr pr))))]
[(cons path rest)
(match (->complete-path path)
[(? pagetree-source? pt)
(loop (append (pagetree->paths pt) rest) sps ops)]
[(app ->source-path sp) #:when (and sp (file-exists? sp))
(define op (match path
[(== (->output-path path)) path]
[_ (->output-path sp)]))
(loop rest (cons sp sps) (cons op ops))]
[_ (loop rest sps ops)])]))]))
(cond
[(null? expanded-source-paths) (message "[no paths to render]")]
[(eq? special-output 'dry-run) (for-each message expanded-source-paths)]
[else (parameterize ([current-null-output? (eq? special-output 'null)])
(apply for-each (λ (sp op) (render-to-file-if-needed sp #f op))
(match wants-parallel-render?
;; returns crashed jobs for serial rendering
[#false (list expanded-source-paths expanded-output-paths)]
[jobs-arg (parallel-render expanded-source-paths expanded-output-paths jobs-arg)])))]))
[(null? all-jobs) (message "[no paths to render]")]
[(eq? special-output 'dry-run) (for-each message (map $job-source all-jobs))]
[else
(parameterize ([current-null-output? (eq? special-output 'null)])
(for-each (λ (job) (render-to-file-if-needed ($job-source job) #f ($job-output job)))
(match wants-parallel-render?
;; returns crashed jobs for serial rendering
[#false all-jobs]
[worker-count-arg (parallel-render all-jobs worker-count-arg)])))]))
(define+provide/contract (render-pagenodes pagetree-or-path)
((or/c pagetree? pathish?) . -> . void?)
@ -219,6 +259,20 @@
(define ram-cache (make-hash))
(define (get-external-render-proc v)
(match v
[(list (? module-path? mod) (? symbol? render-proc-id))
(with-handlers ([exn:fail:filesystem:missing-module?
(λ (e) (raise
(exn:fail:contract (string-replace (exn-message e) "standard-module-name-resolver" "external-renderer")
(exn-continuation-marks e))))]
[exn:fail:contract? ;; raised if dynamic-require can't find render-proc-id
(λ (e) (raise
(exn:fail:contract (string-replace (exn-message e) "dynamic-require" "external-renderer")
(exn-continuation-marks e))))])
(dynamic-require mod render-proc-id))]
[_ (raise-argument-error 'external-renderer "value in the form '(module-path proc-id)" v)]))
;; note that output and template order is reversed from typical
(define (render-to-file-base caller
force?
@ -245,7 +299,11 @@
[(not render-cache-activated?) 'render-cache-deactivated]
[else #false]))
(when render-needed?
(define render-thunk (or maybe-render-thunk (λ () (render source-path template-path output-path)))) ; returns either string or bytes
(define render-thunk (or maybe-render-thunk
(λ () ((or (let ([val (setup:external-renderer)])
(and val (get-external-render-proc val)))
render)
source-path template-path output-path)))) ; returns either string or bytes
(define render-result
(cond
[render-cache-activated?
@ -397,11 +455,12 @@
(with-handlers ([exn:fail:contract? (λ (e) #f)]) ; in case source-path doesn't work with cached-require
(parameterize ([current-directory (current-project-root)])
(define source-metas (cached-metas source-path))
(define template-name-or-names ; #f or atom or list
(select-from-metas pollen-template-meta-key source-metas))
(define template-name (if (list? template-name-or-names)
(findf (λ (tn) (eq? (get-ext tn) output-path-ext)) template-name-or-names)
template-name-or-names))
(define template-name (match (select-from-metas pollen-template-meta-key source-metas) ; #f or atom or list
[(? list? names)
(for/first ([name (in-list names)]
#:when (equal? (get-ext name) (->string output-path-ext)))
name)]
[other other]))
(and template-name (simplify-path (cleanse-path (build-path (dirname source-path) template-name)))))))
(define (get-default-template source-path output-path-ext)
@ -423,7 +482,6 @@
[maybe-output-path]
[(->output-path source-path)]
[else #false]))
(define key (template-cache-key source-path output-path))
(define (cache-thunk)
(match source-path
[(or (? markup-source?) (? markdown-source?))
@ -437,15 +495,18 @@
get-fallback-template)])
(file-exists-or-has-source? (proc source-path output-path-ext)))]
[_ #false]))
(if (current-session-interactive?)
;; don't cache templates in interactive session, for fresher reloads
;; this makes it possible to add template and have it show up in next render
(cache-thunk)
;; otherwise, within a rendering session, this will prevent repeat players like "template.html.p"
;; from hitting the file cache repeatedly
(hash-ref! ram-cache key (λ () (cache-ref! key cache-thunk)))))
(module-test-external
(cond
[(or (current-session-interactive?) (not (setup:render-cache-active source-path)))
;; don't cache templates in interactive session, for fresher reloads
;; this makes it possible to add template and have it show up in next render
(cache-thunk)]
;; otherwise, within a rendering session, this will prevent repeat players like "template.html.p"
;; from hitting the file cache repeatedly
[else
(define key (template-cache-key source-path output-path))
(hash-ref! ram-cache key (λ () (cache-ref! key cache-thunk)))]))
#;(module-test-external
(require pollen/setup sugar/file sugar/coerce)
(define fallback.html (build-path (current-server-extras-path)
(add-ext pollen-fallback-template-prefix 'html)))

@ -15,7 +15,7 @@ This is the core design principle of Pollen. Consistent with this principle, Pol
@item{@bold{A Pollen project consists of source files + static files.} A @italic{source file} is a file that can be compiled to produce certain output. A @italic{static file} is usable as it stands (e.g., an SVG file or webfont). Generally, the textual content of your book will live in source files, and other elements will be static files.}
@item{@bold{Source control is a good idea.} Because Pollen projects are software projects, they can be easily managed with systems for source control and collaboration, like @link["http://github.com"]{GitHub}. If you're a writer at heart, don't fear these systems — the learning curve is repaid by revision & edit tracking that's much easier than it is with Word or PDF files.}
@item{@bold{Source control is a good idea.} Because Pollen projects are software projects, they can be easily managed with systems for source control and collaboration. If you're a writer at heart, don't fear these systems — the learning curve is repaid by revision & edit tracking that's much easier than it is with Word or PDF files.}
]

@ -43,7 +43,7 @@ Be warned that this will make your rendering much slower. But you will be guaran
@section{Scope of dependency tracking}
The compile cache tracks the modification date of the source file, the current setting of @secref["The_POLLEN_environment_variable"], and the modification dates of the template and @filepath{pollen.rkt} (if they exist). For @tt{poly} source files, it also tracks the @racket[current-poly-target]. It also tracks any files you've listed in the optional setup value @racket[setup:cache-watchlist].
The compile cache tracks the modification date of the source file, the current setting of @secref["The_POLLEN_environment_variable"], and the modification dates of the template and @filepath{pollen.rkt} (if they exist). For @tt{poly} source files, it also tracks the @racket[current-poly-target]. It also tracks files you've listed in the optional setup value @racket[setup:cache-watchlist] and environment variables listed in the optional setup value @racket[setup:envvar-watchlist].
It does not, however, track every possible dependency. So in a complex project, it's possible to create deep dependencies that aren't noticed by the cache. In particular, Pollen does not track pagetree files as dependencies of other source files. Thus, if you change a pagetree, you'll ordinarily need to use @exec{raco pollen reset} to clear the caches.

@ -748,12 +748,14 @@ And the metas:
@codeblock{
#lang racket/base
(require "pollen-source.rkt") ; doc and metas and everything else
(require (submod "pollen-source.rkt" metas)) ; just metas
(require "path/to/your-pollen-source") ; doc and metas and everything else
(require (submod "path/to/your-pollen-source" metas)) ; just metas
}
The @id{metas} submodule gives you access to the @id{metas} hashtable @italic{without} compiling the rest of the file. So if you need to harvest metas from a set of source files — for instance, page titles (for a table of contents) or categories — using @racket[require] with the submodule will be faster.
@bold{Pro tip #3}: Within a tag function, you can access the metas of the source currently being evaluated with @racket[current-metas].
@subsubsection{Inserting a comment}
Two options.

@ -31,7 +31,7 @@ You can retrieve a meta value — even in the same document where you define it
@section{Splicing}
@defform[(\@ arg ...)]
Splicing tag: signals that a list should be merged into its containing expression. The splicing tag is @racket[setup:splicing-tag].
The splicing tag signals that a list should be merged into its containing expression. The splicing tag is @racket['\@].
@examples[#:eval my-eval
(module splicer pollen/markup
@ -40,6 +40,24 @@ Splicing tag: signals that a list should be merged into its containing expressio
doc
]
The splicing tag is useful when you want to return a list of X-expressions in a situation where you can only return one. For instance, @secref["Tag_functions"] can only return one X-expression. But if we wrap the list of X-expressions in a splicing tag, they behave like a single X-expression. Later, Pollen will merge the list elements into the surrounding expression (as shown above).
@examples[#:eval my-eval
(require pollen/tag)
(code:comment @#,t{wrong: function returns a list of X-expressions})
(define-tag-function (multi attrs elems)
'("foo" "bar"))
(code:comment @#,t{right: function returns a list of X-expressions})
(code:comment @#,t{as elements inside a splicing tag})
(define-tag-function (multi2 attrs elems)
'(\@ "foo" "bar"))
]
Though the splicing tag is cosmetically identical to the abbreviated notation of @litchar{@"@"} for @racket[unquote-splicing], and has a similar purpose, it's not the same thing. The splicing tag isn't a variable — it's just a symbol that Pollen treats specially when generating output.
@defform[(when/splice condition pollen-args)]
If @racket[_condition] is true, put the @racket[_pollen-args] into the document. Within a template file, usually invoked like so:

@ -44,18 +44,7 @@ This function doesn't do much on its own. Rather, it provides the hooks upon whi
Recall that in Pollen, all @secref["tags-are-functions"]. By default, the @racket[_tagged-xexpr] from a source file is tagged with @racket[root]. So the typical way to use @racket[decode] is to attach your decoding functions to it, and then define @racket[root] to invoke your @racket[decode] function. Then it will be automatically applied to every @racket[doc] during compile.
For instance, here's how @racket[decode] is attached to @racket[root] in @link["http://practicaltypography.com"]{@italic{Butterick's Practical Typography}}. There's not much to it —
@racketblock[
(define (root . items)
(decode (txexpr 'root '() items)
#:txexpr-elements-proc decode-paragraphs
#:block-txexpr-proc (compose1 hyphenate wrap-hanging-quotes)
#:string-proc (compose1 smart-quotes smart-dashes)
#:exclude-tags '(style script)))
]
@margin-note{The @racket[hyphenate] function is not part of Pollen, but rather the @link["http://github.com/mbutterick/hyphenate"]{@racket[hyphenate] package}, which you can install separately.}
@margin-note{@link["https://docs.racket-lang.org/pollen-tfl/_pollen_rkt_.html#%28def._%28%28lib._pollen-tfl%2Fpollen..rkt%29._root%29%29"]{Here's an example} of invoking @racket[decode] via the @racket[root] tag. That example is part of the @racket[pollen-tfl] sample project, which you can install & study separately.}
This illustrates another important point: even though @racket[decode] presents an imposing list of arguments, you're unlikely to use all of them at once. These represent possibilities, not requirements. For instance, let's see what happens when @racket[decode] is invoked without any of its optional arguments.

@ -98,5 +98,58 @@ In general, I subscribe to the view that software should let you do what you wan
I've been using Pollen daily for several years (and will continue to do so, because my main work is writing). I've made Pollen available because a) I'm certain that others have had the same frustrations that I have, and b) feature suggestions and bug reports make it more useful for everyone.
I hope you enjoy using it. If you get stuck on something not covered here, see @secref["Getting_more_help" #:doc '(lib "pollen/scribblings/pollen.scrbl")].
I hope you enjoy using it.
@section{Getting more help}
@subsection{Bugs and feature requests}
Can be submitted as @link["https://git.matthewbutterick.com/mbutterick/pollen/issues"]{issues} at the main Pollen source repository.
@subsection{Questions & discussion}
For general tips and how-to questions, use the @link["https://forums.matthewbutterick.com/c/typesetting/"]{Pollen discussion forum}. I'll also use that list to post major changes and new features. You need an account to post (free and easy to set up with an email address).
(BTW, the former ``pollenpub'' Google Group and the ``pollen-users'' GitHub repo are now deprecated.)
@subsection{Can I see the source for @italic{Practical Typography} or @italic{Typography for Lawyers}?}
Yes, a tutorial project based on the previous version of @link["http://typographyforlawyers.com/"]{@italic{Typography for Lawyers}} is available by installing the @link["https://docs.racket-lang.org/pollen-tfl/"]{pollen-tfl} package the same way you installed Pollen.
The current versions of @italic{Practical Typography} & @italic{Typography for Lawyers} are generated from a single set of Pollen source files, which is a complication that makes them less suitable for an introductory tutorial. Still, even though this tutorial project is based on an earlier version, the coding techniques are very close to what I still use. Learn with confidence.
@subsection{Utilities & libraries}
@link["https://github.com/malcolmstill/pollen-count"]{pollen-count}: enumeration and cross-referencing library by Malcolm Still
@link["https://github.com/lijunsong/pollen-mode"]{pollen-mode}: Emacs mode for Pollen by Junsong Li
@link["https://github.com/basus/pollen-mode"]{Pollen mode}: Emacs mode for Pollen by Shrutarshi Basu
@link["https://docs.racket-lang.org/pollen-component/"]{Pollen Component}: Component-based development for Pollen by Leandro Facchinetti
@link["https://docs.racket-lang.org/css-expr/"]{CSS-expressions}: S-expression-based CSS by Leandro Facchinetti
@link["https://github.com/lijunsong/pollen-rock"]{Pollen Rock}: rendering server and an in-browser editor for Pollen
@link["https://github.com/appliedsciencestudio/talks/tree/master/mxnet"]{Polllen as a front end for Reveal.js} by Dave Liepmann. Reveal.js is a library that allows you to create slide presentations in pure HTML/CSS that run in the browser.
@subsection{More projects & guides}
@link["https://digitalwords.net"]{Digital Words} by Júda Ronén [@link["https://gitlab.com/rwmpelstilzchen/digitalwords.net"]{source}]
@link["https://thelocalyarn.com/excursus/secretary"]{Secretary of Foreign Relations} by Joel Dueck [@link["https://github.com/otherjoel/try-pollen"]{source}]
@link["https://github.com/fasiha/pollen-guide"]{A Poor Guide to Pollen} by Ahmed Fasih
@link["https://youtu.be/20GGVNBykaw"]{The World's Most Dangerous Racket Programmer} and @link["https://youtu.be/IMz09jYOgoc"]{Like a Blind Squirrel in a Ferrari}: short talks about Pollen that I gave at RacketCons 2013 and 2014, respectively.
@link["http://mstill.io"]{mstill.io blog} by Malcolm Still [@link["https://github.com/malcolmstill/mstill.io"]{source}]

@ -10,4 +10,4 @@
This module is licensed under the MIT License.
Source repository at @link["http://github.com/mbutterick/pollen"]{http://github.com/mbutterick/pollen}. Suggestions & corrections welcome.
Source repository at @link["https://git.matthewbutterick.com/mbutterick/pollen/"]{https://git.matthewbutterick.com/mbutterick/pollen/}. Suggestions & corrections welcome.

@ -1,50 +0,0 @@
#lang scribble/manual
@title{Getting more help}
@section{Bugs and feature requests}
Can be submitted as @link["https://github.com/mbutterick/pollen/issues"]{GitHub issues} at the main Pollen source repository.
@section{Questions & discussion}
For general tips and how-to questions, use the @link["https://github.com/mbutterick/pollen-users/issues"]{pollen-users discussion group} (on GitHub). I'll also use that list to post major changes and new features.
You need a GitHub account to post. If you don't have one, don't panic — they're free and easy to set up with an email address. @link["https://github.com/mbutterick/pollen-users"]{Instructions here}.
(BTW, the former ``pollenpub'' Google Group is now deprecated.)
@section{Utilities & libraries}
@link["https://github.com/malcolmstill/pollen-count"]{pollen-count}: enumeration and cross-referencing library by Malcolm Still
@link["https://github.com/lijunsong/pollen-mode"]{pollen-mode}: Emacs mode for Pollen by Junsong Li
@link["https://github.com/basus/pollen-mode"]{Pollen mode}: Emacs mode for Pollen by Shrutarshi Basu
@link["https://docs.racket-lang.org/pollen-component/"]{Pollen Component}: Component-based development for Pollen by Leandro Facchinetti
@link["https://docs.racket-lang.org/css-expr/"]{CSS-expressions}: S-expression-based CSS by Leandro Facchinetti
@link["https://github.com/lijunsong/pollen-rock"]{Pollen Rock}: rendering server and an in-browser editor for Pollen
@link["https://github.com/appliedsciencestudio/talks/tree/master/mxnet"]{Polllen as a front end for Reveal.js} by Dave Liepmann. Reveal.js is a library that allows you to create slide presentations in pure HTML/CSS that run in the browser.
@section{Can I see the source for Practical Typography or Typography for Lawyers?}
Yes, the source for @link["http://typographyforlawyers.com/"]{Typography for Lawyers} is available. In terms of content, TFL was originally the basis of Practical Typography. But in terms of code, this new TFL website is essentially a clone of Practical Typography, but rewritten to be clearer and more instructive, with extensive source comments. [@link["https://github.com/mbutterick/pollen-tfl"]{source}]
@section{More projects & guides}
@link["https://digitalwords.net"]{Digital Words} by Júda Ronén [@link["https://gitlab.com/rwmpelstilzchen/digitalwords.net"]{source}]
@link["https://thelocalyarn.com/excursus/secretary"]{Secretary of Foreign Relations} by Joel Dueck [@link["https://github.com/otherjoel/try-pollen"]{source}]
@link["https://github.com/fasiha/pollen-guide"]{A Poor Guide to Pollen} by Ahmed Fasih
@link["https://youtu.be/20GGVNBykaw"]{The World's Most Dangerous Racket Programmer} and @link["https://youtu.be/IMz09jYOgoc"]{Like a Blind Squirrel in a Ferrari}: short talks about Pollen that I gave at RacketCons 2013 and 2014, respectively.
@link["http://mstill.io"]{mstill.io blog} by Malcolm Still [@link["https://github.com/malcolmstill/mstill.io"]{source}]

@ -47,7 +47,6 @@ Or, if you can find a better digital-publishing tool, use that. But I'm never go
@include-section["programming-pollen.scrbl"]
@include-section["module-reference.scrbl"]
@include-section["unstable-module-reference.scrbl"]
@include-section["more-help.scrbl"]
@include-section["acknowledgments.scrbl"]
@include-section["license.scrbl"]
@include-section["version-history.scrbl"]

@ -102,7 +102,9 @@ Paths can also be specified as output rather than input paths, and the correspon
> raco pollen render foo.html
> raco pollen render foo.html bar.html zam.css}
The optional @exec{--target} or @exec{-t} switch specifies the render target for multi-output source files. If the target is omitted, the renderer will use whatever target appears first in @racket[(setup:poly-targets)].
If a pagetree file is included in @racket[_source], all the files it lists will be rendered using the above rules.
The optional @exec{--target} or @exec{-t} switch specifies the render target to use for multi-output source files. (Files of other types encountered in @racket[_source] will still be rendered as usual.) If the target is omitted, the renderer will use whatever target appears first in @racket[(setup:poly-targets)].
@terminal{
> raco pollen render -t pdf foo.poly.pm}
@ -130,9 +132,7 @@ As a rule of thumb, parallel rendering works best if you do @exec{raco setup} fi
@italic{Warning}: In all cases, the newly rendered output file will overwrite any previous output file.
@margin-note{As of mid-2020, Pollen's parallel-processing performance under the CS (= Chez Scheme) variant of Racket is worse than ordinary Racket. If you use Racket CS, you may get better results using @exec{-j 4} (which will limit the operation to four cores) than @exec{-p} (which will use all available cores).}
@bold{Directory mode}: @racket[raco pollen render _directory] renders all preprocessor source files and then all pagetree files found in the specified directory. If none of these files are found, a pagetree will be generated for the directory (which will include all source files) and then rendered. If the @racket[_directory] argument is omitted, the command defaults to the current directory.
@bold{Directory mode}: @racket[raco pollen render _directory] renders all preprocessor source files and then all pagetree files found in the specified directory. If none of these files are found, a pagetree will be generated for the directory (which will include all source files, but also everything else that exists there; see @secref["The_automatic_pagetree"]) and then rendered. If the @racket[_directory] argument is omitted, the command defaults to the current directory.
In directory mode, this command can be invoked with two other optional arguments (in addition to the @exec{--target}, @exec{--parallel}, and @exec{--jobs} switches mentioned above):

@ -1,6 +1,6 @@
#lang scribble/manual
@(require "mb-tools.rkt")
@(require scribble/eval pollen/setup racket/string (for-label (except-in racket #%top) racket/runtime-path syntax/modresolve (except-in pollen #%module-begin #%top) pollen/setup pollen/top))
@(require scribble/eval pollen/setup racket/string (for-label (except-in racket #%top) racket/runtime-path syntax/modresolve (except-in pollen #%module-begin #%top) pollen/render pollen/setup pollen/top))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/setup))
@ -153,11 +153,16 @@ Both the names and the values of environment variables are case-insensitive, so
@history[#:added "1.5"]}
@defoverridable[allow-unbound-ids? boolean?]{Predicate that controls whether Pollen converts unbound identifiers into default tags by altering the behavior of @racket[#%top] in @racketmodname[pollen/top].
@defoverridable[allow-unbound-ids? boolean?]{Predicate that controls whether Pollen converts unbound identifiers into default tags by altering the behavior of @racket[#%top] in @racketmodname[pollen/top].
@history[#:added "2.0"]}
@history[#:added "2.0"]}
@defoverridable[external-renderer (or/c (list/c module-path? symbol?) #f)]{A module path and identifier (suitable for use with @racket[dynamic-require]) that provide a function for Pollen to call instead of @racket[render] when rendering files needed by the @seclink["Using_the_project_server"]{project server} or when running @secref["raco_pollen_render"]. The function must accept the same arguments as @racket[render-to-file] and should return the final output as a @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{string} or @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{byte string}. Pollen will always write this return value out to the output file for you.
Setting this value gives you full control over (and responsibility for) how Pollen converts the compiled @racketidfont{doc} and @racketidfont{metas} from source files into their final output. Your renderer should be able to handle any of Pollens @seclink["Source_formats"]{source formats} or @seclink["Utility_formats"]{utility formats}. The operation of Pollens @racket[render] function is not affected by setting this value, so your renderer can use it as a fallback.
@history[#:added "3.2"]}
@section{Parameters}
I mean @italic{parameters} in the Racket sense, i.e. values that can be fed to @racket[parameterize].

@ -16,7 +16,7 @@ That's no longer true. The web is now more than 20 years old. During that time,
But one part hasn't improved much: the way we make web pages. Over the years, tools promising to simplify web development have come and mostly gone — from @link["http://www.macobserver.com/reviews/pagemill2.shtml"]{PageMill} to @link["http://www.adobe.com/products/dreamweaver.html"]{Dreamweaver} to @link["http://www.squarespace.com"]{Squarespace}. Meanwhile, serious web jocks have remained loyal to the original HTML power tool: the humble text editor.
In one way, this makes sense. Web pages are made mostly of text-based data — HTML, CSS, JavaScript, and so on — and the simplest way to mainpulate this data is with a text editor. While HTML and CSS are not programming languages — you can't even compute 1 + 1 — they lend themselves to semantic and logical structure that's most easily expressed by editing them as text. Furthermore, text-based editing makes debugging and performance improvements easier.
In one way, this makes sense. Web pages are made mostly of text-based data — HTML, CSS, JavaScript, and so on — and the simplest way to manipulate this data is with a text editor. While HTML and CSS are not programming languages — you can't even compute 1 + 1 — they lend themselves to semantic and logical structure that's most easily expressed by editing them as text. Furthermore, text-based editing makes debugging and performance improvements easier.
But text-based editing is also limited. Though the underlying description of a web page is notionally human-readable, it's optimized to be readable by other software — namely, web browsers. HTML in particular is verbose and easily mistyped. And isn't it fatally dull to manage all the boilerplate, like surrounding every paragraph with @code{<p>...</p>}? Yes, it is.

@ -21,7 +21,7 @@ Pygments is a Python library (though you don't need to know any Python to use it
@subsection[#:tag "pygments-with-pollen"]{Using Pygments with Pollen}
I used @link["http://pygments.org/"]{Pygments} for syntax highlighting in @link["http://unitscale.com/mb/technique/dual-typed-untyped-library.html"]{this article made with Pollen}. Links to the source are available at the bottom of the article.
I used @link["http://pygments.org/"]{Pygments} for syntax highlighting in @link["https://beautifulracket.com/"]{@italic{Beautiful Racket}}. Links to the source are available at the bottom of the article.
@itemlist[#:style 'ordered

@ -405,6 +405,9 @@ Beyond that, all we need to do make sure our template has the three key ingredie
In your project directory, create a new file called @filepath{template.html.p}:
@margin-note{If you're using DrRacket on Mac OS to save this file, it may insist on adding a @filepath{rkt} extension to the filename. If so, you can either correct the filename after you save the file, or instead use a different text editor to create @filepath{template.html.p}.}
@fileblock["template.html.p"
@codeblock[#:keep-lang-line? #f]{
#lang pollen

@ -12,7 +12,7 @@ Inconsistent with this system, Pollen's version also appends a build number, whi
@section{Source code}
Pollen's source code is @link["http://github.com/mbutterick/pollen"]{available from this Git repo}. The @tt{MASTER} branch of the repo will always contain the most recent stable version.
Pollen's source code is @link["https://git.matthewbutterick.com/mbutterick/pollen/"]{available from this Git repo}. The @tt{MASTER} branch of the repo will always contain the most recent stable version.
Racket's @link["http://pkg.racket-lang.org"]{package catalog} relies on this branch, so if you get your updates with @tt{raco pkg update pollen}, you'll get the most recent updates from this branch.
@ -24,6 +24,10 @@ Beyond keeping the commit history available, I make no promise to maintain the p
@section{Changelog}
@subsection{Version 3.2}
Added @racket[setup:external-renderer].
@subsection{Version 3.1}
Downgraded the following @racket[pollen/setup] values from configurable to fixed: @racket[here-path-key], @racket[extension-escape-char].

@ -1,6 +1,7 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax)
racket/runtime-path
racket/path
"private/constants.rkt")
(provide (all-from-out "private/constants.rkt"))
@ -18,12 +19,13 @@
(let-values ([(dir name dir?) (split-path path)])
dir))
(define (get-path-to-override maybe-dir)
(provide find-nearest-default-directory-require)
(define (find-nearest-default-directory-require maybe-dir)
(define starting-dir (cond
[(not maybe-dir) (current-directory)]
[(directory-exists? maybe-dir) maybe-dir]
[else (define dir (dirname maybe-dir))
(and (not (eq? 'relative dir)) (path->complete-path dir (current-directory)))]))
(and (not (eq? 'relative dir)) (simplify-path (path->complete-path dir (current-directory))))]))
(let loop ([dir starting-dir][path default-directory-require])
(and dir ; dir is #f when it hits the top of the filesystem
(let ([simplified-path (simplify-path (path->complete-path path starting-dir))])
@ -49,8 +51,13 @@
;; exn:fail:contract? is raised if setup submodule doesn't exist
;; in which case we use the default value.
;; but if something else is amiss, we want to let it bubble up
(define setup-module-path (get-path-to-override dir))
(define setup-module-path (find-nearest-default-directory-require dir))
(with-handlers ([exn:fail:contract? (λ (exn) DEFAULT-NAME)]
;; certain errors in pollen.rkt will arrive here
;; they do not indicate a defective setup module, so pass them through
[exn:fail:read? raise] ; syntactic failure (e.g., missing paren)
[exn:fail:syntax? raise] ; semantic failure (e.g., unbound identifier)
[exn:fail:filesystem? raise] ; filesystem failure (e.g., too many open files)
[exn? (λ (exn) (raise-user-error 'pollen/setup
(format "defective `setup` submodule in ~v\n~a" (path->string setup-module-path) (exn-message exn))))])
(dynamic-require `(submod ,setup-module-path WORLD-SUBMOD)
@ -127,3 +134,5 @@
(define-settable index-pages '("index.html"))
(define-settable allow-unbound-ids? #true)
(define-settable external-renderer #false)

@ -0,0 +1,3 @@
#lang pollen
this is bar

@ -0,0 +1,3 @@
#lang pollen
this is foo

@ -0,0 +1,4 @@
#lang pollen/ptree
foo.txt
bar.txt

@ -0,0 +1,6 @@
#lang racket/base
(module setup racket/base
(provide (all-defined-out))
(define project-server-port
9876))

@ -0,0 +1,27 @@
#lang at-exp racket/base
(require rackunit racket/runtime-path pollen/render racket/file pollen/setup)
;; define-runtime-path only allowed at top level
(define-runtime-path dir "data/pagetree-output")
(define-runtime-path index.ptree "data/pagetree-output/index.ptree")
(define-runtime-path foo.txt.pp "data/pagetree-output/foo.txt.pp")
(define-runtime-path foo.txt "data/pagetree-output/foo.txt")
(define-runtime-path bar.txt.pp "data/pagetree-output/bar.txt.pp")
(define-runtime-path bar.txt "data/pagetree-output/bar.txt")
(define-runtime-path pollen-cache "data/pagetree-output/compiled")
(parameterize ([current-output-port (open-output-string)]
[current-directory dir]
[current-project-root dir])
;; passing "index.ptree" as argument should work
(for ([parallel? (list #true #false)])
(render-batch #:parallel parallel? index.ptree)
(check-true (file-exists? foo.txt))
(check-equal? (file->string foo.txt) "this is foo")
(delete-file foo.txt)
(check-true (file-exists? bar.txt))
(check-equal? (file->string bar.txt) "this is bar")
(delete-file bar.txt)))
(delete-directory/files pollen-cache)

@ -1,5 +1,5 @@
#lang at-exp racket/base
(require rackunit racket/runtime-path pollen/render racket/file racket/system pollen/setup)
(require rackunit racket/runtime-path pollen/render racket/file pollen/setup txexpr xml)
;; define-runtime-path only allowed at top level
(define-runtime-path poly-output-path-dir "data/poly-output-path")
@ -14,16 +14,17 @@
[current-project-root poly-output-path-dir])
(for ([parallel? (list #true #false)])
;; passing "text.txt" as argument should force use of txt rendering
(render-batch #:parallel parallel? test.txt)
(check-equal? (file->string test.txt) "(root hello world)")
(delete-file test.txt)
(check-false (file-exists? test.html))
;; passing poly source as argument should result in default (html) rendering
(render-batch #:parallel parallel? test.poly.pm)
(check-equal? (file->string test.html) "<html><head><meta charset=\"UTF-8\"/></head><body><root>hello world</root></body></html>")
(delete-file test.html)
(check-false (file-exists? test.txt))))
;; passing "text.txt" as argument should force use of `txt` rendering
(render-batch #:parallel parallel? test.txt)
(check-equal? (file->string test.txt) "(root hello world)")
(delete-file test.txt)
(check-false (file-exists? test.html))
;; passing poly source as argument should result in default (html) rendering
(render-batch #:parallel parallel? test.poly.pm)
(check-txexprs-equal?
(string->xexpr (file->string test.html))
(string->xexpr "<html><head><meta charset=\"UTF-8\"/></head><body><root>hello world</root></body></html>"))
(delete-file test.html)
(check-false (file-exists? test.txt))))
(delete-directory/files pollen-cache)

@ -2,11 +2,15 @@
(require rackunit
pollen/setup
racket/runtime-path
pollen/render)
pollen/render
racket/file)
;; define-runtime-path only allowed at top level
(define-runtime-path poly-dir "data/poly")
(define-runtime-path poly-source "data/poly/test.poly.pm")
(define-runtime-path pollen-cache "data/poly/compiled")
(define-runtime-path test.txt "data/poly/test.txt")
(define-runtime-path test.html "data/poly/test.html")
(parameterize ([current-directory poly-dir]
[current-project-root poly-dir]
@ -14,4 +18,20 @@
(parameterize ([current-poly-target 'txt])
(check-equal? (render poly-source) "TITLE is **big**"))
(parameterize ([current-poly-target 'html])
(check-equal? (render poly-source) (format "~v" '(root (h2 "title") " is " (strong "big"))))))
(check-equal? (render poly-source) (format "~v" '(root (h2 "title") " is " (strong "big"))))))
(parameterize ([current-output-port (open-output-string)]
[current-directory poly-dir]
[current-project-root poly-dir])
;; make sure that batch works with multiple output files
;; related to one poly sourc
;; or duplicate output files (which will only be rendered once)
(for ([parallel? (list #true #false)])
(render-batch #:parallel parallel? test.html test.txt test.html)
(check-equal? (file->string test.txt) "TITLE is **big**")
(check-equal? (file->string test.html) (format "~v" '(root (h2 "title") " is " (strong "big"))))
(delete-file test.txt)
(delete-file test.html)))
(delete-directory/files pollen-cache)

@ -0,0 +1,51 @@
#lang racket/base
(require racket/port
racket/runtime-path
racket/tcp
rackunit)
(define-runtime-path project-port-dir "data/project-port")
(define the-port
(dynamic-require
`(submod ,(build-path project-port-dir "pollen.rkt") setup)
'project-server-port))
(define-values (in out)
(make-pipe))
(define thd
(parameterize ([current-output-port out]
[current-error-port out]
[current-directory project-port-dir]
[current-command-line-arguments (vector "start")]
[exit-handler (lambda (code)
(fail (format "abnormal exit from raco command~n code: ~a" code))
(kill-thread thd))])
(thread
(lambda ()
(dynamic-require '(submod pollen/private/command raco) #f)))))
(dynamic-wind
void
(lambda ()
(sync
(handle-evt
(regexp-match-evt #rx"ready to rock" in)
void)
(handle-evt
(alarm-evt (+ (current-inexact-milliseconds) 5000))
(lambda (_)
(fail "timed out while waiting for server to start"))))
(with-handlers ([exn:fail?
(lambda (e)
(fail (format "failed to connect to server: ~a" (exn-message e))))])
(define-values (cin cout)
(tcp-connect "127.0.0.1" the-port))
(close-output-port cout)
(close-input-port cin)))
(lambda ()
(break-thread thd)
(thread-wait thd)))
Loading…
Cancel
Save