Compare commits

..

193 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
Matthew Butterick 13c6f5bd4a
Add `dt` to block tags (fixes #236) 4 years ago
Matthew Butterick bd154d2a2d correct contract in docs (fixes #234) 4 years ago
Matthew Butterick d96a9d9809 disable template cache in interactive session 4 years ago
Shrutarshi Basu 123547f3cb
More robust interface to Pygments (#230) 4 years ago
Joel Dueck 88c354cb5f Remove vestigial savebox 4 years ago
Joel Dueck 0be74dba8a Better: nabla for 🎸 4 years ago
Joel Dueck cdc9496014 Fix noskip environment; discard emoji 4 years ago
Joel Dueck 95df990b46 Add TeX styles for custom Scribble tags
Removes many (not all) pdflatex errors when generating PDF docs. Some
styles had to be renamed because they get reused as LaTeX
environments/commands which can only contain letters.
4 years ago
Matthew Butterick 648b261079 move a documentation macro 4 years ago
Matthew Butterick 9bb15456c1 dead souls 4 years ago
Matthew Butterick 6d04ec875a never learn 4 years ago
Matthew Butterick a5c88d4e88 doc typo (fixes #227) 4 years ago
Matthew Butterick c7fb7594ff
Update CONTRIBUTING.md 4 years ago
Matthew Butterick 790c166b5a make subdir a complete path (closes #228) 4 years ago
Matthew Butterick cf9b81738a downgrade two more settables 4 years ago
Joel Dueck 3c39efdead small edits 4 years ago
Matthew Butterick 3e4dffcf5c break the loading loop 4 years ago
Matthew Butterick 68e81a114e fix names in docs 4 years ago
Matthew Butterick 32e14bee7b lozenge clarity 4 years ago
Matthew Butterick f094d89902 fix build 4 years ago
Matthew Butterick 912ba088bf
downgrade certain setup values to constants & bump to 3.0 (#225) 4 years ago
Matthew Butterick 67c0c95422 Revert "timeout error"
This reverts commit 8d210c6d13.
5 years ago
Matthew Butterick 8d210c6d13 timeout error 5 years ago
Matthew Butterick 85ac0cdfab comment 5 years ago
Matthew Butterick f8240fd02e make it possible to use `require` in templates 5 years ago
Matthew Butterick ae29f16513 don't test doc sources 5 years ago
Matthew Butterick ea55513d39 docs: clarify keyword notation support 5 years ago
Matthew Butterick 5f60dd4664 spacing clarity 5 years ago
Matthew Butterick fb39c9e8a3 tips for command line 5 years ago
Matthew Butterick a18766f53e word 5 years ago
Matthew Butterick cca0fa0848 nobody else would bother 5 years ago
Matthew Butterick 149f2cc389 skip unnecessary steps for non-interactive sessions 5 years ago
Matthew Butterick 7163f9bc77 roll back FASL (misbehavior under parallelism) 5 years ago
Matthew Butterick 972dba94e6 compat for 6.3 5 years ago
Matthew Butterick 98abad7b4b more bytecode for CS 5 years ago
Matthew Butterick 3b7c03f950 force render inside pagetrees 5 years ago
Matthew Butterick adbe2aae91 Revert "more bytecode"
This reverts commit ac5ba69f88.
5 years ago
Matthew Butterick ac5ba69f88 more bytecode 5 years ago
Matthew Butterick 3b1f76a0ff notes on CS parallel performance 5 years ago
Matthew Butterick eeb07709f8 use caching compiler 5 years ago
Matthew Butterick e81ce5e070 as usual 5 years ago
Matthew Butterick 1de0eff38d add --force option to raco pollen render, take 2 5 years ago
Matthew Butterick d61aea60ee Revert "add --force option to raco pollen render"
This reverts commit d2f7905a3d.
5 years ago
Matthew Butterick d2f7905a3d add --force option to raco pollen render 5 years ago
Matthew Butterick 0f7a3f4721 add dep (fixes #223) 5 years ago
Matthew Butterick bf09e50302 add error for publish 5 years ago
Matthew Butterick e5ddd18cba use serve instead of serve/servlet 5 years ago
Matthew Butterick 53ffc88be0 akas for localhost 5 years ago
Matthew Butterick c6411231c1 change resolution order of static file directories (fixes #222) 5 years ago
Matthew Butterick b716cff939
use FASL for caching (#221) 5 years ago
Matthew Butterick 3fae8a7648
Update CONTRIBUTING.md 5 years ago
Matthew Butterick c31267d00e server security note (addresses #220) 5 years ago
Matthew Butterick 388af39bbc
Update CONTRIBUTING.md 5 years ago
Matthew Butterick 040b66680a learned the hard way 5 years ago
Matthew Butterick 5e2ee3f9f1 docs for logging 5 years ago
Matthew Butterick f7f3c9cccd debug logging in cache 5 years ago
Matthew Butterick 7f26437e93 add debug level messaging 5 years ago
Matthew Butterick aeb8ca7a74 cooperate with global logging envvar 5 years ago
Benjamin Beckwith 3f6432b3f9
Small update to documentation (#218)
I corrected a sentence by adding an 'if' in the middle.
5 years ago
Matthew Butterick 20917e010c duh 5 years ago
Matthew Butterick f13eec8459 add dry-run switch to raco pollen publish 5 years ago
Matthew Butterick 9f674a4e70
Update .travis.yml 5 years ago
Matthew Butterick 4148da79a7 explain possibility of port failure (addresses #217) 5 years ago
Matthew Butterick 0e89afbc65 bump version 5 years ago
Matthew Butterick 95f464ff43 resolve sources in the same order as project server (fixes #216) 5 years ago
Matthew Butterick 361e3446f8 permit multiple key-val pairs in `define-meta` (closes #215) 5 years ago
Matthew Butterick 16c11c6cda get thunky 5 years ago
Matthew Butterick 2f663e4bf3 infinity and beyond 5 years ago
Matthew Butterick e822309d4e intentional nostalgia 5 years ago
Matthew Butterick da2f6313e7 cache template paths 5 years ago
Matthew Butterick ea25058349 todo 5 years ago
Matthew Butterick c8c23a1d39 preserve imperative changes to metas 5 years ago
Matthew Butterick 9e3a0f59e8 shrink 5 years ago
Matthew Butterick b242eb11dc eqs 5 years ago
Matthew Butterick 7534f32dac make crs compaible with debug 5 years ago
Matthew Butterick bba9cff6c9 tighten 5 years ago
Matthew Butterick 4f4dc34850 allow current-metas to be edited by tag functions 5 years ago
Matthew Butterick f9c47ef953 comment about arg 5 years ago
Matthew Butterick 77669695f5 serve text/plain with utf-8 encoding 5 years ago
Matthew Butterick 0e2ff2c79a handle zero-arg case 5 years ago
Matthew Butterick 00255a1889 as usual 5 years ago
Matthew Butterick ccb6bbebec better error msg for miscalled tag function 5 years ago
Matthew Butterick 8db9bfadd6 md 5 years ago
Matthew Butterick 4643cfacbd no LGPL 5 years ago
Matthew Butterick 57657955f8
Update README.md 5 years ago
Matthew Butterick 8ea073f534 switch to MIT licnse (closes #213) 5 years ago
Matthew Butterick fc5ca9f659 add --null switch to `raco pollen render` (closes #24) 5 years ago
Matthew Butterick 2509e0e82d correct contract 5 years ago
Matthew Butterick 73376e8faa reword error 5 years ago
Matthew Butterick ff13024899 link to reveal.js project 5 years ago
Matthew Butterick 3043cc8bc4 fix handling of poly files in project server (fixes #212) 5 years ago
Matthew Butterick 43c981d06c handle cache reads outside of workers 5 years ago
Matthew Butterick f725632444 revert missing-file error (addresses #207) 5 years ago
Matthew Butterick eacc4da368 more user errors 5 years ago
Matthew Butterick c16979325e improve error messages (closes #207) 5 years ago
Matthew Butterick 70b975b2ce dead souls 5 years ago
Matthew Butterick ffade6761b move a message 5 years ago
Matthew Butterick 4583bce7b2 matchify loop 5 years ago
Matthew Butterick 2cd655246c default case 5 years ago
Matthew Butterick ae8122ce9b make parallel & non-parallel render accounting more consistent 5 years ago
Matthew Butterick 3e96eb5c6a doc nit 5 years ago
Matthew Butterick 72df2d2477 add dry-run switch to render and setup 5 years ago
Matthew Butterick ab6691ea86 omit "shared lock" error 5 years ago
Matthew Butterick a05f74c595 omit "exclusive lock" error 5 years ago
Matthew Butterick 3cf97fabcf tidy 5 years ago
Matthew Butterick 618c410062 small refac 5 years ago
Matthew Butterick 0345260119 better handling of job-count and completed-jobs 5 years ago
Matthew Butterick 20ab9371d8 comment on parallel rendering policy 5 years ago
Matthew Butterick 8fa727d140 refac loop 5 years ago
Matthew Butterick bc86b3632d recover from crashed parallel renders 5 years ago
Matthew Butterick bc9694ae05 tidier 5 years ago
Matthew Butterick d32b24edb5 tidy loop 5 years ago
Matthew Butterick 0a13cf5cb9 stronger removal of duplicates 5 years ago
Matthew Butterick 10be642df0 ignore special paths in preheat 5 years ago
Matthew Butterick 12ba29dc03 improve project server 404 error message 5 years ago
Matthew Butterick bb1e3d8df0 source 5 years ago
Matthew Butterick 8771aa7441 add project 5 years ago
Matthew Butterick 3d2dc8ccb8 better sentence-ending edge cases (fixes #208) 5 years ago
Matthew Butterick d743f76bd6 never surrender 5 years ago
Matthew Butterick b4ebdb8947 make envvars case-insensitive 5 years ago
Matthew Butterick 5a8c4e2b03 bump to version 2.1 5 years ago
Matthew Butterick c1f42d9542 undebug 5 years ago
Matthew Butterick f161f5f465 use `envvar-watchlist` 5 years ago
Matthew Butterick 070b9655d2 symbols not bytes 5 years ago
Matthew Butterick 0051d3836f doc clarity 5 years ago
Matthew Butterick 4aa6e57ac0 reorg key 5 years ago
Matthew Butterick 5bcb70a7be permit environment variables in watchlist 5 years ago
Matthew Butterick 875becbff7
Update README.md 5 years ago
Matthew Butterick ce3ae7e553 deprecate mailing list 5 years ago
Matthew Butterick ca5489d8a7
Update README.md 5 years ago
Matthew Butterick 103302d879 undo file filtering in render 5 years ago
Matthew Butterick 749feb460a make behavior of `omitted-path?` and `extra-path?` more consistent 5 years ago
Matthew Butterick c8a2aeb32f use complete path in `preheat-cache` 5 years ago
Matthew Butterick 44dc914245
Update .travis.yml 5 years ago
Matthew Butterick f8ac8a4768
Update .travis.yml 5 years ago
Matthew Butterick 939575d550 add --jobs switch to render and setup 5 years ago
Matthew Butterick ab8e05a145 note about `setup` before `render -p` 5 years ago
Matthew Butterick 7b47cac273 parallel-rendering fixes 5 years ago
Matthew Butterick 88fe03e83b force trusty 6 years ago
Matthew Butterick 01828564ee suspend parallelism for now 6 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,43 +0,0 @@
# adapted from
# https://github.com/greghendershott/travis-racket/blob/master/.travis.yml
# Thanks Greg!
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.1
- RACKET_VERSION=7.2
- 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

@ -1,31 +1,31 @@
## Pull-request tips ## Pull-request tips
I welcome pull requests. But accepting a PR obligates me to maintain that code for the life of Pollen. So if I seem picky about which PRs I accept — yes, because I have to be. No hard feelings. I welcome pull requests. But accepting a PR obligates me to maintain that code for the life of Pollen. So if I seem picky about which PRs I accept — yes, because I have to be. No hard feelings. (= Principle of Infinite Maintenance)
* Theres plenty of room for improvement in the Pollen code, because every line of it has been written against the backdrop of ignorance and fallibility, mostly my own. * Theres plenty of room for improvement in the Pollen code, because every line of it has been written against the backdrop of ignorance and fallibility, mostly my own. (= Principle of Prior Ignorance)
* 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. * 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. * 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. * 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/). * 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.) * 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)
* PRs should avoid introducing magic behavior (aka the [principle of least astonishment](http://wiki.c2.com/?PrincipleOfLeastAstonishment)). * PRs should avoid introducing magic behavior (= [Principle of Least Astonishment](http://wiki.c2.com/?PrincipleOfLeastAstonishment)).
* PRs should forbid as little as possible. In particular, PRs should avoid enshrining personal preference as default behavior (because others will have different preferences). * PRs should forbid as little as possible. In particular, PRs should avoid enshrining personal preference as default behavior (because others will have different preferences). (= Principle of Generality)
* PRs should avoid reinventing features that already exist in Racket. * PRs should avoid reinventing features that already exist in Racket. (= Principle of Economy)
* I follow these principles too, because theyre virtuous habits. Still, I created Pollen as a tool for my writing and typography work. If a certain PR would negatively impact that work, I cant accept it. * PRs should fix real problems that have arisen in actual use, not theoretical or conjectural problems. (= Principle of Practical Justification)
* If youre new to Pollen or Racket, your PR is more likely to be declined, because certain things you perceive as bugs are actually features, certain things you perceive as missing are actually present, and certain limitations you perceive as surmountable are actually not. (See also point #1 re: backdrop of ignorance.) * I follow these principles too, because theyre virtuous habits. Still, I created Pollen as a tool for my writing and typography work. If a certain PR would negatively impact that work, I cant accept it. (= Principle of Royalty)
* If your PR includes open-source material from elsewhere, please make sure that material is a) compatible with the Pollen license and b) attributed in whatever way is required. Otherwise, I cannot accept it. * If youre new to Pollen or Racket, your PR is more likely to be declined, because certain things you perceive as bugs are actually features, certain things you perceive as missing are actually present, and certain limitations you perceive as surmountable are actually not. (See also point #1 re: backdrop of ignorance.) (= Principle of Novelty)
* PRs that could have unit tests, and dont, will be treated harshly. As they should. * If your PR includes open-source material from elsewhere, please make sure that material is a) compatible with the Pollen license and b) attributed in whatever way is required. Otherwise, I cannot accept it. (= Principle of Legality)
* PRs that want to amend Pollens public interface receive the highest scrutiny. * PRs that could have unit tests, and dont, will be treated harshly. As they should. (= Principle of Proof)

@ -1,165 +0,0 @@
GNU LESSER GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
This version of the GNU Lesser General Public License incorporates
the terms and conditions of version 3 of the GNU General Public
License, supplemented by the additional permissions listed below.
0. Additional Definitions.
As used herein, "this License" refers to version 3 of the GNU Lesser
General Public License, and the "GNU GPL" refers to version 3 of the GNU
General Public License.
"The Library" refers to a covered work governed by this License,
other than an Application or a Combined Work as defined below.
An "Application" is any work that makes use of an interface provided
by the Library, but which is not otherwise based on the Library.
Defining a subclass of a class defined by the Library is deemed a mode
of using an interface provided by the Library.
A "Combined Work" is a work produced by combining or linking an
Application with the Library. The particular version of the Library
with which the Combined Work was made is also called the "Linked
Version".
The "Minimal Corresponding Source" for a Combined Work means the
Corresponding Source for the Combined Work, excluding any source code
for portions of the Combined Work that, considered in isolation, are
based on the Application, and not on the Linked Version.
The "Corresponding Application Code" for a Combined Work means the
object code and/or source code for the Application, including any data
and utility programs needed for reproducing the Combined Work from the
Application, but excluding the System Libraries of the Combined Work.
1. Exception to Section 3 of the GNU GPL.
You may convey a covered work under sections 3 and 4 of this License
without being bound by section 3 of the GNU GPL.
2. Conveying Modified Versions.
If you modify a copy of the Library, and, in your modifications, a
facility refers to a function or data to be supplied by an Application
that uses the facility (other than as an argument passed when the
facility is invoked), then you may convey a copy of the modified
version:
a) under this License, provided that you make a good faith effort to
ensure that, in the event an Application does not supply the
function or data, the facility still operates, and performs
whatever part of its purpose remains meaningful, or
b) under the GNU GPL, with none of the additional permissions of
this License applicable to that copy.
3. Object Code Incorporating Material from Library Header Files.
The object code form of an Application may incorporate material from
a header file that is part of the Library. You may convey such object
code under terms of your choice, provided that, if the incorporated
material is not limited to numerical parameters, data structure
layouts and accessors, or small macros, inline functions and templates
(ten or fewer lines in length), you do both of the following:
a) Give prominent notice with each copy of the object code that the
Library is used in it and that the Library and its use are
covered by this License.
b) Accompany the object code with a copy of the GNU GPL and this license
document.
4. Combined Works.
You may convey a Combined Work under terms of your choice that,
taken together, effectively do not restrict modification of the
portions of the Library contained in the Combined Work and reverse
engineering for debugging such modifications, if you also do each of
the following:
a) Give prominent notice with each copy of the Combined Work that
the Library is used in it and that the Library and its use are
covered by this License.
b) Accompany the Combined Work with a copy of the GNU GPL and this license
document.
c) For a Combined Work that displays copyright notices during
execution, include the copyright notice for the Library among
these notices, as well as a reference directing the user to the
copies of the GNU GPL and this license document.
d) Do one of the following:
0) Convey the Minimal Corresponding Source under the terms of this
License, and the Corresponding Application Code in a form
suitable for, and under terms that permit, the user to
recombine or relink the Application with a modified version of
the Linked Version to produce a modified Combined Work, in the
manner specified by section 6 of the GNU GPL for conveying
Corresponding Source.
1) Use a suitable shared library mechanism for linking with the
Library. A suitable mechanism is one that (a) uses at run time
a copy of the Library already present on the user's computer
system, and (b) will operate properly with a modified version
of the Library that is interface-compatible with the Linked
Version.
e) Provide Installation Information, but only if you would otherwise
be required to provide such information under section 6 of the
GNU GPL, and only to the extent that such information is
necessary to install and execute a modified version of the
Combined Work produced by recombining or relinking the
Application with a modified version of the Linked Version. (If
you use option 4d0, the Installation Information must accompany
the Minimal Corresponding Source and Corresponding Application
Code. If you use option 4d1, you must provide the Installation
Information in the manner specified by section 6 of the GNU GPL
for conveying Corresponding Source.)
5. Combined Libraries.
You may place library facilities that are a work based on the
Library side by side in a single library together with other library
facilities that are not Applications and are not covered by this
License, and convey such a combined library under terms of your
choice, if you do both of the following:
a) Accompany the combined library with a copy of the same work based
on the Library, uncombined with any other library facilities,
conveyed under the terms of this License.
b) Give prominent notice with the combined library that part of it
is a work based on the Library, and explaining where to find the
accompanying uncombined form of the same work.
6. Revised Versions of the GNU Lesser General Public License.
The Free Software Foundation may publish revised and/or new versions
of the GNU Lesser General Public License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the
Library as you received it specifies that a certain numbered version
of the GNU Lesser General Public License "or any later version"
applies to it, you have the option of following the terms and
conditions either of that published version or of any later version
published by the Free Software Foundation. If the Library as you
received it does not specify a version number of the GNU Lesser
General Public License, you may choose any version of the GNU Lesser
General Public License ever published by the Free Software Foundation.
If the Library as you received it specifies that a proxy can decide
whether future versions of the GNU Lesser General Public License shall
apply, that proxy's public statement of acceptance of any version is
permanent authorization for you to choose that version for the
Library.

@ -1,3 +0,0 @@
Pollen
© 20132018 Matthew Butterick
Licensed under the LGPL (see "LGPL.txt")

@ -0,0 +1,9 @@
MIT License for Pollen
© 2013-2019 Matthew Butterick
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@ -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). 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 raco pkg update --update-deps pollen
Official mailing list: http://groups.google.com/forum/#!forum/pollenpub Official forum: https://forums.matthewbutterick.com/c/typesetting/
## License ## License
LGPL 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 #lang info
(define collection 'multi) (define collection 'multi)
(define version "2.0") (define version "3.2")
(define deps '(["base" #:version "6.3"] (define deps '(["base" #:version "6.3"]
["txexpr" #:version "0.2"] ["txexpr" #:version "0.2"]
["sugar" #:version "0.2"] ["sugar" #:version "0.2"]
@ -15,7 +15,8 @@
"scribble-text-lib" "scribble-text-lib"
"rackunit-lib" "rackunit-lib"
"gui-lib" "gui-lib"
"string-constants-lib")) "string-constants-lib"
"net-lib"))
(define build-deps '("plot-gui-lib" (define build-deps '("plot-gui-lib"
"scribble-lib" "scribble-lib"
"racket-doc" "racket-doc"

@ -39,14 +39,14 @@
(λ (path-or-path-string subkey caller-name) (λ (path-or-path-string subkey caller-name)
(define path (define path
(with-handlers ([exn:fail? (path-error-handler caller-name path-or-path-string)]) (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 path-or-path-string
(string->path path-or-path-string))))) (string->path path-or-path-string)))))
(unless (file-exists? path) (unless (file-exists? path)
(raise-argument-error caller-name "path to existing file" path-or-path-string)) (raise-argument-error caller-name "path to existing file" path-or-path-string))
(cond (cond
[(setup:compile-cache-active path) [(setup:compile-cache-active path)
(define key (paths->key path)) (define key (paths->key 'source path))
(define (convert-path-to-cache-record) (define (convert-path-to-cache-record)
(when (let ([crs (current-render-source)]) (when (let ([crs (current-render-source)])
(and crs (not (equal? crs path)))) (and crs (not (equal? crs path))))
@ -61,7 +61,7 @@
(cached-require-base path-string subkey 'cached-require)) (cached-require-base path-string subkey 'cached-require))
(define+provide (cached-doc path-string) (define+provide (cached-doc path-string)
(cached-require-base path-string (setup:main-export) 'cached-doc)) (cached-require-base path-string pollen-main-export 'cached-doc))
(define+provide (cached-metas path-string) (define+provide (cached-metas path-string)
(cached-require-base path-string (setup:meta-export) 'cached-metas)) (cached-require-base path-string pollen-meta-export 'cached-metas))

@ -1,7 +1,7 @@
#lang racket/base #lang racket/base
(require (for-syntax (require (for-syntax
racket/base racket/base
"setup.rkt") "private/constants.rkt")
racket/match racket/match
txexpr/base txexpr/base
xml/path xml/path
@ -21,7 +21,7 @@
;; even though this error will happen after macro expansion, when metas are extracted ;; even though this error will happen after macro expansion, when metas are extracted
;; empty string will merge with surroundings ;; empty string will merge with surroundings
(provide define-meta) (provide define-meta)
(define-syntax-rule (define-meta k v) (begin)) (define-syntax-rule (define-meta k v kv ...) (begin))
(define+provide current-metas (make-parameter #f)) (define+provide current-metas (make-parameter #f))
@ -120,7 +120,7 @@
(define-syntax (when/splice stx) (define-syntax (when/splice stx)
(syntax-case stx () (syntax-case stx ()
[(_ COND . BODY) [(_ COND . BODY)
(with-syntax ([SPLICING-TAG (datum->syntax stx (setup:splicing-tag))]) (with-syntax ([SPLICING-TAG (datum->syntax stx pollen-splicing-tag)])
#'(if COND #'(if COND
(SPLICING-TAG . BODY) (SPLICING-TAG . BODY)
(SPLICING-TAG)))])) (SPLICING-TAG)))]))
@ -130,7 +130,7 @@
(define-syntax (for/splice/base stx) (define-syntax (for/splice/base stx)
(syntax-case stx () (syntax-case stx ()
[(_ ITERATORS . BODY) [(_ ITERATORS . BODY)
(with-syntax ([SPLICING-TAG (datum->syntax stx (setup:splicing-tag))] (with-syntax ([SPLICING-TAG (datum->syntax stx pollen-splicing-tag)]
[FORM (or (syntax-property stx 'form) #'for/list)]) [FORM (or (syntax-property stx 'form) #'for/list)])
#'(apply SPLICING-TAG (FORM ITERATORS #'(apply SPLICING-TAG (FORM ITERATORS
(SPLICING-TAG . BODY))))])) (SPLICING-TAG . BODY))))]))

@ -16,8 +16,8 @@
(check-equal? (->preproc-source-path "foo") (->path "foo.pp")) (check-equal? (->preproc-source-path "foo") (->path "foo.pp"))
(check-equal? (->preproc-source-path 'foo) (->path "foo.pp")) (check-equal? (->preproc-source-path 'foo) (->path "foo.pp"))
(check-true (pagetree-source? (format "foo.~a" (setup:pagetree-source-ext)))) (check-true (pagetree-source? (format "foo.~a" pollen-pagetree-source-ext)))
(check-false (pagetree-source? (format "~a.foo" (setup:pagetree-source-ext)))) (check-false (pagetree-source? (format "~a.foo" pollen-pagetree-source-ext)))
(check-false (pagetree-source? #f)) (check-false (pagetree-source? #f))
(check-true (markup-source? "foo.pm")) (check-true (markup-source? "foo.pm"))

@ -4,6 +4,6 @@
(define raco-commands '(("pollen" (submod pollen/private/command raco) "issue Pollen command" #f))) (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")) (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 ;; 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" "scribblings/pollen.scrbl")) (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 ;; don't put #"p" in this list because it's not a #lang
(define module-suffixes '(#"pp" #"pm" #"pmd" #"ptree")) (define module-suffixes '(#"pp" #"pm" #"pmd" #"ptree"))

@ -1,54 +1,29 @@
#lang racket/base #lang racket/base
#| #|
Implements the pollen/mode metalanguage. Implements the pollen/mode metalanguage. Certain values are hardcoded inside the Racket source, so we have to copy & paste, a little.
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.
Note that pollen/mode uses default-command-char, NOT (setup:command-char), Note that pollen/mode uses a hardcoded #\◊, as the command char, NOT (setup:command-char),
because doing so would create a loading loop if pollen/mode were used in "pollen.rkt" (which is a likely place to use it) because importing `pollen/setup` will create a loading loop
if pollen/mode were used in "pollen.rkt" (which is a likely place to use it)
Intractable problem; unavoidable limitation. Intractable problem; unavoidable limitation.
|# |#
(module* runtime-config racket/base ;; because the reader "boots" from `pollen/mode`,
(provide configure) ;; Racket looks for the `language-info` submodule in `pollen/mode`
;; so we just re-export the default.
(require (only-in (submod ".." at-reader) make-at-readtable)) (module language-info racket/base
(require at-exp/lang/language-info)
(define (configure data) (provide (all-from-out at-exp/lang/language-info)))
(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)))
(module* language-info racket/base
(provide get-language-info) ;; adapted from
;; https://github.com/racket/racket/blob/master/pkgs/at-exp-lib/at-exp/lang/reader.rkt
(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)]))))
(module* reader racket/base (module* reader racket/base
(require syntax/module-reader (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] (provide (rename-out [at-read read]
[at-read-syntax read-syntax] [at-read-syntax read-syntax]
@ -58,7 +33,7 @@ Intractable problem; unavoidable limitation.
(λ args (λ args
(parameterize ([current-readtable (make-at-readtable #:datum-readtable 'dynamic (parameterize ([current-readtable (make-at-readtable #:datum-readtable 'dynamic
#:command-readtable 'dynamic #:command-readtable 'dynamic
#:command-char (dynamic-require 'pollen/setup 'default-command-char))]) #:command-char #\◊)])
(apply p args)))) (apply p args))))
(define-values (at-read at-read-syntax at-get-info) (define-values (at-read at-read-syntax at-get-info)
@ -80,7 +55,7 @@ Intractable problem; unavoidable limitation.
(λ args (λ args
(define stx (apply read-syntax args)) (define stx (apply read-syntax args))
(define old-prop (syntax-property stx 'module-language)) (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))) (syntax-property stx 'module-language new-prop)))
(λ (proc) (λ (proc)
(λ (key defval) (λ (key defval)
@ -98,675 +73,3 @@ Intractable problem; unavoidable limitation.
[(drracket:indentation) [(drracket:indentation)
(dynamic-require 'pollen/private/external/mode-indentation 'determine-spaces)] (dynamic-require 'pollen/private/external/mode-indentation 'determine-spaces)]
[else (fallback)])))))) [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)))

@ -117,12 +117,11 @@
(define+provide load-pagetree get-pagetree) ; bw compat (define+provide load-pagetree get-pagetree) ; bw compat
;; Try loading from pagetree file, or failing that, synthesize pagetree.
(define+provide/contract (make-project-pagetree project-dir) (define+provide/contract (make-project-pagetree project-dir)
(pathish? . -> . pagetree?) (pathish? . -> . pagetree?)
(with-handlers ([exn:fail? (λ (exn) (directory->pagetree project-dir))]) (match (build-path project-dir (setup:main-pagetree))
(define pagetree-source (build-path project-dir (setup:main-pagetree))) [(and (? file-exists?) pagetree-source) (load-pagetree pagetree-source)]
(load-pagetree pagetree-source))) [_ (directory->pagetree project-dir)]))
(define (topmost-node x) (first (->list x))) (define (topmost-node x) (first (->list x)))
@ -216,9 +215,21 @@
(define+provide/contract (pagetree->list pt-or-path) (define+provide/contract (pagetree->list pt-or-path)
((or/c pagetree? pathish?) . -> . pagenodes?) ((or/c pagetree? pathish?) . -> . pagenodes?)
; use rest to get rid of root tag at front ; use rest to get rid of root tag at front
(pagetree-strict->list (get-pagetree pt-or-path))) (pagetree-strict->list (get-pagetree pt-or-path)))
(define+provide/contract (pagetree->paths pt-or-path)
((or/c pagetree? pathish?) . -> . (listof complete-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 (module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three)))) (define test-pagetree `(pagetree-main foo bar (one (two three))))
(check-equal? (pagetree->list test-pagetree) '(foo bar one two three))) (check-equal? (pagetree->list test-pagetree) '(foo bar one two three)))
@ -297,7 +308,17 @@
(define starting-dir (match starting-path (define starting-dir (match starting-path
[(? directory-exists?) starting-path] [(? directory-exists?) starting-path]
[_ (dirname 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)]) (define+provide/contract (in-pagetree? pnish [pt-or-path (current-pagetree)])

@ -7,9 +7,12 @@
racket/file racket/file
racket/path racket/path
racket/list racket/list
racket/serialize racket/port
racket/match
sugar/coerce sugar/coerce
sugar/test sugar/test
racket/fasl
racket/serialize
compiler/cm) compiler/cm)
(provide (all-defined-out)) (provide (all-defined-out))
@ -21,7 +24,9 @@
;; because we don't want to attach a mod date ;; because we don't want to attach a mod date
;; because cache validity is not sensitive to mod date of output path ;; because cache validity is not sensitive to mod date of output path
;; (in fact we would expect it to be earlier, since we want to rely on an earlier version) ;; (in fact we would expect it to be earlier, since we want to rely on an earlier version)
(define (paths->key source-path [template-path #false] [output-path #false]) (define (paths->key cache-type source-path [template-path #false] [output-path #false])
(unless (symbol? cache-type)
(raise-argument-error 'paths->key "symbol" cache-type))
(define path-strings-to-track (define path-strings-to-track
(list* source-path (list* source-path
;; if template has a source file, track that instead ;; if template has a source file, track that instead
@ -30,49 +35,66 @@
(append (->list (get-directory-require-files source-path)) (append (->list (get-directory-require-files source-path))
;; user-designated files to track ;; user-designated files to track
(map ->string (setup:cache-watchlist source-path))))) (map ->string (setup:cache-watchlist source-path)))))
(define pollen-env (getenv default-env-name)) (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 env-name))
[#false #false]
[str (string-downcase (->string str))]))))
(define poly-flag (and (has-inner-poly-ext? source-path) (current-poly-target))) (define poly-flag (and (has-inner-poly-ext? source-path) (current-poly-target)))
(define path+mod-time-pairs (define path+mod-time-pairs
(for/list ([ps (in-list path-strings-to-track)]) (for/list ([ps (in-list path-strings-to-track)])
(cond (match ps
[ps (define cp (->complete-path ps)) [(? symbol? sym) sym]
(unless (file-exists? cp) [#false #false]
(message (format "watchlist file /~a does not exist" (find-relative-path (current-project-root) cp)))) [_ (define cp (->complete-path ps))
(cons (path->string cp) (file-or-directory-modify-seconds cp #false (λ () 0)))] (unless (file-exists? cp)
[else #false]))) (message (format "watchlist file /~a does not exist" (find-relative-path (current-project-root) cp))))
(list* pollen-env poly-flag (and output-path (path->string output-path)) path+mod-time-pairs)) (cons (path->string cp) (file-or-directory-modify-seconds cp #false (λ () 0)))])))
(list* cache-type env-rec poly-flag (and output-path (path->string output-path)) path+mod-time-pairs))
(define (key->source-path key) (car (fourth key))) (define (key->source-path key) (car (fifth key)))
(define (key->output-path key) (third key)) (define (key->output-path key) (fourth key))
(define (key->type key) (car key))
(module-test-internal (module-test-internal
(define ps "/users/nobody/project/source.html.pm") (define ps "/users/nobody/project/source.html.pm")
(check-equal? (key->source-path (paths->key ps)) ps)) (check-equal? (key->source-path (paths->key 'source ps)) ps))
(define-namespace-anchor cache-utils-module-ns) (define-namespace-anchor cache-utils-module-ns)
;; faster than the usual `managed-compile-zo`
(define caching-zo-compiler (make-caching-managed-compile-zo))
(define (path->hash path) (define (path->hash path)
(for-each managed-compile-zo (or (get-directory-require-files path) null)) (define compilation-namespace
(apply hasheq (cond
(let ([doc-key (setup:main-export)] [meta-key (setup:meta-export)]) [(current-session-interactive?)
(unless (and (symbol? doc-key) (symbol? meta-key)) ;; in interactive mode, we need a fresh namespace every time
(raise-argument-error 'path->hash "symbols for doc and meta key" (cons doc-key meta-key))) ;; and can't use bytecode, because it's possible that path
;; I monkeyed around with using the metas submodule to pull out the metas (for speed) ;; or any dependency (say, "pollen.rkt") has changed
;; but in practice most files get their doc requested too. (define bns (make-base-namespace))
;; so it's just simpler to get both at once and be done with it. (define outer-ns (namespace-anchor->namespace cache-utils-module-ns))
;; the savings of avoiding two cache fetches at the outset outweighs ;; bring in currently instantiated params (unlike namespace-require)
;; the benefit of not reloading doc when you just need metas. (namespace-attach-module outer-ns 'pollen/setup bns)
;; new namespace forces `dynamic-require` to re-instantiate `path` bns]
;; otherwise it gets cached in current namespace. [else
(parameterize ([current-namespace (make-base-namespace)] ;; make bytecode, because we know that in a non-interactive sesssion
[current-directory (dirname path)]) ;; the sources won't change in the midst
;; brings in currently instantiated params (unlike namespace-require) (for-each caching-zo-compiler (cons path (or (get-directory-require-files path) null)))
(define outer-ns (namespace-anchor->namespace cache-utils-module-ns)) ; recycle namespace
(namespace-attach-module outer-ns 'pollen/setup) (current-namespace)]))
(define doc-missing-thunk (λ () "")) ;; I monkeyed around with using the metas submodule to pull out the metas (for speed)
(define metas-missing-thunk (λ () (hasheq))) ;; but in practice most files get their doc requested too.
(list doc-key (dynamic-require path doc-key doc-missing-thunk) ;; so it's just simpler to get both at once and be done with it.
meta-key (dynamic-require path meta-key metas-missing-thunk)))))) ;; the savings of avoiding two cache fetches at the outset outweighs
;; the benefit of not reloading doc when you just need metas.
;; new namespace forces `dynamic-require` to re-instantiate `path`
;; otherwise it gets cached in current namespace.
(define doc-missing-thunk (λ () ""))
(define metas-missing-thunk (λ () (hasheq)))
(parameterize ([current-namespace compilation-namespace]
[current-directory (dirname path)])
(hasheq pollen-main-export (dynamic-require path pollen-main-export doc-missing-thunk)
pollen-meta-export (dynamic-require path pollen-meta-export metas-missing-thunk))))
(define (my-make-directory* dir) (define (my-make-directory* dir)
(define base (dirname dir)) (define base (dirname dir))
@ -84,21 +106,29 @@
(define (make-cache-dirs path) (define (make-cache-dirs path)
(define path-dir (dirname path)) (define path-dir (dirname path))
(define cache-dir (build-path path-dir (setup:cache-dir-name) (setup:cache-subdir-name))) (define cache-dir (build-path path-dir pollen-cache-dir-name pollen-cache-subdir-name))
(define private-cache-dir (build-path cache-dir "private")) (define private-cache-dir (build-path cache-dir "private"))
(my-make-directory* private-cache-dir) ; will also make cache-dir, if needed (my-make-directory* private-cache-dir) ; will also make cache-dir, if needed
(values cache-dir private-cache-dir)) (values cache-dir private-cache-dir))
(define (cache-ref! key path-hash-thunk (define (cache-ref! key path-hash-thunk
#:dest-path [path-for-dest 'source]
#:notify-cache-use [notify-proc void]) #:notify-cache-use [notify-proc void])
(define dest-path ((case path-for-dest (define dest-path ((match (key->type key)
[(source) key->source-path] ['source key->source-path]
[(output) key->output-path]) key)) ['output key->output-path]
;; path-add-suffix is deprecated since 6.5.0.3 but we still need compatibility with 6.3
['template (λ (k) (path-add-suffix (key->source-path key) (string->bytes/utf-8 (format ".~a-template" (current-poly-target)))))]) key))
(define-values (cache-dir private-cache-dir) (make-cache-dirs dest-path)) (define-values (cache-dir private-cache-dir) (make-cache-dirs dest-path))
(define-values (dest-path-dir dest-path-filename _) (split-path dest-path)) (define-values (dest-path-dir dest-path-filename _) (split-path dest-path))
(define dest-file (build-path cache-dir (format "~a.rktd" dest-path-filename))) (define dest-file (build-path cache-dir (format "~a.rktd" dest-path-filename)))
(define (generate-dest-file) (define (generate-dest-file)
(message-debug (format "cache miss for ~a" dest-file))
#;(with-output-to-file dest-file
(λ ()
(define op (open-output-bytes))
(s-exp->fasl (path-hash-thunk) op)
(write-bytes (get-output-bytes op)))
#:exists 'replace)
(write-to-file (serialize (path-hash-thunk)) dest-file #:exists 'replace)) (write-to-file (serialize (path-hash-thunk)) dest-file #:exists 'replace))
;; `cache-file` looks for a file in private-cache-dir previously cached with key ;; `cache-file` looks for a file in private-cache-dir previously cached with key
@ -112,5 +142,16 @@
private-cache-dir private-cache-dir
generate-dest-file generate-dest-file
#:notify-cache-use notify-proc #:notify-cache-use notify-proc
#:max-cache-size (setup:compile-cache-max-size)) #:max-cache-files +inf.0
(deserialize (file->value dest-file))) #:max-cache-size (setup:compile-cache-max-size)
#:log-debug-string message-debug
#:log-error-string
(λ (str)
(match str
;; concurrency-related error that has no larger consequence
[(or "cache attempt failed: could not acquire exclusive lock"
"cache attempt failed: could not acquire shared lock") (void)]
[_ (log-pollen-error str)])))
#;(with-input-from-file dest-file
(λ () (fasl->s-exp (port->bytes))))
(deserialize (file->value dest-file)))

@ -7,7 +7,8 @@
sugar/coerce sugar/coerce
"file-utils.rkt" "file-utils.rkt"
"log.rkt" "log.rkt"
"../setup.rkt") "../setup.rkt"
"../pagetree.rkt")
;; The use of dynamic-require throughout this file is intentional: ;; The use of dynamic-require throughout this file is intentional:
;; this way, low-dependency raco commands (like "version") are faster. ;; this way, low-dependency raco commands (like "version") are faster.
@ -27,26 +28,31 @@
(very-nice-path (car args))))) (very-nice-path (car args)))))
(define (dispatch command-name) (define (dispatch command-name)
(with-logging-to-port (define dispatch-thunk
(current-error-port) (λ ()
(λ () (case command-name
(case command-name [("test" "xyzzy") (handle-test)]
[("test" "xyzzy") (handle-test)] [(#f "help") (handle-help)]
[(#f "help") (handle-help)] [("start") (handle-start)] ; parses its own args
[("start") (handle-start)] ; parses its own args ;; "second" arg is actually third in command line args, so use cddr not cdr
;; "second" arg is actually third in command line args, so use cddr not cdr [("render") (handle-render)] ; render parses its own args from current-command-line-arguments
[("render") (handle-render)] ; render parses its own args from current-command-line-arguments [("version") (handle-version)]
[("version") (handle-version)] [("reset") (handle-reset (get-first-arg-or-current-dir))]
[("reset") (handle-reset (get-first-arg-or-current-dir))] [("setup") (handle-setup)]
[("setup") (handle-setup (get-first-arg-or-current-dir))] [("clone" "publish") (handle-publish)]
[("clone" "publish") (handle-publish)] [else (handle-unknown command-name)])))
[else (handle-unknown command-name)])) (cond
#:logger pollen-logger [(let ([str (getenv "PLTSTDERR")])
'info (and str (regexp-match "@pollen" str))) (dispatch-thunk)]
'pollen)) [else (with-logging-to-port
(current-error-port)
dispatch-thunk
#:logger pollen-logger
'info
'pollen)]))
(define (very-nice-path x) (define (very-nice-path x)
(path->complete-path (simplify-path (cleanse-path (->path x))))) (simple-form-path (cleanse-path (->path x))))
(define (handle-test) (define (handle-test)
(displayln "raco pollen is installed correctly")) (displayln "raco pollen is installed correctly"))
@ -73,9 +79,23 @@ version print the version" (current-server-port) (make-publish-di
(message "resetting cache ...") (message "resetting cache ...")
((dynamic-require 'pollen/cache 'reset-cache) directory-maybe)) ((dynamic-require 'pollen/cache 'reset-cache) directory-maybe))
(define (handle-setup directory-maybe) (define (handle-setup)
(message "preheating cache ...") (message "preheating cache ...")
((dynamic-require 'pollen/private/preheat-cache 'preheat-cache) directory-maybe)) (define setup-parallel? (make-parameter #false))
(define dry-run? (make-parameter #false))
(define parsed-args
(command-line #:program "raco pollen setup"
#:argv (vector-drop (current-command-line-arguments) 1) ; snip the 'setup' from the front
#:once-any
[("-p" "--parallel") "Setup in parallel using all cores" (setup-parallel? #true)]
[("-j" "--jobs") job-count "Setup in parallel using <job-count> jobs" (setup-parallel? (or (string->number job-count) (raise-argument-error 'handle-setup "exact positive integer" job-count)))]
[("-d" "--dry-run") "Print paths that would be compiled" (dry-run? #true)]
#:args other-args
other-args))
(define starting-dir (match parsed-args
[(list dir) dir]
[_ (current-directory)]))
((dynamic-require 'pollen/private/preheat-cache 'preheat-cache) starting-dir (setup-parallel?) (dry-run?)))
(define (handle-render) (define (handle-render)
(define render-batch (dynamic-require 'pollen/render 'render-batch)) (define render-batch (dynamic-require 'pollen/render 'render-batch))
@ -84,6 +104,8 @@ version print the version" (current-server-port) (make-publish-di
(define render-target-wanted (make-parameter (current-poly-target))) (define render-target-wanted (make-parameter (current-poly-target)))
(define render-with-subdirs? (make-parameter #f)) (define render-with-subdirs? (make-parameter #f))
(define render-parallel? (make-parameter #f)) (define render-parallel? (make-parameter #f))
(define special-output? (make-parameter #f))
(define force-render? (make-parameter #f))
(define parsed-args (define parsed-args
(command-line #:program "raco pollen render" (command-line #:program "raco pollen render"
#:argv (vector-drop (current-command-line-arguments) 1) ; snip the 'render' from the front #:argv (vector-drop (current-command-line-arguments) 1) ; snip the 'render' from the front
@ -93,9 +115,30 @@ version print the version" (current-server-port) (make-publish-di
[("-r" "--recursive") "Render subdirectories recursively" [("-r" "--recursive") "Render subdirectories recursively"
(render-with-subdirs? 'recursive)] (render-with-subdirs? 'recursive)]
[("-s" "--subdir") "Render subdirectories nonrecursively" (render-with-subdirs? 'include)] [("-s" "--subdir") "Render subdirectories nonrecursively" (render-with-subdirs? 'include)]
[("-p" "--parallel") "Render in parallel" (render-parallel? #true)] [("-f" "--force") "Force render" (force-render? #true)]
#:once-any
[("-d" "--dry-run") "Print paths that would be rendered" (special-output? 'dry-run)]
[("-n" "--null") "Suppress file output" (special-output? 'null)]
#:once-any
[("-p" "--parallel") "Render in parallel using all cores" (render-parallel? #true)]
[("-j" "--jobs") job-count "Render in parallel using <job-count> jobs" (render-parallel? (or (string->number job-count) (raise-argument-error 'handle-render "exact positive integer" job-count)))]
#:args other-args #:args other-args
other-args)) other-args))
(define timestamp (current-seconds)) ; keeps timestamp consistent through whole render
(define (handle-batch-render paths)
(when (force-render?)
;; forcing works like `touch`: updates the mod date of the files,
;; which invalidates any cached results.
(let force-paths ([paths paths])
(for* ([path (in-list paths)]
[sp (in-value (if (pagetree-source? path) path (get-source path)))]
#:when sp)
(file-or-directory-modify-seconds sp timestamp)
(when (pagetree-source? sp)
(force-paths (pagetree->paths sp))))))
(apply render-batch (map very-nice-path paths) #:parallel (render-parallel?) #:special (special-output?)))
(parameterize ([current-poly-target (render-target-wanted)]) ;; applies to both cases (parameterize ([current-poly-target (render-target-wanted)]) ;; applies to both cases
(let loop ([args parsed-args]) (let loop ([args parsed-args])
(match args (match args
@ -104,55 +147,55 @@ version print the version" (current-server-port) (make-publish-di
#:when (directory-exists? dir) #:when (directory-exists? dir)
(define top-dir (very-nice-path dir)) (define top-dir (very-nice-path dir))
(let render-one-dir ([dir top-dir]) (let render-one-dir ([dir top-dir])
(parameterize ([current-directory dir] (when (or (extra-path? dir) (not (omitted-path? dir)))
[current-project-root (case (render-with-subdirs?) (parameterize ([current-directory dir]
[(recursive) dir] [current-project-root (case (render-with-subdirs?)
[else top-dir])]) [(recursive) dir]
(define dirlist (directory-list dir)) [else top-dir])])
(define preprocs (filter preproc-source? dirlist)) (define dirlist (directory-list dir))
(define static-pagetrees (filter pagetree-source? dirlist)) (define paths-to-render
;; if there are no static pagetrees, use make-project-pagetree (match (filter pagetree-source? dirlist)
;; (which will synthesize a pagetree if needed, which includes all sources) ;; if there are no static pagetrees, use make-project-pagetree
(define batch-to-render ;; (which will synthesize a pagetree if needed, which includes all sources)
(map very-nice-path [(? null?)
(match static-pagetrees (message (format "rendering generated pagetree for directory ~a" dir))
[(? null?) (cdr (make-project-pagetree dir))]
(message (format "rendering generated pagetree for directory ~a" dir)) [pagetree-sources
(cdr (make-project-pagetree dir))] (message (format "rendering preproc & pagetree files in directory ~a" dir))
[_ (append (filter preproc-source? dirlist) pagetree-sources)]))
(message (format "rendering preproc & pagetree files in directory ~a" dir)) (handle-batch-render paths-to-render)
(append preprocs static-pagetrees)]))) (when (render-with-subdirs?)
(apply render-batch batch-to-render #:parallel (render-parallel?)) (for ([path (in-list dirlist)]
(when (render-with-subdirs?) #:when (directory-exists? path))
(for ([path (in-list dirlist)] (render-one-dir (->complete-path path)))))))]
#:when (and (directory-exists? path)
(not (omitted-path? path))))
(render-one-dir (->complete-path path))))))]
[path-args ;; path mode [path-args ;; path mode
(message (format "rendering ~a" (string-join (map ->string path-args) " "))) (message (format "rendering ~a" (string-join (map ->string path-args) " ")))
(apply render-batch (map very-nice-path path-args) #:parallel (render-parallel?))])))) (handle-batch-render path-args)]))))
(define (handle-start) (define (handle-start)
(define launch-wanted #f) (define launch-wanted #f)
(define localhost-wanted #f) (define localhost-wanted #f)
(define clargs (define-values (dir http-port)
(command-line #:program "raco pollen start" (command-line
#:argv (vector-drop (current-command-line-arguments) 1) ; snip the 'start' from the front #:program "raco pollen start"
#:once-each #:argv (vector-drop (current-command-line-arguments) 1) ; snip the 'start' from the front
[("--launch" "-l") "Launch browser after start" (set! launch-wanted #t)] #:once-each
[("--local") "Restrict access to localhost" (set! localhost-wanted #t)] [("--launch" "-l") "Launch browser after start" (set! launch-wanted #t)]
#:args other-args [("--local") "Restrict access to localhost" (set! localhost-wanted #t)]
other-args)) #:args ([dir (current-directory)] [port #f])
(define dir (path->directory-path (get-first-arg-or-current-dir clargs))) (define parsed-dir
(unless (directory-exists? dir) (path->directory-path (normalize-path (very-nice-path dir))))
(error (format "~a is not a directory" dir))) (unless (directory-exists? parsed-dir)
(define http-port (with-handlers ([exn:fail? (λ (e) #f)]) (error (format "~a is not a directory" parsed-dir)))
(string->number (cadr clargs))))
(when (and http-port (not (exact-positive-integer? http-port))) (define parsed-port (and port (string->number port)))
(error (format "~a is not a valid port number" http-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] (parameterize ([current-project-root dir]
[current-server-port (or http-port (setup:project-server-port))] [current-server-port (or http-port (setup:project-server-port))]
[current-server-listen-ip (and localhost-wanted "127.0.0.1")]) [current-server-listen-ip (and localhost-wanted "127.0.0.1")]
[current-session-interactive? #true])
(message "starting project server ...") (message "starting project server ...")
((dynamic-require 'pollen/private/project-server 'start-server) (format "/~a" (setup:main-pagetree dir)) launch-wanted))) ((dynamic-require 'pollen/private/project-server 'start-server) (format "/~a" (setup:main-pagetree dir)) launch-wanted)))
@ -179,19 +222,21 @@ version print the version" (current-server-port) (make-publish-di
(and (>= (length xs) (length prefix)) (and (>= (length xs) (length prefix))
(andmap equal? prefix (for/list ([(x idx) (in-indexed xs)] (andmap equal? prefix (for/list ([(x idx) (in-indexed xs)]
#:break (= idx (length prefix))) #:break (= idx (length prefix)))
x)))) x))))
((explode-path possible-subdir) . has-prefix? . (explode-path possible-superdir))) ((explode-path possible-subdir) . has-prefix? . (explode-path possible-superdir)))
(define (handle-publish) (define (handle-publish)
(define command-name ; either "publish" or "clone" (define command-name ; either "publish" or "clone"
(vector-ref (current-command-line-arguments) 0)) (vector-ref (current-command-line-arguments) 0))
(define force-target-overwrite? (make-parameter #true)) (define force-target-overwrite? (make-parameter #true))
(define dry-run? (make-parameter #false))
(define other-args (command-line (define other-args (command-line
;; drop command name ;; drop command name
#:argv (vector-drop (current-command-line-arguments) 1) #:argv (vector-drop (current-command-line-arguments) 1)
#:once-each #:once-each
[("-c" "--confirm") "Confirm overwrite of existing dest dir" [("-c" "--confirm") "Confirm overwrite of existing dest dir"
(force-target-overwrite? #f)] (force-target-overwrite? #f)]
[("-d" "--dry-run") "Check paths that would be published" (dry-run? #true)]
#:args other-args #:args other-args
other-args)) other-args))
;; other-args looks like (list [maybe-source-dir-arg] [maybe-dest-dir-arg]) ;; other-args looks like (list [maybe-source-dir-arg] [maybe-dest-dir-arg])
@ -214,7 +259,6 @@ version print the version" (current-server-port) (make-publish-di
(when (equal? dest-dir (current-directory)) (when (equal? dest-dir (current-directory))
(error 'publish "aborted because destination directory for publishing (~a) can't be the same as current directory (~a)" dest-dir (current-directory))) (error 'publish "aborted because destination directory for publishing (~a) can't be the same as current directory (~a)" dest-dir (current-directory)))
(message (string-append (format "publishing from ~a to ~a ..." source-dir dest-dir)))
(define do-publish-operation? (define do-publish-operation?
(or (not (directory-exists? dest-dir)) (or (not (directory-exists? dest-dir))
(force-target-overwrite?) (force-target-overwrite?)
@ -224,20 +268,35 @@ version print the version" (current-server-port) (make-publish-di
[(y yes) #true] [(y yes) #true]
[else #false])))) [else #false]))))
(cond (cond
[do-publish-operation? [(dry-run?)
(when (directory-exists? dest-dir) (message "publish: start dry run")
(delete-directory/files dest-dir)) (message (format "would publish from ~a to ~a" source-dir dest-dir))
(copy-directory/files source-dir dest-dir) (cond
;; if source-dir is provided, we want it to be treated as current-directory. [(directory-exists? dest-dir)
;; if no source-dir is provided, it is set to current-directory, (message (string-append (format "directory ~a exists (but can be overwritten)" dest-dir)))]
;; so the parameterize is a no-op. [(directory-exists? (simplify-path (build-path dest-dir "..")))
(parameterize* ([current-directory source-dir] (message (string-append (format "directory ~a does not exist (but can be created)" dest-dir)))]
[current-project-root (current-directory)]) [else
(define (delete-from-publish-dir? p) (raise-user-error 'publish "dry run failure: directory path ~a is defective (neither directory nor parent directory exists)" dest-dir)])
(and (omitted-path? p) (not (extra-path? p)))) (message "publish: end dry run")]
(for-each delete-it! (find-files delete-from-publish-dir? dest-dir))) [else
(message "publish completed")] (message (string-append (format "publishing from ~a to ~a ..." source-dir dest-dir)))
[else (message "publish aborted")])) (cond
[do-publish-operation?
(when (directory-exists? dest-dir)
(with-handlers ([exn:fail:filesystem? (λ (exn) (raise-user-error 'publish (format "operation failed: could not delete ~a" dest-dir)))])
(delete-directory/files dest-dir)))
(copy-directory/files source-dir dest-dir)
;; if source-dir is provided, we want it to be treated as current-directory.
;; if no source-dir is provided, it is set to current-directory,
;; so the parameterize is a no-op.
(parameterize* ([current-directory source-dir]
[current-project-root (current-directory)])
(define (delete-from-publish-dir? p)
(and (omitted-path? p) (not (extra-path? p))))
(for-each delete-it! (find-files delete-from-publish-dir? dest-dir)))
(message "publish completed")]
[else (message "publish aborted")])]))
(define (handle-unknown command) (define (handle-unknown command)
(match command (match command

@ -0,0 +1,23 @@
#lang racket/base
(provide (prefix-out pollen- (all-defined-out)))
(define main-export 'doc) ; don't forget to change fallback template too
(define meta-export 'metas)
(define meta-tag-name 'meta)
(define define-meta-name 'define-meta)
(define preproc-source-ext 'pp)
(define markup-source-ext 'pm)
(define markdown-source-ext 'pmd)
(define null-source-ext 'p)
(define pagetree-source-ext 'ptree)
(define template-source-ext 'pt)
(define scribble-source-ext 'scrbl)
(define poly-source-ext 'poly) ; extension that signals source can be used for multiple output targets
(define cache-dir-name "compiled")
(define cache-subdir-name "pollen")
(define template-prefix "template")
(define fallback-template-prefix "fallback")
(define template-meta-key "template")
(define old-cache-names '("pollen.cache" "pollen-cache"))
(define splicing-tag '@)
(define here-path-key 'here-path)
(define extension-escape-char #\_)

@ -11,6 +11,7 @@
(define-syntax (*module-begin stx) (define-syntax (*module-begin stx)
(syntax-case stx () (syntax-case stx ()
[(_ id post-process . body) [(_ id post-process . body)
;; unlike regular doclang, don't accept a third positional argument (just pass dummy `exprs`)
(with-syntax ([exprs #'()]) (with-syntax ([exprs #'()])
#'(#%module-begin #'(#%module-begin
(doc-begin id post-process exprs . body)))])) (doc-begin id post-process exprs . body)))]))

@ -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) 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` In the unit tests, `scribble/base` became `pollen/markup`
and `scribble/manual` became `pollen/markdown` and `scribble/manual` became `pollen/markdown`

@ -1,7 +1,7 @@
#lang racket/base #lang racket/base
(require racket/promise (require racket/promise
racket/contract/base racket/contract/base
pollen/setup) ; to get splicing char "../constants.rkt") ; to get splicing char
#| #|
161017: 161017:
This is a slightly amended version of scribble/text/output This is a slightly amended version of scribble/text/output
@ -129,7 +129,7 @@ This version will also splice lists that begin with the splicing char.
(define npfx (pfx+col (pfx+ pfx lpfx))) (define npfx (pfx+col (pfx+ pfx lpfx)))
(set-mcar! pfxs npfx) (set-mcdr! pfxs 0) (set-mcar! pfxs npfx) (set-mcdr! pfxs 0)
(if (list? c) (if (list? c)
(let ([c (if (eq? (setup:splicing-tag) (car c)) ; patch to cooperate with splicing char (let ([c (if (eq? pollen-splicing-tag (car c)) ; patch to cooperate with splicing char
(cdr c) (cdr c)
c)]) c)])
(for ([c (in-list c)]) (loop c))) (for ([c (in-list c)]) (loop c)))

@ -1,8 +1,22 @@
# This allows us to launch Python and pygments once, and pipe to it # This allows us to launch Python and pygments once, and pipe to it
# continuously. Input format is: # continuously.
# #
# <lexer-name> # There are four options:
# <list-of-highlighted-lines> # 1. Language (used to determine the lexer)
# 2. Line numbers to highlight
# 3. Encoding to use for the output
# 4. HTML Class to use for the output
#
# These can be specified as arguments when this script is first invoked, or on a
# per invocation.
#
# To set the options for each invocation, the format is:
#
# __LANG__ <lexer-name>
# __LINENOS__ <true|false>
# __LINES__ <list-of-highlighted-lines>
# __CSS__ <CSS-class>
# __ENC__ <encoding>
# <code> # <code>
# ... # ...
# __END__ # __END__
@ -17,57 +31,120 @@
# ... # ...
# __END__ # __END__
from __future__ import print_function
import sys import sys
import optparse import optparse
from pygments import highlight from pygments import highlight
from pygments.lexers import get_lexer_by_name from pygments.lexers import get_lexer_by_name
from pygments.util import ClassNotFound from pygments.util import ClassNotFound
from pygments.formatters import HtmlFormatter from pygments.formatters import HtmlFormatter
def get_lexer(lang):
if not lang:
get_lexer_by_name("text", encoding="guess")
try:
return get_lexer_by_name(lang, encoding="guess")
except ClassNotFound:
print("No lexer was found for the given language. Using plain text instead.", file=sys.stderr)
return get_lexer_by_name("text", encoding="guess")
parser = optparse.OptionParser() parser = optparse.OptionParser()
parser.add_option('--linenos', action="store_true", dest="linenos") parser.add_option('--linenos', action="store_true", dest="linenos")
parser.add_option('--cssclass', default="source", dest="cssclass") parser.add_option('--cssclass', default="source", dest="cssclass")
parser.add_option('--encoding', default="utf-8", dest="encoding")
parser.add_option('--language', dest="language")
(options, _) = parser.parse_args() (options, _) = parser.parse_args()
lexer = "" # Set initial options
config = {
'linenos': options.linenos,
'cssclass': options.cssclass,
'encoding': options.encoding,
'hl_lines': []
}
lexer = get_lexer(options.language)
code = "" code = ""
lines_to_highlight = ""
py_version = sys.version_info.major py_version = sys.version_info.major
sys.stdout.write("ready\n") sys.stdout.write("ready\n")
sys.stdout.flush() sys.stdout.flush()
while 1: while 1:
line_raw = sys.stdin.readline() line_raw = sys.stdin.readline()
if not line_raw: if not line_raw:
break break
# Without trailing space, \n, or \n # Without trailing space, \n, or \n
line = line_raw.rstrip() line = line_raw.rstrip()
if line == '__EXIT__': if line == '__EXIT__':
break break
elif line == '__END__': elif line == '__END__':
# Lex input finished. Lex it. # Lex input finished. Lex it.
formatter = HtmlFormatter(linenos=options.linenos, formatter = HtmlFormatter(linenos=config['linenos'],
cssclass=options.cssclass, cssclass=config['cssclass'],
encoding="utf-8", encoding=config['encoding'],
hl_lines=lines_to_highlight) hl_lines=config['hl_lines'])
if py_version >= 3: if py_version >= 3:
sys.stdout.write(highlight(code, lexer, formatter).decode("utf-8")) sys.stdout.write(highlight(code, lexer, formatter).decode("utf-8"))
else: else:
sys.stdout.write(highlight(code, lexer, formatter)) sys.stdout.write(highlight(code, lexer, formatter))
sys.stdout.write('\n__END__\n') sys.stdout.write('\n__END__\n')
sys.stdout.flush() sys.stdout.flush()
lexer = ""
# Reset the configuration for the next invocation. Most options are
# actually persisted between runs, except for the code itself and the
# lines to be highlighted.
code = "" code = ""
lines_to_highlight = "" config['hl_lines'] = []
elif lexer == "":
# Starting another lex. First line is the lexer name. elif code == "":
try: # Only check for new options at the beginning of a a fresh invocation
lexer = get_lexer_by_name(line, encoding="guess") if line.startswith("__LANG__"):
except ClassNotFound: # Use the provided language to find the appropriate lexer.
lexer = get_lexer_by_name("text", encoding="guess") try:
elif lines_to_highlight == "": lang = line.split()[1]
# Starting another lex. Second line is list of lines to highlight, lexer = get_lexer(lang)
# formatted as string of whitespace-separated integers except IndexError:
lines_to_highlight = [int(str) for str in line.split()] print("No lexer was found for the given language. Using plain text instead.", file=sys.stderr)
lexer = get_lexer_by_name("text", encoding="guess")
elif line.startswith("__LINENOS__"):
try:
option = line.split()[1]
if option.lower() == "true":
config['linenos'] = True
elif option.lower() == "false":
config['linenos'] = False
else:
pass
except IndexError:
print("__LINENOS__ option must be given a `true` or `false` value",
file=sys.stderr)
elif line.startswith("__LINES__"):
# The list of lines to highlight is formatted as string of
# whitespace-separated integers
lines = line.split()[1:]
config['hl_lines'] = [int(str) for str in lines]
elif line.startswith("__CSS__"):
try:
config['cssclass'] = line.split[1]
except IndexError:
print("Could not parse CSS class line.", file=sys.stderr)
elif line.startswith("__ENC__"):
try:
config['encoding'] = line.split[1]
except IndexError:
print("Could not parse encoding line.", file=sys.stderr)
else:
# Done with configuration for this invocation, start accumulating
# code. Use `line_raw` because we want trailing space, \n, \r
code += line_raw
else: else:
# Accumulate more code # Accumulate more code
# Use `line_raw`: Do want trailing space, \n, \r # Use `line_raw`: Do want trailing space, \n, \r

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base racket/syntax)) (require (for-syntax racket/base racket/syntax))
(require racket/path) (require racket/path racket/match)
(require "../setup.rkt" sugar/define sugar/file sugar/coerce sugar/test) (require "../setup.rkt" sugar/define sugar/file sugar/coerce sugar/test)
@ -19,10 +19,9 @@
(parameterize ([current-directory (dirname (->complete-path starting-path))]) (parameterize ([current-directory (dirname (->complete-path starting-path))])
(let loop ([dir (current-directory)][path filename-to-find]) (let loop ([dir (current-directory)][path filename-to-find])
(and dir ; dir is #f when it hits the top of the filesystem (and dir ; dir is #f when it hits the top of the filesystem
(let ([completed-path (path->complete-path path)]) (match (simple-form-path path)
(if (exists-proc completed-path) [(? exists-proc sfp) sfp]
(simplify-path completed-path) [_ (loop (dirname dir) (build-path 'up path))])))))
(loop (dirname dir) (build-path 'up path))))))))
;; for files like svg that are not source in pollen terms, ;; for files like svg that are not source in pollen terms,
@ -57,7 +56,7 @@
(not (regexp-match #rx"^\\." (path->string path)))) (not (regexp-match #rx"^\\." (path->string path))))
(define+provide (escape-last-ext x [escape-char (setup:extension-escape-char)]) (define+provide (escape-last-ext x [escape-char pollen-extension-escape-char])
;((pathish?) (char?) . ->* . coerce/path?) ;((pathish?) (char?) . ->* . coerce/path?)
;; if x has a file extension, reattach it with the escape char ;; if x has a file extension, reattach it with the escape char
(define current-ext (get-ext x)) (define current-ext (get-ext x))
@ -76,7 +75,7 @@
(define second cadr) (define second cadr)
(define third caddr) (define third caddr)
(define (last x) (car (reverse x))) (define (last x) (car (reverse x)))
(define+provide (unescape-ext x [escape-char (setup:extension-escape-char)]) (define+provide (unescape-ext x [escape-char pollen-extension-escape-char])
;((coerce/string?) (char?) . ->* . coerce/path?) ;((coerce/string?) (char?) . ->* . coerce/path?)
;; if x has an escaped extension, unescape it. ;; if x has an escaped extension, unescape it.
(define-values (base _ dir?) (split-path x)) (define-values (base _ dir?) (split-path x))
@ -128,7 +127,7 @@
(define+provide (has-poly-ext? x) (define+provide (has-poly-ext? x)
(equal? (get-ext x) (->string (setup:poly-source-ext)))) (equal? (get-ext x) (->string pollen-poly-source-ext)))
(module-test-external (module-test-external
(check-true (has-poly-ext? "foo.poly")) (check-true (has-poly-ext? "foo.poly"))
@ -147,7 +146,7 @@
(define-syntax (define-utility-functions stx) (define-syntax (define-utility-functions stx)
(syntax-case stx () (syntax-case stx ()
[(_ STEM) [(_ STEM)
(with-syntax ([SETUP:STEM-SOURCE-EXT (format-id stx "setup:~a-source-ext" #'STEM)] (with-syntax ([STEM-SOURCE-EXT (format-id stx "pollen-~a-source-ext" #'STEM)]
[STEM-SOURCE? (format-id stx "~a-source?" #'STEM)] [STEM-SOURCE? (format-id stx "~a-source?" #'STEM)]
[GET-STEM-SOURCE (format-id stx "get-~a-source" #'STEM)] [GET-STEM-SOURCE (format-id stx "get-~a-source" #'STEM)]
[HAS/IS-STEM-SOURCE? (format-id stx "has/is-~a-source?" #'STEM)] [HAS/IS-STEM-SOURCE? (format-id stx "has/is-~a-source?" #'STEM)]
@ -158,7 +157,7 @@
;; does file have particular extension ;; does file have particular extension
(define+provide (STEM-SOURCE? x) (define+provide (STEM-SOURCE? x)
#;(any/c . -> . boolean?) #;(any/c . -> . boolean?)
(and (pathish? x) (has-ext? (->path x) (SETUP:STEM-SOURCE-EXT)) #true)) (and (pathish? x) (has-ext? (->path x) STEM-SOURCE-EXT) #true))
;; non-theoretical: want the first possible source that exists in the filesystem ;; non-theoretical: want the first possible source that exists in the filesystem
(define+provide (GET-STEM-SOURCE x) (define+provide (GET-STEM-SOURCE x)
@ -185,19 +184,19 @@
(list x) ; already has the source extension (list x) ; already has the source extension
#,(if (eq? (syntax->datum #'STEM) 'scribble) #,(if (eq? (syntax->datum #'STEM) 'scribble)
#'(if (x . has-ext? . 'html) ; different logic for scribble sources #'(if (x . has-ext? . 'html) ; different logic for scribble sources
(list (add-ext (remove-ext* x) (SETUP:STEM-SOURCE-EXT))) (list (add-ext (remove-ext* x) STEM-SOURCE-EXT))
#false) #false)
#'(let ([x-ext (get-ext x)] #'(let ([x-ext (get-ext x)]
[source-ext (SETUP:STEM-SOURCE-EXT)]) [source-ext STEM-SOURCE-EXT])
(cons (cons
(add-ext x source-ext) ; standard (add-ext x source-ext) ; standard
(if x-ext ; has existing ext, therefore needs escaped version (if x-ext ; has existing ext, therefore needs escaped version
(cons (cons
(add-ext (escape-last-ext x) source-ext) (add-ext (escape-last-ext x) source-ext)
(if (ext-in-poly-targets? x-ext x) ; needs multi + escaped multi (if (ext-in-poly-targets? x-ext x) ; needs multi + escaped multi
(let ([x-multi (add-ext (remove-ext x) (setup:poly-source-ext))]) (let ([x-multi (add-ext (remove-ext x) pollen-poly-source-ext)])
(list (list
(add-ext x-multi (SETUP:STEM-SOURCE-EXT)) (add-ext x-multi STEM-SOURCE-EXT)
(add-ext (escape-last-ext x-multi) source-ext))) (add-ext (escape-last-ext x-multi) source-ext)))
null)) null))
null)))))) null))))))
@ -221,21 +220,15 @@
(define+provide (->source+output-paths source-or-output-path) (define+provide (->source+output-paths source-or-output-path)
;(complete-path? . -> . (values complete-path? complete-path?)) ;(complete-path? . -> . (values complete-path? complete-path?))
;; file-proc returns two values, but ormap only wants one ;; file-proc returns two values, but ormap only wants one
(define tests (list (define file-proc
has/is-null-source? (match source-or-output-path
has/is-preproc-source? ;; resolve these in alphabetical order, because project server gives priority to alphabetic order
has/is-markup-source? [(? has/is-null-source?) ->null-source+output-paths] ; .p
has/is-scribble-source? [(? has/is-markup-source?) ->markup-source+output-paths] ; .pm
has/is-markdown-source?)) [(? has/is-markdown-source?) ->markdown-source+output-paths] ; .pmd
(define file-procs (list ->null-source+output-paths [(? has/is-preproc-source?) ->preproc-source+output-paths] ; .pp
->preproc-source+output-paths [(? has/is-scribble-source?) ->scribble-source+output-paths] ; . scrbl
->markup-source+output-paths [_ (λ (x) (values #false #false))]))
->scribble-source+output-paths
->markdown-source+output-paths))
(define file-proc (for/first ([test (in-list tests)]
[file-proc (in-list file-procs)]
#:when (test source-or-output-path))
file-proc))
(file-proc source-or-output-path)) (file-proc source-or-output-path))
@ -299,8 +292,8 @@
(and (regexp-match pat str) #t)) (and (regexp-match pat str) #t))
(define (special-path? path) (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)) (and (member (path->string (last (explode-path path))) special-paths) #t))
(module-test-internal (module-test-internal

@ -12,3 +12,6 @@
(define (message . items) (define (message . items)
(log-pollen-info (string-join (map ~a items) " "))) (log-pollen-info (string-join (map ~a items) " ")))
(define (message-debug . items)
(log-pollen-debug (string-join (map ~a items) " ")))

@ -2,8 +2,8 @@
(require (for-syntax racket/base (require (for-syntax racket/base
syntax/strip-context syntax/strip-context
"../setup.rkt" "../setup.rkt"
"splice.rkt"
"split-metas.rkt") "split-metas.rkt")
racket/match
racket/list racket/list
"to-string.rkt" "to-string.rkt"
"../pagetree.rkt" "../pagetree.rkt"
@ -15,50 +15,57 @@
(rename-out [pollen-module-begin #%module-begin]) (rename-out [pollen-module-begin #%module-begin])
(all-from-out "../core.rkt" "../setup.rkt")) (all-from-out "../core.rkt" "../setup.rkt"))
(define ((make-parse-proc parser-mode root-proc) xs)
(define (stringify xs) (apply string-append (map to-string xs)))
(match parser-mode
[(== default-mode-pagetree) (decode-pagetree xs)]
[(== default-mode-markup) (apply root-proc (remove-voids xs))]
[(== default-mode-markdown)
(let* ([xs (stringify xs)]
[xs ((dynamic-require 'markdown 'parse-markdown) xs)]
[xs (map strip-empty-attrs xs)])
(apply root-proc xs))]
[_ (stringify xs)])) ; preprocessor mode
(define (strip-leading-newlines doc) (define (strip-leading-newlines doc)
;; drop leading newlines, as they're often the result of `defines` and `requires` ;; drop leading newlines, as they're often the result of `defines` and `requires`
(if (setup:trim-whitespace?) (if (setup:trim-whitespace?)
(dropf doc (λ (ln) (member ln (list (setup:newline) "")))) (dropf doc (λ (ln) (member ln (list (setup:newline) ""))))
doc)) doc))
(define (stringify xs) (apply string-append (map to-string xs)))
(define (parse xs-in parser-mode root-proc)
(define xs (splice (strip-leading-newlines xs-in) pollen-splicing-tag))
(cond
[(eq? parser-mode default-mode-pagetree) (decode-pagetree xs)]
[(eq? parser-mode default-mode-markup) (apply root-proc (remove-voids xs))]
[(eq? parser-mode default-mode-markdown)
(let* ([xs (stringify xs)]
[xs ((dynamic-require 'markdown 'parse-markdown) xs)]
[xs (map strip-empty-attrs xs)])
(apply root-proc xs))]
[else (stringify xs)])) ; preprocessor mode
(define-syntax (pollen-module-begin stx) (define-syntax (pollen-module-begin stx)
(syntax-case stx () (syntax-case stx ()
[(_ PARSER-MODE . EXPRS) [(_ PARSER-MODE . EXPRS)
(with-syntax ([META-HASH (split-metas #'EXPRS (setup:define-meta-name))] (with-syntax ([META-HASH (split-metas #'EXPRS pollen-define-meta-name)]
[METAS-ID (setup:meta-export)] [METAS-ID pollen-meta-export]
[METAS-ID-CALLER (datum->syntax #'EXPRS (setup:meta-export))] [METAS-ID-CALLER (datum->syntax #'EXPRS pollen-meta-export)]
[ROOT-ID (datum->syntax #'EXPRS (setup:main-root-node))] [ROOT-ID (datum->syntax #'EXPRS (setup:main-root-node))]
[POLLEN/TOP (datum->syntax #'EXPRS 'pollen/top)] [POLLEN/TOP (datum->syntax #'EXPRS 'pollen/top)]
[DOC-ID (setup:main-export)] [DOC-ID pollen-main-export]
[ALL-DEFINED-OUT (datum->syntax #'EXPRS '(all-defined-out))]) [ALL-DEFINED-OUT (datum->syntax #'EXPRS '(all-defined-out))])
#'(doclang:#%module-begin #'(doclang:#%module-begin
DOC-ID ; positional arg for doclang-raw: name of export DOC-ID ; positional arg for doclang-raw: name of export
(λ (xs) (λ (xs) ; positional arg for doclang-raw: post-processor
(define proc (make-parse-proc PARSER-MODE ROOT-ID)) ;; wait till the end to restore prev-metas
(define trimmed-xs (strip-leading-newlines xs)) ;; because tag functions may edit current-metas
(define doc-elements (splice trimmed-xs (setup:splicing-tag))) ;; and we want root to see those changes
(parameterize ([current-metas METAS-ID-CALLER]) (begin0
(proc doc-elements))) ; positional arg for doclang-raw: post-processor (parse xs PARSER-MODE ROOT-ID)
;; pick up any imperative changes to current-metas by tag functions
(set! METAS-ID-CALLER (current-metas))
;; restore previous value of metas
(current-metas prev-metas)))
(module METAS-ID racket/base (module METAS-ID racket/base
(provide METAS-ID) (provide METAS-ID)
(define METAS-ID META-HASH)) (define METAS-ID META-HASH))
(require POLLEN/TOP (submod "." METAS-ID)) (require POLLEN/TOP (submod "." METAS-ID))
(provide ALL-DEFINED-OUT ; implicitly picks up METAS-ID-CALLER (provide ALL-DEFINED-OUT; implicitly picks up METAS-ID-CALLER
DOC-ID) DOC-ID)
(define prev-metas (current-metas)) ;; we set current-metas imperatively rather than using `splicing-parameterize`
(define METAS-ID-CALLER METAS-ID) ;; so that we can restore it in the post-processor, rather than out here
(and (current-metas METAS-ID) "") ; because empty strings get stripped, voids don't (define METAS-ID-CALLER METAS-ID) ; grab the new metas
(begin . EXPRS) (define prev-metas (current-metas)) ; stash the old metas
(and (current-metas prev-metas) "")))])) ; leave behind empty string, not void (and (current-metas METAS-ID-CALLER) "") ; because empty strings get stripped, voids don't
(begin . EXPRS)))]))

@ -2,9 +2,8 @@
(require racket/file (require racket/file
racket/path racket/path
racket/place racket/place
racket/list
racket/match racket/match
sugar/list racket/format
"file-utils.rkt" "file-utils.rkt"
"cache-utils.rkt" "cache-utils.rkt"
"log.rkt") "log.rkt")
@ -16,48 +15,66 @@
(define-values (_ private-cache-dir) (make-cache-dirs path)) (define-values (_ private-cache-dir) (make-cache-dirs path))
(define cache-db-file (build-path private-cache-dir "cache.rktd")) (define cache-db-file (build-path private-cache-dir "cache.rktd"))
(and (file-exists? cache-db-file) (and (file-exists? cache-db-file)
(hash-has-key? (file->value cache-db-file) (paths->key path)))) (hash-has-key? (file->value cache-db-file) (paths->key 'source path))))
(define (preheat-cache starting-dir) (define (preheat-cache starting-dir [wants-parallel-setup? #false] [wants-dry-run? #false])
(unless (and (path-string? starting-dir) (directory-exists? starting-dir)) (unless (and (path-string? starting-dir) (directory-exists? starting-dir))
(raise-argument-error 'preheat-cache "directory" starting-dir)) (raise-argument-error 'preheat-cache "directory" starting-dir))
;; if a file is already in the cache, no need to hit it again. ;; if a file is already in the cache, no need to hit it again.
;; this allows partially completed preheat jobs to resume. ;; this allows partially completed preheat jobs to resume.
(define uncached-paths (define uncached-paths
(for/list ([path (in-directory starting-dir)] (for/list ([path (in-directory starting-dir (λ (p) (not (special-path? p))))]
#:when (for/or ([proc (in-list (list preproc-source? #:when (for/or ([proc (in-list (list preproc-source?
markup-source? markup-source?
markdown-source? markdown-source?
pagetree-source?))]) pagetree-source?))])
(proc path)) (proc path))
#:unless (path-cached? path)) #:unless (path-cached? path))
path)) (simple-form-path path)))
(define worker-evts (cond
(for/list ([wpidx (in-range (processor-count))]) [wants-dry-run? (for-each message uncached-paths)]
(define wp [(null? uncached-paths) (message "all cached files are up to date")]
(place ch [wants-parallel-setup?
(let loop ()
(define path (place-channel-put/get ch (list 'want-job))) (define job-count
(place-channel-put ch (list 'job-finished path (min
(with-handlers ([exn:fail? (λ (e) #f)]) (length uncached-paths)
(path->hash path)))) (match wants-parallel-setup?
(loop)))) [#true (processor-count)]
(handle-evt wp (λ (val) (list* wpidx wp val))))) [(? exact-positive-integer? count) count]
[_ (raise-argument-error 'preheat-cache "exact positive integer" wants-parallel-setup?)])))
(define worker-evts
(for/list ([wpidx (in-range job-count)])
(define wp
(place ch
(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) (cons #false (exn-message e)))])
(path->hash path))))
(loop))))
(handle-evt wp (λ (val) (list* wpidx wp val)))))
(let loop ([paths uncached-paths][actives null]) (let loop ([paths uncached-paths][actives null])
(unless (and (null? paths) (null? actives)) (unless (and (null? paths) (null? actives))
(match (apply sync worker-evts) (match (apply sync worker-evts)
[(list wpidx wp 'want-job) [(list wpidx wp 'want-job)
(match paths (match paths
[(? null?) (loop null actives)] [(? null?) (loop null actives)]
[(cons path rest) [(cons path rest)
(place-channel-put wp path) (place-channel-put wp path)
(message (format "caching on core ~a: ~a" (add1 wpidx) (find-relative-path starting-dir path))) (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))])] (loop rest (cons wpidx actives))])]
[(list wpidx wp 'job-finished path result) [(list wpidx wp 'job-finished path result)
(if result (match result
(cache-ref! (paths->key path) (λ () 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))]
(message (format "caching failed on core ~a: ~a" (add1 wpidx) (find-relative-path starting-dir path)))) [_ (cache-ref! (paths->key 'source path) (λ () result))])
(loop paths (remq wpidx actives))])))) (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) (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))]))]))

@ -58,15 +58,16 @@
;; print message to console about a request ;; print message to console about a request
(define/contract (logger req) (define/contract (logger req)
(request? . -> . void?) (request? . -> . void?)
(define localhost-client "::1") (define localhost-names '("::1" "fe80::1%lo0" "127.0.0.1"))
(define url-string (url->string (request-uri req))) (define url-string (url->string (request-uri req)))
(unless (ends-with? url-string "favicon.ico") (unless (ends-with? url-string "favicon.ico")
(message (match url-string (message (match url-string
[(regexp #rx"/$") (string-append url-string " directory default page")] [(regexp #rx"/$") (string-append url-string " directory default page")]
[_ (string-replace url-string (setup:main-pagetree) " dashboard")]) [_ (string-replace url-string (setup:main-pagetree) " dashboard")])
(match (request-client-ip req) (match (request-client-ip req)
[(== localhost-client) ""] [client #:when (not (member client localhost-names))
[client (format "from ~a" client)])))) (format "from ~a" client)]
[_ ""]))))
;; pass string args to route, then ;; pass string args to route, then
;; package route into right format for web server ;; package route into right format for web server
@ -176,7 +177,7 @@
null))) null)))
(define dirlinks (cons "/" (map (λ (ps) (format "/~a/" (apply build-path ps))) (define dirlinks (cons "/" (map (λ (ps) (format "/~a/" (apply build-path ps)))
(for/list ([i (in-range (length (cdr dirs)))]) (for/list ([i (in-range (length (cdr dirs)))])
(take (cdr dirs) (add1 i)))))) (take (cdr dirs) (add1 i))))))
`(row (heading ((colspan "3")) ,@(add-between (map (λ (dir dirlink) `(a ((href ,(format "~a~a" dirlink (setup:main-pagetree)))) ,(->string dir))) dirs dirlinks) "/")))) `(row (heading ((colspan "3")) ,@(add-between (map (λ (dir dirlink) `(a ((href ,(format "~a~a" dirlink (setup:main-pagetree)))) ,(->string dir))) dirs dirlinks) "/"))))
(define (make-path-row filename source indent-level) (define (make-path-row filename source indent-level)
@ -192,7 +193,7 @@
(define source-minus-ext (unescape-ext (remove-ext source))) (define source-minus-ext (unescape-ext (remove-ext source)))
(define source-second-ext (get-ext source-minus-ext)) (define source-second-ext (get-ext source-minus-ext))
(cond ; multi source. expand to multiple output files. (cond ; multi source. expand to multiple output files.
[(and source-second-ext (equal? source-second-ext (->string (setup:poly-source-ext (->complete-path source))))) [(and source-second-ext (equal? source-second-ext (->string pollen-poly-source-ext)))
(define source-base (remove-ext source-minus-ext)) (define source-base (remove-ext source-minus-ext))
(define output-names (map (λ (ext) (->string (add-ext source-base ext))) (setup:poly-targets (->complete-path source)))) (define output-names (map (λ (ext) (->string (add-ext source-base ext))) (setup:poly-targets (->complete-path source))))
(cons #f `(div ,@(map (λ (on) `(a ((href ,on)) ,on (span ((class "file-ext")) "." ,source-first-ext ,(format " (from ~a)" (->string (find-relative-path dashboard-dir source)))))) output-names)))] (cons #f `(div ,@(map (λ (on) `(a ((href ,on)) ,on (span ((class "file-ext")) "." ,source-first-ext ,(format " (from ~a)" (->string (find-relative-path dashboard-dir source)))))) output-names)))]
@ -301,15 +302,21 @@
[possible-idx-path (in-value (build-path index-dir possible-idx-page))] [possible-idx-path (in-value (build-path index-dir possible-idx-page))]
[_ (in-value (render-from-source-or-output-path possible-idx-path))] [_ (in-value (render-from-source-or-output-path possible-idx-path))]
#:when (file-exists? possible-idx-path)) #:when (file-exists? possible-idx-path))
(redirect-to (path->string (find-relative-path index-dir possible-idx-path)) temporarily)) (redirect-to (path->string (find-relative-path index-dir possible-idx-path)) temporarily))
(route-404 req))) (route-404 req)))
;; 404 route ;; 404 route
(define/contract (route-404 req) (define/contract (route-404 req)
(request? . -> . response?) (request? . -> . response?)
(define missing-url (url->string (request-uri req)))
(define missing-path-string (path->string (simplify-path (req->path req)))) (define missing-path-string (path->string (simplify-path (req->path req))))
(message (format "can't find ~a" missing-path-string)) (message (format "can't find ~a" missing-url))
(response/xexpr+doctype (response/xexpr+doctype
`(html `(html
(head (title "404 error") (link ((href "/error.css") (rel "stylesheet")))) (head (title "404 error") (link ((href "/error.css") (rel "stylesheet"))))
(body (div ((class "section")) (div ((class "title")) "404 error") (p ,(format "~v" missing-path-string) " was not found")))))) (body (div ((class "section"))
(div ((class "title")) "404 error")
(p ,(format "URL ~v was not found at path ~v" missing-url
(match missing-path-string
[(regexp #rx"/$") (string-append missing-path-string "index.html")]
[mps mps]))))))))

@ -1,40 +1,78 @@
#lang web-server/base #lang racket/base
(require racket/list (require racket/async-channel
web-server/servlet-env racket/runtime-path
web-server/dispatch web-server/dispatch
web-server/web-server
web-server/servlet-dispatch
web-server/private/mime-types
(prefix-in files: web-server/dispatchers/dispatch-files)
(prefix-in sequencer: web-server/dispatchers/dispatch-sequencer)
web-server/dispatchers/filesystem-map
net/sendurl
"project-server-routes.rkt" "project-server-routes.rkt"
"log.rkt" "log.rkt"
"../setup.rkt" "../setup.rkt"
"../file.rkt" "../file.rkt"
"../cache.rkt"
"version.rkt") "version.rkt")
(provide start-server) (provide start-server)
(define (start-server servlet-path [open-browser-window? #f]) (define-runtime-path mime-types "server-extras/mime.types")
(define-values (pollen-servlet _)
(dispatch-rules (define (make-static-dispatcher-sequence . pths)
[((string-arg) ... (? (λ (x) (string=? "" x)))) route-index] ; last element of a "/"-terminated url is "" (apply sequencer:make
[((string-arg) ... (? pagetree-source?)) route-dashboard] (for/list ([pth (in-list pths)])
[((string-arg) ... "in" (string-arg) ...) route-in] (files:make
[((string-arg) ... "out" (string-arg) ...) route-out] #:path->mime-type (make-path->mime-type mime-types)
[else route-default])) #:url->path (make-url->path (path->string pth))))))
(define-values (pollen-servlet _)
(dispatch-rules
;; last element of a "/"-terminated url is ""
[((string-arg) ... "") route-index]
[((string-arg) ... (? pagetree-source?)) route-dashboard]
[((string-arg) ... "in" (string-arg) ...) route-in]
[((string-arg) ... "out" (string-arg) ...) route-out]
[else route-default]))
(define (start-server servlet-path [open-browser-window? #false] #:return [return? #false])
(define server-name (format "http://localhost:~a" (current-server-port)))
(message (format "welcome to Pollen ~a (Racket ~a)" pollen:version (version))) (message (format "welcome to Pollen ~a (Racket ~a)" pollen:version (version)))
(message (format "project root is ~a" (current-project-root))) (message (format "project root is ~a" (current-project-root)))
(define server-name (format "http://localhost:~a" (current-server-port)))
(message (format "project server is ~a (Ctrl+C to exit)" server-name)) (message (format "project server is ~a (Ctrl+C to exit)" server-name))
(message (format "project dashboard is ~a/~a" server-name (setup:main-pagetree))) (message (format "project dashboard is ~a/~a" server-name (setup:main-pagetree)))
(message (let ([clsi (current-server-listen-ip)])
(if clsi
(format "project server permitting access only to ~a"
(case clsi
[("127.0.0.1") "localhost"]
[else clsi]))
"project server permitting access to all clients")))
(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
(current-project-root)
(current-server-extras-path))
(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") (message "ready to rock")
(when open-browser-window?
(parameterize ([error-print-width 1000]) (send-url (string-append server-name servlet-path)))
(serve/servlet pollen-servlet (if return?
#:launch-browser? open-browser-window? stop-func
#:servlet-path servlet-path (with-handlers ([exn:break? (λ (e) (stop-func) (message "project server stopped"))])
#:port (current-server-port) (do-not-return))))
#:listen-ip (current-server-listen-ip)
#:servlet-regexp #rx"" ; respond to top level
#:command-line? #t
#:file-not-found-responder route-404
#:extra-files-paths (list (current-server-extras-path) (current-project-root)))))

@ -4,7 +4,6 @@
racket/class racket/class
racket/string racket/string
racket/runtime-path racket/runtime-path
racket/match
setup/getinfo setup/getinfo
sugar/file sugar/file
(for-syntax racket/base) (for-syntax racket/base)
@ -19,14 +18,15 @@
((if (syntax? source-name) syntax-source values) source-name)) ((if (syntax? source-name) syntax-source values) source-name))
(define (infer-parser-mode reader-mode reader-here-path) (define (infer-parser-mode reader-mode reader-here-path)
(match reader-mode (cond
[(== default-mode-auto) [(eq? reader-mode default-mode-auto)
(match (cond [(get-ext reader-here-path) => string->symbol]) (let ([val (cond [(get-ext reader-here-path) => string->symbol])])
[(== (setup:pagetree-source-ext)) default-mode-pagetree] (cond
[(== (setup:markup-source-ext)) default-mode-markup] [(eq? val pollen-pagetree-source-ext) default-mode-pagetree]
[(== (setup:markdown-source-ext)) default-mode-markdown] [(eq? val pollen-markup-source-ext) default-mode-markup]
[_ default-mode-preproc])] [(eq? val pollen-markdown-source-ext) default-mode-markdown]
[_ reader-mode])) [else default-mode-preproc]))]
[else reader-mode]))
(define (custom-read p) (syntax->datum (custom-read-syntax (object-name p) p))) (define (custom-read p) (syntax->datum (custom-read-syntax (object-name p) p)))
@ -46,11 +46,11 @@
;; an inline Pollen submodule doesn't have "pollen.rkt" or `here-path` ;; an inline Pollen submodule doesn't have "pollen.rkt" or `here-path`
[POLLEN-REQUIRE-AND-PROVIDES (require+provide-directory-require-files pollen-require-path)] [POLLEN-REQUIRE-AND-PROVIDES (require+provide-directory-require-files pollen-require-path)]
[HERE-PATH reader-here-path] [HERE-PATH reader-here-path]
[HERE-KEY (setup:here-path-key)] [HERE-KEY pollen-here-path-key]
[SOURCE-LINES source-stx] [SOURCE-LINES source-stx]
[DOC (setup:main-export)] [DOC pollen-main-export]
[META-MOD (setup:meta-export)] [META-MOD pollen-meta-export]
[METAS-ID (setup:meta-export)] [METAS-ID pollen-meta-export]
[PARSER-MODE-FROM-READER parser-mode-from-reader]) [PARSER-MODE-FROM-READER parser-mode-from-reader])
#'(module runtime-wrapper racket/base #'(module runtime-wrapper racket/base
(module configure-runtime racket/base (module configure-runtime racket/base
@ -88,12 +88,16 @@
(hash-ref! command-char-cache maybe-source-path (λ () (setup:command-char maybe-source-path)))) (hash-ref! command-char-cache maybe-source-path (λ () (setup:command-char maybe-source-path))))
(case key (case key
[(color-lexer) [(color-lexer)
(match (dynamic-require 'syntax-color/scribble-lexer 'make-scribble-inside-lexer (λ () #false)) (define maybe-lexer
[(? procedure? make-lexer) (make-lexer #:command-char my-command-char)] (dynamic-require 'syntax-color/scribble-lexer 'make-scribble-inside-lexer (λ () #false)))
[_ default])] (cond
[(procedure? maybe-lexer) (maybe-lexer #:command-char my-command-char)]
[else default])]
[(drracket:toolbar-buttons) [(drracket:toolbar-buttons)
(match (dynamic-require 'pollen/private/drracket-buttons 'make-drracket-buttons (λ () #false)) (define maybe-button-maker
[(? procedure? make-buttons) (make-buttons my-command-char)])])] (dynamic-require 'pollen/private/drracket-buttons 'make-drracket-buttons (λ () #false)))
(when (procedure? maybe-button-maker)
(maybe-button-maker my-command-char))])]
[(drracket:indentation) [(drracket:indentation)
(λ (text pos) (λ (text pos)
(define line-idx (send text position-line pos)) (define line-idx (send text position-line pos))
@ -103,28 +107,30 @@
(or (or
(for/first ([pos (in-range line-start-pos line-end-pos)] (for/first ([pos (in-range line-start-pos line-end-pos)]
#:unless (char-blank? (send text get-character pos))) #:unless (char-blank? (send text get-character pos)))
pos) pos)
line-start-pos)) line-start-pos))
(- first-vis-pos line-start-pos))] (- first-vis-pos line-start-pos))]
[(drracket:default-filters) [(drracket:default-filters)
;; derive this from `module-suffixes` entry in main info.rkt file ;; derive this from `module-suffixes` entry in main info.rkt file
(define module-suffixes ((get-info/full info-dir) 'module-suffixes)) (define module-suffixes ((get-info/full info-dir) 'module-suffixes))
(define filter-strings (for/list ([suffix (in-list module-suffixes)]) (define filter-strings (for/list ([suffix (in-list module-suffixes)])
(format "*.~a" suffix))) (format "*.~a" suffix)))
(list (list "Pollen sources" (string-join filter-strings ";")))] (list (list "Pollen sources" (string-join filter-strings ";")))]
[(drracket:default-extension) [(drracket:default-extension)
(symbol->string (symbol->string
(match mode (cond
[(== default-mode-auto) (setup:preproc-source-ext)] [(eq? mode default-mode-auto) pollen-preproc-source-ext]
[(== default-mode-preproc) (setup:preproc-source-ext)] [(eq? mode default-mode-preproc) pollen-preproc-source-ext]
[(== default-mode-markdown) (setup:markdown-source-ext)] [(eq? mode default-mode-markdown) pollen-markdown-source-ext]
[(== default-mode-markup) (setup:markup-source-ext)] [(eq? mode default-mode-markup) pollen-markup-source-ext]
[(== default-mode-pagetree) (setup:pagetree-source-ext)]))] [(eq? mode default-mode-pagetree) pollen-pagetree-source-ext]))]
[(module-language) 'pollen]
[else default]))) [else default])))
(define-syntax-rule (reader-module-begin mode . _) (define-syntax-rule (reader-module-begin mode . _)
(#%module-begin (#%module-begin
(define cgi (custom-get-info mode)) ; stash hygienic references to local funcs with macro-introduced identifiers (define cgi (custom-get-info mode)) ; stash hygienic references to local funcs with macro-introduced identifiers
(define cr custom-read) ; so they can be provided out (define cr custom-read) ; so they can be provided out
(define (crs ps p) (custom-read-syntax #:reader-mode mode ps p)) ;; allow six-argument arity to be compatible with `debug`
(define (crs ps p . _) (custom-read-syntax #:reader-mode mode ps p))
(provide (rename-out [cr read][crs read-syntax][cgi get-info])))) (provide (rename-out [cr read][crs read-syntax][cgi get-info]))))

@ -29,8 +29,8 @@
(let ([source-path (syntax->datum #'SOURCE-PATH-STRING)]) (let ([source-path (syntax->datum #'SOURCE-PATH-STRING)])
(with-syntax ([DIRECTORY-REQUIRE-FILES (with-syntax ([DIRECTORY-REQUIRE-FILES
(replace-context #'here (require-directory-require-files source-path))] (replace-context #'here (require-directory-require-files source-path))]
[DOC-ID (setup:main-export source-path)] [DOC-ID pollen-main-export]
[METAS-ID (setup:meta-export source-path)] [METAS-ID pollen-meta-export]
[COMMAND-CHAR (setup:command-char source-path)]) [COMMAND-CHAR (setup:command-char source-path)])
#'(#%module-begin #'(#%module-begin
DIRECTORY-REQUIRE-FILES DIRECTORY-REQUIRE-FILES
@ -44,8 +44,10 @@
(define doc (cached-doc SOURCE-PATH-STRING)) (define doc (cached-doc SOURCE-PATH-STRING))
(define metas (current-metas)) (define metas (current-metas))
(define here (path->pagenode (define here (path->pagenode
(or (select-from-metas (setup:here-path-key SOURCE-PATH-STRING) metas) 'unknown))) (or (select-from-metas pollen-here-path-key metas) 'unknown)))
(if (bytes? doc) ; if main export is binary, just pass it through (if (bytes? doc) ; if main export is binary, just pass it through
doc doc
(include-template #:command-char COMMAND-CHAR (file TEMPLATE-PATH-STRING))))) ;; allows `require` in a template
(splicing-let-syntax ([require (make-rename-transformer #'local-require)])
(include-template #:command-char COMMAND-CHAR (file TEMPLATE-PATH-STRING))))))
(provide result)))))])) (provide result)))))]))

File diff suppressed because it is too large Load Diff

@ -1,10 +1,10 @@
#lang racket/base #lang racket/base
(require racket/match (require racket/match
racket/list) racket/list
"constants.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
;; (string->symbol (format "~a" #\u200B)) ;; (string->symbol (format "~a" #\u200B))
(define splice-signal-tag '@)
(define (attrs? x) (define (attrs? x)
(match x (match x
@ -18,7 +18,7 @@
[(cons (== splicing-tag eq?) _) #true] [(cons (== splicing-tag eq?) _) #true]
[_ #false])) [_ #false]))
(define (splice x [splicing-tag splice-signal-tag]) (define (splice x [splicing-tag pollen-splicing-tag])
; (listof txexpr-elements?) . -> . (listof txexpr-elements?)) ; (listof txexpr-elements?) . -> . (listof txexpr-elements?))
(let loop ([x x]) (let loop ([x x])
(if (list? x) ; don't exclude `attrs?` here, because it will exclude valid splice input like '((@ "foo")) (if (list? x) ; don't exclude `attrs?` here, because it will exclude valid splice input like '((@ "foo"))
@ -32,14 +32,14 @@
(module+ test (module+ test
(require rackunit) (require rackunit)
(check-equal? (splice `((div 1 (,splice-signal-tag 2 "" (,splice-signal-tag 3 (div 4 (,splice-signal-tag 5))) 6) "" 7))) (check-equal? (splice `((div 1 (,pollen-splicing-tag 2 "" (,pollen-splicing-tag 3 (div 4 (,pollen-splicing-tag 5))) 6) "" 7)))
'((div 1 2 3 (div 4 5) 6 7))) '((div 1 2 3 (div 4 5) 6 7)))
(check-equal? (splice `((,splice-signal-tag 1 (,splice-signal-tag 2 "" (,splice-signal-tag 3 (div 4 (,splice-signal-tag 5))) 6) "" 7))) (check-equal? (splice `((,pollen-splicing-tag 1 (,pollen-splicing-tag 2 "" (,pollen-splicing-tag 3 (div 4 (,pollen-splicing-tag 5))) 6) "" 7)))
'(1 2 3 (div 4 5) 6 7)) '(1 2 3 (div 4 5) 6 7))
(check-equal? (splice `((,splice-signal-tag "foo" "" "bar"))) '("foo" "bar")) (check-equal? (splice `((,pollen-splicing-tag "foo" "" "bar"))) '("foo" "bar"))
(check-equal? (splice null) null) (check-equal? (splice null) null)
(check-equal? (splice '(a ((href "")(foo "bar")) "zam")) '(a ((href "")(foo "bar")) "zam")) (check-equal? (splice '(a ((href "")(foo "bar")) "zam")) '(a ((href "")(foo "bar")) "zam"))
(check-equal? (splice `((,splice-signal-tag "str"))) '("str"))) (check-equal? (splice `((,pollen-splicing-tag "str"))) '("str")))
;; this will strip all empty lists. ;; this will strip all empty lists.

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

@ -1 +1 @@
1560436450 1710316839

@ -2,6 +2,8 @@
(require racket/file (require racket/file
racket/path racket/path
racket/match racket/match
racket/string
racket/format
racket/place racket/place
racket/list racket/list
racket/dict racket/dict
@ -21,17 +23,18 @@
"setup.rkt") "setup.rkt")
;; used to track renders according to modification dates of component files ;; used to track renders according to modification dates of component files
(define mod-date-hash (make-hash)) (define mod-date-hash #false)
;; when you want to generate everything fresh. ;; when you want to generate everything fresh.
;; render functions will always go when no mod-date is found. ;; render functions will always go when no mod-date is found.
(define (reset-mod-date-hash!) (set! mod-date-hash (make-hash))) (define (reset-mod-date-hash!) (set! mod-date-hash (make-hash)))
(reset-mod-date-hash!)
(module-test-internal (module-test-internal
(require racket/runtime-path) (require racket/runtime-path)
(define-runtime-path sample-dir "test/data/samples") (define-runtime-path sample-dir "test/data/samples")
(define samples (parameterize ([current-directory sample-dir]) (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))) (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) ;; each key for mod-date-hash is a list of file / mod-date pairs (using pollen/cache keymaking function)
@ -41,102 +44,206 @@
;; create a new key with current files. If the key is in the hash, the render has happened. ;; create a new key with current files. If the key is in the hash, the render has happened.
;; if not, a new render is needed. ;; if not, a new render is needed.
(define (update-mod-date-hash! source-path template-path) (define (update-mod-date-hash! source-path template-path)
(hash-set! mod-date-hash (paths->key source-path template-path) #true)) (hash-set! mod-date-hash (paths->key 'output source-path template-path) #true))
(define (mod-date-missing-or-changed? source-path template-path) (define (mod-date-missing-or-changed? source-path template-path)
(not (hash-has-key? mod-date-hash (paths->key source-path template-path)))) (not (hash-has-key? mod-date-hash (paths->key 'output source-path template-path))))
(define (list-of-pathish? x) (and (list? x) (andmap pathish? x))) (struct $job (source output) #:transparent)
(struct $jobresult (job finished-successfully) #:transparent)
(define+provide/contract (render-batch #:parallel [parallel? #false] . paths) (define (parallel-render jobs-in worker-count-arg)
((#:parallel any/c) #:rest list-of-pathish? . ->* . void?) ;; if jobs are already in the cache, pull them out before assigning workers
;; using worker to fetch from cache is slower
(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 ($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-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" worker-count-arg)])))
;; initialize the workers
(define worker-evts
(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))
(struct $lock (worker path) #:transparent)
;; `locks` and `blocks` are (listof $lock)
(let loop ([jobs (reverse uncached-jobs)]
[locks-in null]
[blocks-in null]
[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 ($lock wp path) block)
(cond
[(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 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).
;; That is, they do not appear under serial rendering.
;; 2) even if a crash is legit (that is, there is a real flaw in the source)
;; and should be raised, we don't want to do it inside a parallel-rendering `place`
;; because then the place will never return, and the whole parallel job will never finish.
;; so we take the list of crashed jobs and try rendering them again serially.
;; 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
(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 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)\n because ~a"
(add1 wpidx)
(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
(let ([jr ($jobresult ($job source-path output-path) job-finished?)])
(cons jr completed-job-results))
(add1 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]
#: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 ...)? ;; Why not just (for-each render ...)?
;; Because certain files will pass through multiple times (e.g., templates) ;; Because certain files will pass through multiple times (e.g., templates)
;; And with render, they would be rendered repeatedly. ;; And with render, they would be rendered repeatedly.
;; Using reset-modification-dates is sort of like session control. ;; Using reset-modification-dates is sort of like session control.
(reset-mod-date-hash!) (reset-mod-date-hash!)
;; we need to handle output-paths in parallel
;; because `raco pollen render` can take an output path for poly source.
;; 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 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 (cond
[parallel? [(null? all-jobs) (message "[no paths to render]")]
[(eq? special-output 'dry-run) (for-each message (map $job-source all-jobs))]
(define source-paths [else
(let () (parameterize ([current-null-output? (eq? special-output 'null)])
(define flattened-paths (for-each (λ (job) (render-to-file-if-needed ($job-source job) #f ($job-output job)))
(remove-duplicates (match wants-parallel-render?
(sort ;; returns crashed jobs for serial rendering
(let loop ([paths paths]) [#false all-jobs]
(if (null? paths) [worker-count-arg (parallel-render all-jobs worker-count-arg)])))]))
null
(match (->complete-path (car paths))
[(? pagetree-source? pt) (append (loop (pagetree->paths pt)) (loop (cdr paths)))]
[path (cons path (loop (cdr paths)))])))
string<?
#:key path->string)))
(for*/list ([p (in-list flattened-paths)]
[maybe-source-path (in-value (->source-path p))]
#:when (and maybe-source-path (file-exists? maybe-source-path)))
maybe-source-path)))
;; initialize the workers
(define worker-evts
(for/list ([wpidx (in-range (processor-count))])
(define wp (place ch
(let loop ()
(match-define (cons 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 path)))
(match-define-values (_ _ ms _)
(time-apply render-from-source-or-output-path (list path)))
(place-channel-put ch (list 'finished-job path ms)))
(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 source-paths][locks-in null][blocks-in null])
;; 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)
(cond
[(member path (dict-values locks))
(values locks (cons block blocks))]
[else
(place-channel-put wp 'lock-approved)
(values (cons block locks) blocks)])))
;; no source paths means all jobs have been assigned
;; no locks means no jobs are in progress
;; therefore we must be done.
(unless (and (null? source-paths) (null? locks))
(match (apply sync worker-evts)
[(list wpidx wp 'wants-job)
(match source-paths
[(? null?) (loop null locks blocks)]
[(cons path rest)
(place-channel-put wp (cons path poly-target))
(loop rest locks blocks)])]
[(list wpidx wp 'finished-job path ms)
(message
(format "rendered parallel on core ~a /~a ~a"
(add1 wpidx)
(find-relative-path (current-project-root) (->output-path path))
(if (< ms 1000) (format "(~a ms)" ms) (format "(~a s)" (/ ms 1000.0)))))
(loop source-paths (match (assoc wp locks)
[#false locks]
[lock (remove lock locks)]) blocks)]
[(list wpidx wp 'wants-lock path)
(loop source-paths locks (append blocks (list (cons wp path))))])))]
[else (for-each render-from-source-or-output-path paths)]))
(define (pagetree->paths pagetree-or-path)
(define pagetree (if (pagetree? pagetree-or-path)
pagetree-or-path
(cached-doc pagetree-or-path)))
(parameterize ([current-directory (current-project-root)])
(map ->complete-path (pagetree->list pagetree))))
(define+provide/contract (render-pagenodes pagetree-or-path) (define+provide/contract (render-pagenodes pagetree-or-path)
((or/c pagetree? pathish?) . -> . void?) ((or/c pagetree? pathish?) . -> . void?)
@ -144,33 +251,45 @@
(define+provide/contract (render-from-source-or-output-path so-pathish) (define+provide/contract (render-from-source-or-output-path so-pathish)
(pathish? . -> . void?) (pathish? . -> . void?)
(define so-path (->complete-path so-pathish)) ; so-path = source or output path (could be either) (define so-path (->complete-path so-pathish))
(define-values (sp op) (->source+output-paths so-path))
(cond (cond
[(for/or ([pred (in-list (list has/is-null-source? [(and sp op) (render-to-file-if-needed sp #false op)]
has/is-preproc-source? [(pagetree-source? so-path) (render-pagenodes so-path)]))
has/is-markup-source?
has/is-scribble-source? (define ram-cache (make-hash))
has/is-markdown-source?))])
(pred so-path)) (define (get-external-render-proc v)
(define-values (source-path output-path) (->source+output-paths so-path)) (match v
(render-to-file-if-needed source-path #f output-path)] [(list (? module-path? mod) (? symbol? render-proc-id))
[(pagetree-source? so-path) (render-pagenodes so-path)]) (with-handlers ([exn:fail:filesystem:missing-module?
(void)) (λ (e) (raise
(exn:fail:contract (string-replace (exn-message e) "standard-module-name-resolver" "external-renderer")
(define render-ram-cache (make-hash)) (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 ;; note that output and template order is reversed from typical
(define (render-to-file-base caller (define (render-to-file-base caller
force? force?
source-path source-path
maybe-output-path maybe-output-path
maybe-template-path) maybe-template-path
maybe-render-thunk)
(unless (file-exists? source-path) (unless (file-exists? source-path)
(raise-argument-error caller "existing source path" source-path)) (raise-user-error caller "~a is not an existing source path" source-path))
(define output-path (or maybe-output-path (->output-path source-path))) (define output-path (cond
(unless output-path [maybe-output-path]
(raise-argument-error caller "valid output path" output-path)) [(->output-path source-path)]
(define template-path (or maybe-template-path (get-template-for source-path output-path))) [else (raise-user-error caller "~a is not a valid output path" maybe-output-path)]))
(define template-path (cond
[maybe-template-path]
[(get-template-for source-path output-path)]
[else #false]))
(define render-cache-activated? (setup:render-cache-active source-path)) (define render-cache-activated? (setup:render-cache-active source-path))
(define render-needed? (define render-needed?
(cond (cond
@ -180,65 +299,66 @@
[(not render-cache-activated?) 'render-cache-deactivated] [(not render-cache-activated?) 'render-cache-deactivated]
[else #false])) [else #false]))
(when render-needed? (when render-needed?
(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 (define render-result
(let ([key (paths->key source-path template-path output-path)] (cond
[render-thunk (λ () (render source-path template-path output-path))]) ; returns either string or bytes [render-cache-activated?
(if render-cache-activated? (define key (paths->key 'output source-path template-path output-path))
(hash-ref! render-ram-cache (hash-ref! ram-cache
;; within a session, this will prevent repeat players like "template.html.p" ;; within a session, this will prevent repeat players like "template.html.p"
;; from hitting the file cache repeatedly ;; from hitting the file cache repeatedly
key key
(cache-ref! key (λ ()
render-thunk (cache-ref! key
#:dest-path 'output render-thunk
#:notify-cache-use #:notify-cache-use
(λ (str) (λ (str)
(message (format "from cache /~a" (message (format "from cache /~a"
(find-relative-path (current-project-root) output-path)))))) (find-relative-path (current-project-root) output-path)))))))]
(render-thunk)))) [else (render-thunk)]))
(display-to-file render-result (unless (current-null-output?)
output-path (display-to-file render-result
#:exists 'replace output-path
#:mode (if (string? render-result) 'text 'binary)))) #:exists 'replace
#:mode (if (string? render-result) 'text 'binary)))))
(define+provide/contract (render-to-file-if-needed source-path [maybe-template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?) (define+provide/contract (render-to-file-if-needed source-path [maybe-template-path #f] [maybe-output-path #f] [maybe-render-thunk #f])
(render-to-file-base 'render-to-file-if-needed #f source-path maybe-output-path maybe-template-path)) ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?) (or/c #f procedure?)) . ->* . void?)
(render-to-file-base 'render-to-file-if-needed #f source-path maybe-output-path maybe-template-path maybe-render-thunk))
(define+provide/contract (render-to-file source-path [maybe-template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?) (define+provide/contract (render-to-file source-path [maybe-template-path #f] [maybe-output-path #f] [maybe-render-thunk #f])
(render-to-file-base 'render-to-file #t source-path maybe-output-path maybe-template-path)) ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?) (or/c #f procedure?)) . ->* . void?)
(render-to-file-base 'render-to-file #t source-path maybe-output-path maybe-template-path maybe-render-thunk))
(define+provide/contract (render source-path [maybe-template-path #f] [maybe-output-path #f]) (define+provide/contract (render source-path [maybe-template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . (or/c string? bytes?)) ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . (or/c string? bytes?))
(unless (file-exists? source-path) (unless (file-exists? source-path)
(raise-argument-error 'render "existing source path" source-path)) (raise-user-error 'render "~a is not an existing source path" source-path))
(define output-path (or maybe-output-path (->output-path source-path))) (define output-path (cond
(unless output-path [maybe-output-path]
(raise-argument-error 'render "valid output path" output-path)) [(->output-path source-path)]
[else (raise-user-error 'render "~a is not a valid output path" maybe-output-path)]))
(define tests (list has/is-null-source? (define render-proc
has/is-preproc-source? (match source-path
has/is-markup-source? [(? has/is-null-source?) render-null-source]
has/is-scribble-source? [(? has/is-preproc-source?) render-preproc-source]
has/is-markdown-source?)) [(? has/is-markup-source?) render-markup-or-markdown-source]
(define render-procs (list render-null-source [(? has/is-scribble-source?) render-scribble-source]
render-preproc-source [(? has/is-markdown-source?) render-markup-or-markdown-source]
render-markup-or-markdown-source [_ (raise-user-error 'render "valid rendering function for ~a" source-path)]))
render-scribble-source
render-markup-or-markdown-source))
(define render-proc (for/first ([test (in-list tests)]
[render-proc (in-list render-procs)]
#:when (test source-path))
render-proc))
(unless render-proc
(raise-argument-error 'render (format "valid rendering function for ~a" source-path) render-proc))
(define template-path (or maybe-template-path (get-template-for source-path output-path))) (define template-path (cond
[maybe-template-path]
[(get-template-for source-path output-path)]
[else #false]))
;; output-path and template-path may not have an extension, so check them in order with fallback ;; output-path and template-path may not have an extension, so check them in order with fallback
(match-define-values ((cons render-result _) _ real _) (match-define-values ((cons render-result _) _ ms _)
(parameterize ([current-directory (->complete-path (dirname source-path))] (parameterize ([current-directory (->complete-path (dirname source-path))]
[current-poly-target (->symbol (or (get-ext output-path) [current-poly-target (->symbol (or (get-ext output-path)
(and template-path (get-ext template-path)) (and template-path (get-ext template-path))
@ -250,18 +370,15 @@
(time-apply render-proc (list source-path template-path output-path)))) (time-apply render-proc (list source-path template-path output-path))))
;; wait till last possible moment to store mod dates, because render-proc may also trigger its own subrenders ;; wait till last possible moment to store mod dates, because render-proc may also trigger its own subrenders
;; e.g., of a template. ;; e.g., of a template.
(message (format "rendered /~a ~a" (message (apply format "rendered /~a (~a ~a)"
(find-relative-path (current-project-root) output-path) (find-relative-path (current-project-root) output-path)
(if (< real 1000) (if (< ms 1000) (list ms "ms") (list (/ ms 1000.0) "s"))))
(format "(~a ms)" real)
(format "(~a s)" (/ real 1000.0)))))
(update-mod-date-hash! source-path template-path) (update-mod-date-hash! source-path template-path)
render-result) render-result)
(define (render-null-source source-path . ignored-paths) (define (render-null-source source-path . ignored-paths)
;((complete-path?) #:rest any/c . ->* . bytes?) ;((complete-path?) #:rest any/c . ->* . bytes?)
;; All this does is copy the source. Hence, "null". ;; All this does is copy the source. Hence, "null".
;; todo: add test to avoid copying if unnecessary (good idea in case the file is large)
(file->bytes source-path)) (file->bytes source-path))
(define-namespace-anchor render-module-ns) (define-namespace-anchor render-module-ns)
@ -283,25 +400,34 @@
;; BTW this next action has side effects: scribble will copy in its core files if they don't exist. ;; BTW this next action has side effects: scribble will copy in its core files if they don't exist.
[(? part? doc) (scribble-render (list doc) (list source-path))] [(? part? doc) (scribble-render (list doc) (list source-path))]
[_ (void)])) [_ (void)]))
(define op (->output-path source-path))
(begin0 ; because render promises the data, not the side effect (begin0 ; because render promises the data, not the side effect
(file->string (->output-path source-path)) (file->string op)
(delete-file (->output-path source-path)))) (delete-file op)))
(define (render-preproc-source source-path . _) (define (render-preproc-source source-path . _)
(cached-doc (->string source-path))) (cached-doc source-path))
(define (render-markup-or-markdown-source source-path [maybe-template-path #f] [maybe-output-path #f]) (define (render-markup-or-markdown-source source-path [maybe-template-path #f] [maybe-output-path #f])
(define output-path (or maybe-output-path (->output-path source-path))) (define output-path
(unless output-path (cond
(raise-argument-error 'render-markup-or-markdown-source "valid output path" output-path)) [maybe-output-path]
(define template-path (or maybe-template-path (get-template-for source-path output-path))) [(->output-path source-path)]
(unless template-path [else (raise-user-error 'render-markup-or-markdown-source "~a is not a valid output path" maybe-output-path)]))
(raise-argument-error 'render-markup-or-markdown-source (format "valid template path~a" (if (has-inner-poly-ext? source-path) (format " for target ~a" (current-poly-target)) "")) template-path)) (define template-path
(cond
[maybe-template-path]
[(get-template-for source-path output-path)]
[else (raise-user-error 'render-markup-or-markdown-source
"couldn't find template for target .~a"
(current-poly-target))]))
;; use a temp file so that multiple (possibly parallel) renders ;; use a temp file so that multiple (possibly parallel) renders
;; do not compete for write access to the same template ;; do not compete for write access to the same template
(define temp-template (make-temporary-file "pollentmp~a" (define temp-template (make-temporary-file "pollentmp~a" (cond
(or (->source-path template-path) template-path))) [(->source-path template-path)]
[template-path]
[else #false])))
(render-from-source-or-output-path temp-template) ; because template might have its own preprocessor source (render-from-source-or-output-path temp-template) ; because template might have its own preprocessor source
(parameterize ([current-output-port (current-error-port)] (parameterize ([current-output-port (current-error-port)]
[current-namespace (make-base-namespace)]) [current-namespace (make-base-namespace)])
@ -320,60 +446,81 @@
result))) result)))
(delete-file temp-template)))) (delete-file temp-template))))
(define (templated-source? path)
(or (markup-source? path) (markdown-source? path)))
(define (file-exists-or-has-source? path) ; path could be #f (define (file-exists-or-has-source? path) ; path could be #f
(and path (for/first ([proc (in-list (list values ->preproc-source-path ->null-source-path))] (and path (for/first ([proc (in-list (list values ->preproc-source-path ->null-source-path))]
#:when (file-exists? (proc path))) #:when (file-exists? (proc path)))
path))) path)))
(define (get-template-from-metas source-path output-path-ext) (define (get-template-from-metas source-path output-path-ext)
(with-handlers ([exn:fail:contract? (λ (e) #f)]) ; in case source-path doesn't work with cached-require (with-handlers ([exn:fail:contract? (λ (e) #f)]) ; in case source-path doesn't work with cached-require
(parameterize ([current-directory (current-project-root)]) (parameterize ([current-directory (current-project-root)])
(define source-metas (cached-metas source-path)) (define source-metas (cached-metas source-path))
(define template-name-or-names ; #f or atom or list (define template-name (match (select-from-metas pollen-template-meta-key source-metas) ; #f or atom or list
(select-from-metas (setup:template-meta-key source-path) source-metas)) [(? list? names)
(define template-name (if (list? template-name-or-names) (for/first ([name (in-list names)]
(findf (λ (tn) (eq? (get-ext tn) output-path-ext)) template-name-or-names) #:when (equal? (get-ext name) (->string output-path-ext)))
template-name-or-names)) name)]
[other other]))
(and template-name (simplify-path (cleanse-path (build-path (dirname source-path) template-name))))))) (and template-name (simplify-path (cleanse-path (build-path (dirname source-path) template-name)))))))
(define (get-default-template source-path output-path-ext) (define (get-default-template source-path output-path-ext)
(and output-path-ext (and output-path-ext
(let ([default-template-filename (add-ext (setup:template-prefix source-path) output-path-ext)]) (let ([default-template-filename (add-ext pollen-template-prefix output-path-ext)])
(find-upward-from source-path default-template-filename file-exists-or-has-source?)))) (find-upward-from source-path default-template-filename file-exists-or-has-source?))))
(define (get-fallback-template source-path output-path-ext) (define (get-fallback-template source-path output-path-ext)
(and output-path-ext (and output-path-ext
(build-path (current-server-extras-path) (build-path (current-server-extras-path)
(add-ext (setup:fallback-template-prefix source-path) output-path-ext)))) (add-ext pollen-fallback-template-prefix output-path-ext))))
(define (template-cache-key source-path output-path)
(paths->key 'template source-path (current-poly-target) output-path))
(define+provide/contract (get-template-for source-path [maybe-output-path #f]) (define+provide/contract (get-template-for source-path [maybe-output-path #f])
((complete-path?)((or/c #f complete-path?)) . ->* . (or/c #f complete-path?)) ((complete-path?)((or/c #f complete-path?)) . ->* . (or/c #f complete-path?))
(and (templated-source? source-path) (define output-path (cond
(let () [maybe-output-path]
(define output-path (or maybe-output-path (->output-path source-path))) [(->output-path source-path)]
;; output-path may not have an extension [else #false]))
(define output-path-ext (or (get-ext output-path) (current-poly-target))) (define (cache-thunk)
(for/or ([proc (list get-template-from-metas get-default-template get-fallback-template)]) (match source-path
(file-exists-or-has-source? (proc source-path output-path-ext)))))) [(or (? markup-source?) (? markdown-source?))
;; output-path may not have an extension
(module-test-external (define output-path-ext (cond
[(get-ext output-path)]
[(current-poly-target)]
[else #false]))
(for/or ([proc (list get-template-from-metas
get-default-template
get-fallback-template)])
(file-exists-or-has-source? (proc source-path output-path-ext)))]
[_ #false]))
(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) (require pollen/setup sugar/file sugar/coerce)
(define fallback.html (build-path (current-server-extras-path) (define fallback.html (build-path (current-server-extras-path)
(add-ext (setup:fallback-template-prefix) 'html))) (add-ext pollen-fallback-template-prefix 'html)))
(check-equal? (get-template-for (->complete-path "foo.poly.pm")) fallback.html) (check-equal? (get-template-for (->complete-path "foo.poly.pm")) fallback.html)
(check-equal? (get-template-for (->complete-path "foo.html.pm")) fallback.html) (check-equal? (get-template-for (->complete-path "foo.html.pm")) fallback.html)
(define fallback.svg (build-path (current-server-extras-path) (define fallback.svg (build-path (current-server-extras-path)
(add-ext (setup:fallback-template-prefix) 'svg))) (add-ext pollen-fallback-template-prefix 'svg)))
(parameterize ([current-poly-target 'svg]) (parameterize ([current-poly-target 'svg])
(check-equal? (get-template-for (->complete-path "foo.poly.pm")) fallback.svg) (check-equal? (get-template-for (->complete-path "foo.poly.pm")) fallback.svg)
(check-equal? (get-template-for (->complete-path "foo.html.pm")) fallback.html)) (check-equal? (get-template-for (->complete-path "foo.html.pm")) fallback.html))
(define fallback.missing (build-path (current-server-extras-path) (define fallback.missing (build-path (current-server-extras-path)
(add-ext (setup:fallback-template-prefix) 'missing))) (add-ext pollen-fallback-template-prefix 'missing)))
(parameterize ([current-poly-target 'missing]) (parameterize ([current-poly-target 'missing])
(check-false (get-template-for (->complete-path "foo.poly.pm"))) (check-false (get-template-for (->complete-path "foo.poly.pm")))
(check-equal? (get-template-for (->complete-path "foo.html.pm")) fallback.html))) (check-equal? (get-template-for (->complete-path "foo.html.pm")) fallback.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{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.}
] ]

@ -9,7 +9,7 @@
@defmodule[pollen/cache] @defmodule[pollen/cache]
The slowest part of a Pollen @racket[render] is compiling a source file. Because Pollen allows source files to be edited and previewed dynamically, these files get recompiled a lot. Therefore, Pollen stores copies of the exports of source files — namely, whatever is stored in @code[(format "~a" default-main-export)] and @code[(format "~a" default-meta-export)] — in a cache so they can be reused. The slowest part of a Pollen @racket[render] is compiling a source file. Because Pollen allows source files to be edited and previewed dynamically, these files get recompiled a lot. Therefore, Pollen stores copies of the exports of source files — namely, whatever is stored in @code[(format "~a" pollen-main-export)] and @code[(format "~a" pollen-meta-export)] — in a cache so they can be reused.
In each directory of your project, Pollen writes cache files into a subdirectory called @filepath{compiled}. The files are stored on disk so they can be reused between sessions. If you delete files within a cache directory (or the whole thing), don't worry — everything will get regenerated. (However, I don't recommend trying to read or write directly to any @filepath{compiled} directory, as the implementation details of the cache are subject to change.) In each directory of your project, Pollen writes cache files into a subdirectory called @filepath{compiled}. The files are stored on disk so they can be reused between sessions. If you delete files within a cache directory (or the whole thing), don't worry — everything will get regenerated. (However, I don't recommend trying to read or write directly to any @filepath{compiled} directory, as the implementation details of the cache are subject to change.)
@ -43,7 +43,7 @@ Be warned that this will make your rendering much slower. But you will be guaran
@section{Scope of dependency tracking} @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. 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.
@ -70,8 +70,6 @@ Attempt to retrieve the requested value out of the cache. If it's not there, or
These functions are the lower-level cousins of @racket[get-doc] and @racket[get-metas], which have a more convenient interface. Unless you have a special reason, you're better off using those. These functions are the lower-level cousins of @racket[get-doc] and @racket[get-metas], which have a more convenient interface. Unless you have a special reason, you're better off using those.
Despite their names, these functions actually rely on @racket[setup:main-export] and @racket[setup:meta-export] (which default to @id[default-main-export] and @id[default-meta-export]). Thus, if you override those names, everything will still work as expected.
If you want the speed benefit of the cache, you should use @racket[cached-doc] and @racket[cached-metas] to get data from Pollen source files in preference to functions like @racket[require], @racket[local-require], and @racket[dynamic-require]. Those will also work. They'll just be slower. If you want the speed benefit of the cache, you should use @racket[cached-doc] and @racket[cached-metas] to get data from Pollen source files in preference to functions like @racket[require], @racket[local-require], and @racket[dynamic-require]. Those will also work. They'll just be slower.

@ -21,6 +21,8 @@ Pollen uses a special character — the @italic{lozenge}, which looks like this:
I chose the lozenge as the command character because a) it appears in almost every font, b) it's barely used in ordinary typesetting, c) it's not used in any programming language that I know of, and d) its shape and color allow it to stand out easily in code without being distracting. I chose the lozenge as the command character because a) it appears in almost every font, b) it's barely used in ordinary typesetting, c) it's not used in any programming language that I know of, and d) its shape and color allow it to stand out easily in code without being distracting.
Consideration (b) is especially important in a text-based language like Pollen. If Pollen used something more common as its command character, then every time you used that character in text, you'd have to specially escape it. This would make it cumbersome and annoying to import plain text into Pollen source files. This is the Pareto-optimal trade.
If you're using DrRacket, you can use the @onscreen{Insert Command Char} button at the top of the editing window to — you guessed it — insert the command character. If you're using DrRacket, you can use the @onscreen{Insert Command Char} button at the top of the editing window to — you guessed it — insert the command character.
If you're using a different editor, here's how you type it: If you're using a different editor, here's how you type it:
@ -29,9 +31,9 @@ If you're using a different editor, here's how you type it:
@(linebreak)@bold{Windows}: holding down Alt, type 9674 on the num pad @(linebreak)@bold{Windows}: holding down Alt, type 9674 on the num pad
@(linebreak)@bold{GNU/Linux, BSD}: Type Ctrl + Shift + U, then 25CA, then Enter @(linebreak)@bold{GNU/Linux, BSD}: Type Ctrl + Shift + U, then 25CA, then Enter
For more information on entering arbitrary Unicode glyphs, see @link["https://en.wikipedia.org/wiki/Unicode_input"]{Wikipedia}. For more information on entering arbitrary Unicode characters, see @link["https://en.wikipedia.org/wiki/Unicode_input"]{Wikipedia}.
@subsection{``But I don't want to use it ...''} @subsection{``But I don't want to use the lozenge ...''}
Fine, but you have to pick @italic{something} as your command character. If you don't like this one, you can override it within a project — see @seclink["setup-overrides"]. Fine, but you have to pick @italic{something} as your command character. If you don't like this one, you can override it within a project — see @seclink["setup-overrides"].
@ -612,7 +614,7 @@ Second, the metas are collected into a hash table that is exported with the name
'#hasheq((dog . "Roxy") (cat . "Chopper") (here-path . "unsaved-editor")) '#hasheq((dog . "Roxy") (cat . "Chopper") (here-path . "unsaved-editor"))
} }
The only key that's automatically defined in every meta table is @racket['#,(setup:here-path-key)], which is the absolute path to the source file. (In this case, because the file hasn't been saved, you'll see the @val{unsaved-editor} name instead.) The only key that's automatically defined in every meta table is @racket['#,pollen-here-path-key], which is the absolute path to the source file. (In this case, because the file hasn't been saved, you'll see the @val{unsaved-editor} name instead.)
Still, you can override this too: Still, you can override this too:
@ -661,6 +663,32 @@ The title is ◊(select-from-metas 'title metas)
@repl-output{'(root "The title is " "Conclusion to " (em "Infinity War"))} @repl-output{'(root "The title is " "Conclusion to " (em "Infinity War"))}
To save a few keystrokes, you can consolidate multiple keyvalue pairs into one @racket[define-meta] form. So this:
@codeblock{
#lang pollen
◊(define-meta dog "Roxy")
◊(define-meta cat "Chopper")
◊(define-meta ape "Koko")
}
Is the same as this:
@codeblock{
#lang pollen
◊(define-meta dog "Roxy"
cat "Chopper"
ape "Koko")
}
In both cases, the resulting metas look like this:
@terminal{
> metas
'#hasheq((ape . "Koko") (cat . "Chopper") (dog . "Roxy") (here-path . "unsaved editor"))
}
@subsubsection{Retrieving metas} @subsubsection{Retrieving metas}
The @id{metas} hashtable is available immediately within the body of your source file. You can use @racket[select] to get values out of @id{metas}. The @id{metas} hashtable is available immediately within the body of your source file. You can use @racket[select] to get values out of @id{metas}.
@ -720,12 +748,14 @@ And the metas:
@codeblock{ @codeblock{
#lang racket/base #lang racket/base
(require "pollen-source.rkt") ; doc and metas and everything else (require "path/to/your-pollen-source") ; doc and metas and everything else
(require (submod "pollen-source.rkt" metas)) ; just metas (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. 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} @subsubsection{Inserting a comment}
Two options. Two options.

@ -16,8 +16,7 @@ These functions are automatically imported into every Pollen source file (meanin
@section{Metas} @section{Metas}
The only key that's automatically defined in every meta table is @racket['#,(setup:here-path-key)], which holds the absolute path to the source file. For instance, you could retrieve this value with @racket[(select-from-metas '#,(setup:here-path-key) metas)]. You can use something other than @racket['#,(setup:here-path-key)] as the key by overriding @racket[setup:here-path-key]. The only key that's automatically defined in every meta table is @racket['#,pollen-here-path-key], which holds the absolute path to the source file. For instance, you could retrieve this value with @racket[(select-from-metas '#,pollen-here-path-key metas)].
For a full introduction to metas, see @secref["Inserting_metas"]. For a full introduction to metas, see @secref["Inserting_metas"].
@ -32,7 +31,7 @@ You can retrieve a meta value — even in the same document where you define it
@section{Splicing} @section{Splicing}
@defform[(\@ arg ...)] @defform[(\@ arg ...)]
Splicing tag: signals that a list should be merged into its containing expression. You can use something other than @racket[\@] by overriding @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 @examples[#:eval my-eval
(module splicer pollen/markup (module splicer pollen/markup
@ -41,6 +40,24 @@ Splicing tag: signals that a list should be merged into its containing expressio
doc 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)] @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: 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. 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 — @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.}
@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.}
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. 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.
@ -302,9 +291,9 @@ The @racket[_linebreaker] argument can either be @racket[#f] (which will delete
(decode-paragraphs (decode-paragraphs
[elements (listof xexpr?)] [elements (listof xexpr?)]
[paragraph-wrapper (or/c txexpr-tag? ((listof xexpr?) . -> . txexpr?)) 'p] [paragraph-wrapper (or/c txexpr-tag? ((listof xexpr?) . -> . txexpr?)) 'p]
[#:linebreak-proc linebreak-proc ((listof xexpr?) . -> . (listof xexpr?)) decode-linebreaks] [#:linebreak-proc linebreak-proc (txexpr-elements? . -> . txexpr-elements?) decode-linebreaks]
[#:force? force-paragraph? boolean? #f]) [#:force? force-paragraph? boolean? #f])
(listof xexpr?)] txexpr-elements?]
Find paragraphs within @racket[_elements] and wrap them with @racket[_paragraph-wrapper]. Also handle linebreaks using @racket[decode-linebreaks]. Find paragraphs within @racket[_elements] and wrap them with @racket[_paragraph-wrapper]. Also handle linebreaks using @racket[decode-linebreaks].
What counts as a paragraph? Any @racket[_elements] that are either a) explicitly set apart with a paragraph separator, or b) adjacent to a @racket[block-txexpr?] (in which case the paragraph-ness is implied). What counts as a paragraph? Any @racket[_elements] that are either a) explicitly set apart with a paragraph separator, or b) adjacent to a @racket[block-txexpr?] (in which case the paragraph-ness is implied).

@ -15,17 +15,17 @@ Pollen handles six kinds of source files:
@itemlist[ @itemlist[
@item{@bold{Preprocessor}, with file extension @ext[default-preproc-source-ext]} @item{@bold{Preprocessor}, with file extension @ext[pollen-preproc-source-ext]}
@item{@bold{Markup}, with file extension @ext[default-markup-source-ext]} @item{@bold{Markup}, with file extension @ext[pollen-markup-source-ext]}
@item{@bold{Markdown}, with file extension @ext[default-markdown-source-ext]} @item{@bold{Markdown}, with file extension @ext[pollen-markdown-source-ext]}
@item{@bold{Null}, with file extension @ext[default-null-source-ext]} @item{@bold{Null}, with file extension @ext[pollen-null-source-ext]}
@item{@bold{Scribble}, with file extension @ext[default-scribble-source-ext]} @item{@bold{Scribble}, with file extension @ext[pollen-scribble-source-ext]}
@item{@bold{Pagetree}, with file extension @ext[default-pagetree-source-ext]. This is the only source type that does not produce an output file.} @item{@bold{Pagetree}, with file extension @ext[pollen-pagetree-source-ext]. This is the only source type that does not produce an output file.}
] ]
@ -170,7 +170,7 @@ In all cases, if there is no corresponding source, return @racket[#f].
path?] path?]
Convert a source path @racket[_p] into its corresponding output path. This function simply generates a path for a file — it does not ask whether the file exists. Convert a source path @racket[_p] into its corresponding output path. This function simply generates a path for a file — it does not ask whether the file exists.
If @racket[_p] has a @seclink["The_poly_output_type"]{@id[default-poly-source-ext] output type}, then @racket[->output-path] uses @racket[current-poly-target] as the output-path extension. If @racket[_p] has a @seclink["The_poly_output_type"]{@id[pollen-poly-source-ext] output type}, then @racket[->output-path] uses @racket[current-poly-target] as the output-path extension.
Otherwise, there are no type-specific variants for this function because the output path of a Pollen source file is @seclink["Saving___naming_your_source_file"]{determined by its name}. Otherwise, there are no type-specific variants for this function because the output path of a Pollen source file is @seclink["Saving___naming_your_source_file"]{determined by its name}.

@ -27,7 +27,7 @@ For ease of use, the behavior of the Pollen language departs from the standard R
Commands must start with the special lozenge character @litchar{◊}. Other material is interpreted as plain text. See @secref["pollen-command-syntax"] for more. Commands must start with the special lozenge character @litchar{◊}. Other material is interpreted as plain text. See @secref["pollen-command-syntax"] for more.
You can change the command character for a project by overriding @racket[default-command-char]. You can change the command character for a project by overriding @racket[pollen-command-char].
@bold{How is this different from Racket?} In Racket, everything is a command, and plain text must be quoted. @bold{How is this different from Racket?} In Racket, everything is a command, and plain text must be quoted.
@ -46,14 +46,12 @@ By default, every Pollen source file exports two identifiers:
Contains the output of the file. The type of output depends on the source format (about which, more below).} Contains the output of the file. The type of output depends on the source format (about which, more below).}
@defthing[metas hasheq?]{ @defthing[metas hasheq?]{
A table of keyvalue pairs with extra information that is extracted from the source. These @racket[metas] will always contain the key @racket['#,(setup:here-path-key)], which returns a string representation of the full path to the source file. Beyond that, the only @racket[metas] are the ones that are specified within the source file (see the source formats below for more detail on how to specify metas).} A table of keyvalue pairs with extra information that is extracted from the source. These @racket[metas] will always contain the key @racket['#,pollen-here-path-key], which returns a string representation of the full path to the source file. Beyond that, the only @racket[metas] are the ones that are specified within the source file (see the source formats below for more detail on how to specify metas).}
As usual, you can use @racket[require], @racket[local-require], or @racket[dynamic-require] to retrieve these values. But within a Pollen project, the faster way is to use @racket[get-doc] and @racket[get-metas]. As usual, you can use @racket[require], @racket[local-require], or @racket[dynamic-require] to retrieve these values. But within a Pollen project, the faster way is to use @racket[get-doc] and @racket[get-metas].
Pollen source files also make the @racket[metas] hashtable available through a submodule, unsurprisingly called @racket[metas]. So rather than importing a source file with @racket[(require "source.html.pm")], you can @racket[(require (submod "source.html.pm" metas))]. Accessing the metas this way avoids fully compiling the source file, and thus will usually be faster. Pollen source files also make the @racket[metas] hashtable available through a submodule, unsurprisingly called @racket[metas]. So rather than importing a source file with @racket[(require "source.html.pm")], you can @racket[(require (submod "source.html.pm" metas))]. Accessing the metas this way avoids fully compiling the source file, and thus will usually be faster.
The names @racket[doc] and @racket[metas] can be changed for a project by overriding @racket[default-main-export] and @racket[default-meta-export].
@margin-note{The Pollen rendering system relies on these two exported identifiers, but otherwise doesn't care how they're generated. Thus, the code inside your Pollen source file could be written in @tt{#lang racket} or @tt{#lang whatever}. As long as you @racket[provide] those two identifiers and follow Pollen's file-naming conventions, your source file will be renderable.} @margin-note{The Pollen rendering system relies on these two exported identifiers, but otherwise doesn't care how they're generated. Thus, the code inside your Pollen source file could be written in @tt{#lang racket} or @tt{#lang whatever}. As long as you @racket[provide] those two identifiers and follow Pollen's file-naming conventions, your source file will be renderable.}
@bold{How is this different from Racket?} In Racket, you must explicitly @racket[define] and then @racket[provide] any values you want to export. @bold{How is this different from Racket?} In Racket, you must explicitly @racket[define] and then @racket[provide] any values you want to export.
@ -71,9 +69,9 @@ If a file called @filepath{pollen.rkt} exists in the same directory with a sourc
@bold{How is this different from Racket?} In Racket, you must explicitly import files using @racket[require]. @bold{How is this different from Racket?} In Racket, you must explicitly import files using @racket[require].
@subsection{Preprocessor (@(format ".~a" default-preproc-source-ext) extension)} @subsection{Preprocessor (@(format ".~a" pollen-preproc-source-ext) extension)}
Invoke the preprocessor dialect by using @code{#lang pollen/pre} as the first line of your source file, or by using @code{#lang pollen} with a file extension of @code{@(format ".~a" default-preproc-source-ext)}. These forms are equivalent: Invoke the preprocessor dialect by using @code{#lang pollen/pre} as the first line of your source file, or by using @code{#lang pollen} with a file extension of @code{@(format ".~a" pollen-preproc-source-ext)}. These forms are equivalent:
@racketmod[#:file "sample.css.pp" pollen @racketmod[#:file "sample.css.pp" pollen
@ -96,9 +94,9 @@ The output of the preprocessor dialect, provided by @racket[doc], is plain text.
@subsection{Markdown (@(format ".~a" default-markdown-source-ext) extension)} @subsection{Markdown (@(format ".~a" pollen-markdown-source-ext) extension)}
Invoke the Markdown dialect by using @code{#lang pollen/markdown} as the first line of your source file, or by using @code{#lang pollen} with a file extension of @code{@(format ".~a" default-markdown-source-ext)}. These forms are equivalent: Invoke the Markdown dialect by using @code{#lang pollen/markdown} as the first line of your source file, or by using @code{#lang pollen} with a file extension of @code{@(format ".~a" pollen-markdown-source-ext)}. These forms are equivalent:
@racketmod[#:file "sample.txt.pmd" pollen @racketmod[#:file "sample.txt.pmd" pollen
@ -112,9 +110,9 @@ _...source...
The output of the Markdown dialect, provided by @racket[doc], is a tagged X-expression. The output of the Markdown dialect, provided by @racket[doc], is a tagged X-expression.
@subsection{Markup (@(format ".~a" default-markup-source-ext) extension)} @subsection{Markup (@(format ".~a" pollen-markup-source-ext) extension)}
Invoke the Pollen markup dialect by using @code{#lang pollen/markup} as the first line of your source file, or by using @code{#lang pollen} with a file extension of @code{@(format ".~a" default-markup-source-ext)}. These forms are equivalent: Invoke the Pollen markup dialect by using @code{#lang pollen/markup} as the first line of your source file, or by using @code{#lang pollen} with a file extension of @code{@(format ".~a" pollen-markup-source-ext)}. These forms are equivalent:
@racketmod[#:file "about.html.pm" pollen @racketmod[#:file "about.html.pm" pollen
@ -127,10 +125,10 @@ _...source...
The output of the Pollen markup dialect, provided by @racket[doc], is a tagged X-expression. The output of the Pollen markup dialect, provided by @racket[doc], is a tagged X-expression.
@subsection{Pagetree (@(format ".~a" default-pagetree-source-ext) extension)} @subsection{Pagetree (@(format ".~a" pollen-pagetree-source-ext) extension)}
Invoke the pagetree dialect by using @code{#lang pollen/ptree} as the first line of your source file, or by using @code{#lang pollen} with a file extension of @code{@(format ".~a" default-pagetree-source-ext)}. These forms are equivalent: Invoke the pagetree dialect by using @code{#lang pollen/ptree} as the first line of your source file, or by using @code{#lang pollen} with a file extension of @code{@(format ".~a" pollen-pagetree-source-ext)}. These forms are equivalent:
@racketmod[#:file "main.ptree" pollen @racketmod[#:file "main.ptree" pollen
@ -154,16 +152,16 @@ These aren't source formats because they don't contain a @tt{#lang pollen} line.
@subsection{Scribble (@(format ".~a" default-scribble-source-ext) extension)} @subsection{Scribble (@(format ".~a" pollen-scribble-source-ext) extension)}
Scribble files are recognized by the project server and can be compiled and previewed in single-page mode. Scribble files are recognized by the project server and can be compiled and previewed in single-page mode.
@subsection{Null (@(format ".~a" default-null-source-ext) extension)} @subsection{Null (@(format ".~a" pollen-null-source-ext) extension)}
Files with the null extension are simply rendered as a copy of the file without the extension, so @filepath{index.html.p} becomes @filepath{index.html}. Files with the null extension are simply rendered as a copy of the file without the extension, so @filepath{index.html.p} becomes @filepath{index.html}.
This can be useful you're managing your project with Git. Most likely you'll want to ignore @filepath{*.html} and other file types that are frequently regenerated by the project server. But if you have isolated static files — for instance, a @filepath{index.html} that doesn't have source associated with it — they'll be ignored too. You can cure this problem by appending the null extension to these static files, so they'll be tracked in your source system without actually being source files. This can be useful if you're managing your project with Git. Most likely you'll want to ignore @filepath{*.html} and other file types that are frequently regenerated by the project server. But if you have isolated static files — for instance, a @filepath{index.html} that doesn't have source associated with it — they'll be ignored too. You can cure this problem by appending the null extension to these static files, so they'll be tracked in your source system without actually being source files.
The null extension is also useful for templates — @filepath{template.html} and @filepath{template.html.p} will work the same way. The null extension is also useful for templates — @filepath{template.html} and @filepath{template.html.p} will work the same way.
@ -177,4 +175,4 @@ This convention occasionally flummoxes other programs that assume a file can onl
So instead of @filepath{index.html.pm}, your source-file name would be @filepath{index_html.pm}. When this source file is rendered, it will automatically be converted into @filepath{index.html} (meaning, the escaped extension will be converted into a normal file extension). So instead of @filepath{index.html.pm}, your source-file name would be @filepath{index_html.pm}. When this source file is rendered, it will automatically be converted into @filepath{index.html} (meaning, the escaped extension will be converted into a normal file extension).
This alternative-naming scheme is automatically enabled in every project. You can also set the escape character on a per-project basis (by overriding @racket[defaul-extension-escape-char]). Pollen will let you choose any character, but of course it would be unwise to pick one with special meaning in your filesystem (for instance, @litchar{/}). This alternative-naming scheme is automatically enabled in every project. You can also set the escape character on a per-project basis (by overriding @racket[defaul-extension-escape-char]). Pollen will let you choose any character, but of course it would be unwise to pick one with special meaning in your filesystem (for instance, @litchar{/}).

@ -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'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}]

@ -8,6 +8,6 @@
@title{License & source code} @title{License & source code}
This module is licensed under the LGPL. 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,9 +1,20 @@
#lang at-exp racket/base #lang at-exp racket/base
(require (for-syntax racket/base racket/syntax pollen/setup) scribble/core scribble/manual scribble/private/manual-sprop scribble/decode scribble/html-properties racket/runtime-path racket/format pollen/setup) (require (for-syntax racket/base
racket/syntax)
racket/format
racket/runtime-path
scribble/core
scribble/decode
scribble/html-properties
scribble/latex-properties
scribble/manual
scribble/private/manual-sprop)
(provide (all-defined-out) (all-from-out racket/runtime-path)) (provide (all-defined-out) (all-from-out racket/runtime-path))
(define-runtime-path mb-css "mb.css") (define-runtime-path mb-css "mb.css")
(define-runtime-path mb-tex "mb.tex")
(define (link-tt url) (link url (tt url))) (define (link-tt url) (link url (tt url)))
@ -13,17 +24,18 @@
(define (fileblock filename . inside) (define (fileblock filename . inside)
(compound-paragraph (compound-paragraph
(style "fileblock" (list* (alt-tag "div") 'multicommand (style "fileblock" (list* (alt-tag "div") 'multicommand
(box-mode "RfileboxBoxT" "RfileboxBoxC" "RfileboxBoxB") (box-mode "RfileboxBoxT" "RfileboxBoxC" "RfileboxBoxB")
(tex-addition mb-tex)
scheme-properties)) scheme-properties))
(list (list
(paragraph (style "fileblock_filetitle" (list* (alt-tag "div") (box-mode* "RfiletitleBox") scheme-properties)) (paragraph (style "fileblockFiletitle" (list* (alt-tag "div") (box-mode* "RfiletitleBox") (tex-addition mb-tex) scheme-properties))
(list (make-element (list (make-element
(style "fileblock_filename" (list (css-style-addition mb-css))) (style "fileblockFilename" (list (css-style-addition mb-css) (tex-addition mb-tex)))
(if (string? filename) (if (string? filename)
(filepath filename) (filepath filename)
filename)))) filename))))
(compound-paragraph (compound-paragraph
(style "fileblock_filecontent" (list* (alt-tag "div") (box-mode* "RfilecontentBox") scheme-properties)) (style "fileblockFilecontent" (list* (alt-tag "div") (box-mode* "RfilecontentBox") (tex-addition mb-tex) scheme-properties))
(decode-flow inside))))) (decode-flow inside)))))
(define (convert-newlines args) (define (convert-newlines args)
@ -36,17 +48,28 @@
(nested (racketerror (racketfont* (convert-newlines args))))) (nested (racketerror (racketfont* (convert-newlines args)))))
(define (foreign-code . args) (define (foreign-code . args)
(compound-paragraph (style "foreign-code" (list (css-style-addition mb-css) (alt-tag "div"))) (list (apply verbatim args)))) (compound-paragraph (style "foreignCode" (list (css-style-addition mb-css)
(alt-tag "div")
(tex-addition mb-tex)))
(list (apply verbatim args))))
(define (terminal . args) (define (terminal . args)
(compound-paragraph (style "terminal" (list (css-style-addition mb-css) (alt-tag "div"))) (list (apply verbatim args)))) (compound-paragraph (style "terminal" (list (css-style-addition mb-css)
(alt-tag "div")
(tex-addition mb-tex)))
(list (apply verbatim args))))
(define (browser . args) (define (browser . args)
(compound-paragraph (style "browser" (list (css-style-addition mb-css) (alt-tag "div"))) (list (paragraph (style #f null) (convert-newlines args))))) (compound-paragraph (style "browser" (list (css-style-addition mb-css)
(alt-tag "div")
(tex-addition mb-tex)))
(list (paragraph (style #f null) (convert-newlines args)))))
(define (noskip-note) (define (noskip-note)
(nested #:style (style "noskip" (list (css-style-addition mb-css) (alt-tag "div"))) (nested #:style (style "noskip" (list (css-style-addition mb-css)
(alt-tag "div")
(tex-addition mb-tex)))
(margin-note "Dont skip this section! It explains an essential Pollen concept."))) (margin-note "Dont skip this section! It explains an essential Pollen concept.")))
@ -58,20 +81,6 @@
(define-runtime-path id name) (define-runtime-path id name)
(image id xs ...)))])) (image id xs ...)))]))
(define-syntax (defoverridable stx)
(syntax-case stx ()
[(_ name predicate? desc ...)
(with-syntax* ([default-name (format-id #'here "default-~a" #'name)]
[value (let ([v (syntax-local-eval #'default-name)])
(cond
[(and (list? v) (andmap symbol? v) (> (length v) 5)) #`'#,'(see below)]
[(or (symbol? v) (list? v)) #`'#,v]
[(procedure? v) '(λ (path) #f)]
[else v]))]
[setup:name (format-id stx "setup:~a" #'name)])
#`(deftogether ((defproc (setup:name) predicate?)
(defthing default-name predicate? #:value value))
desc ...))]))
(define (val . args) (define (val . args)
(racketvalfont (element 'tt (map ~v args)))) (racketvalfont (element 'tt (map ~v args))))

@ -26,7 +26,7 @@
width: 90%; width: 90%;
} }
.fileblock_filetitle{ .fileblockFiletitle{
background: #eee; background: #eee;
text-align:right; text-align:right;
padding: 0.15em; padding: 0.15em;
@ -42,13 +42,13 @@
color: #666; color: #666;
} }
.foreign-code { .foreignCode {
margin-bottom: 1em; margin-bottom: 1em;
padding: 0.5em; padding: 0.5em;
background: #fcfcfc; background: #fcfcfc;
color: #666; color: #666;
} }
.terminal .SIntrapara, .browser .SIntrapara, .foreign-code .SIntrapara { .terminal .SIntrapara, .browser .SIntrapara, .foreignCode .SIntrapara {
margin: 0 0 0 0; margin: 0 0 0 0;
} }

@ -0,0 +1,20 @@
\newcommand{\terminal}[1]{#1}
\newcommand{\browser}[1]{#1}
\newcommand{\foreignCode}[1]{#1}
\newenvironment{fileblock}{}{}
\definecolor{fileboxborder}{gray}{0.5}
\definecolor{fileboxbackground}{gray}{0.9}
\definecolor{noskipbackground}{gray}{0.5}
\definecolor{noskipforeground}{gray}{1}
\newcommand{\fileblockFiletitle}[1]{\fcolorbox{fileboxborder}{fileboxbackground}{\makebox[\textwidth][r]{#1}}}
\newcommand{\fileblockFilename}[1]{#1}
\newenvironment{fileblockFilecontent}{}{}
\newenvironment{noskip}{}{}
% pdflatex chokes on emoji. Use ∇ in place of the guitar in setup.scrbl
\DeclareUnicodeCharacter{1F3B8}{$\nabla$}

@ -1,44 +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}.
@section{Mailing list}
For general tips and how-to questions, use the @link["https://groups.google.com/forum/#!forum/pollenpub"]{Pollen discussion group} at @link["mailto:pollenpub@googlegroups.com"]{pollenpub@"@"googlegroups.com}. I'll also use that list to post major changes and new features.
@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
@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["http://mstill.io"]{mstill.io blog} by Malcolm Still [@link["https://github.com/malcolmstill/mstill.io"]{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["https://www.leafac.com/"]{Leandro Facchinetti's personal website} [@link["https://github.com/leafac/www.leafac.com/tree/pollen"]{source}]

@ -24,7 +24,7 @@ Pagetrees surface throughout the Pollen system. They're primarily used for navig
@section{Making pagetrees with a source file} @section{Making pagetrees with a source file}
A pagetree source file either starts with @code{#lang pollen} and uses the @racketfont{@(format ".~a" default-pagetree-source-ext)} extension, or starts with @code{#lang pollen/ptree} and then can have any file extension. A pagetree source file either starts with @code{#lang pollen} and uses the @racketfont{@(format ".~a" pollen-pagetree-source-ext)} extension, or starts with @code{#lang pollen/ptree} and then can have any file extension.
Unlike other Pollen source files, since the pagetree source is not rendered into an output format, the rest of the filename is up to you. Unlike other Pollen source files, since the pagetree source is not rendered into an output format, the rest of the filename is up to you.
@ -436,7 +436,7 @@ Return the pagenode immediately after @racket[_p]. For @racket[next*], return al
[pagetree-source (or/c pagetree? pathish?)]) [pagetree-source (or/c pagetree? pathish?)])
pagetree? pagetree?
] ]
Get a pagetree from a @ext[default-pagetree-source-ext] source file, namely @racket[_pagetree-source]. If @racket[_pagetree-source] is already a pagetree, just pass it through. Get a pagetree from a @ext[pollen-pagetree-source-ext] source file, namely @racket[_pagetree-source]. If @racket[_pagetree-source] is already a pagetree, just pass it through.
@defproc[ @defproc[

@ -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["programming-pollen.scrbl"]
@include-section["module-reference.scrbl"] @include-section["module-reference.scrbl"]
@include-section["unstable-module-reference.scrbl"] @include-section["unstable-module-reference.scrbl"]
@include-section["more-help.scrbl"]
@include-section["acknowledgments.scrbl"] @include-section["acknowledgments.scrbl"]
@include-section["license.scrbl"] @include-section["license.scrbl"]
@include-section["version-history.scrbl"] @include-section["version-history.scrbl"]

@ -17,6 +17,7 @@ Start a new document. Change the top line to:
The first line of every Pollen source file will start with @code{#lang pollen}. The first line of every Pollen source file will start with @code{#lang pollen}.
@margin-note{If you prefer to use the command line and an editor other than DrRacket, equivalent command-line instructions follow at the end of each section. If you're using DrRacket, you can ignore these.}
@section{Running a source file} @section{Running a source file}
@ -59,6 +60,11 @@ document.write('Hello world');
printf("Hello world"); printf("Hello world");
} }
@bold{Command line}: save the file as @filepath{hello.txt.pp} and then run:
@terminal{
> racket hello.txt.pp
}
@section{Naming, saving, and rendering a source file} @section{Naming, saving, and rendering a source file}
@ -107,7 +113,11 @@ The old @filepath{hello.txt} will be replaced with a new one showing your change
You just saw two ways to view the output of a Pollen source file — first, you ran it in DrRacket. Second, you rendered it to an output file. You just saw two ways to view the output of a Pollen source file — first, you ran it in DrRacket. Second, you rendered it to an output file.
Now here's a third: the Pollen project server. To start the project server, return to your terminal and issue two commands: Now here's a third: the Pollen project server.
@margin-note{The project server is a real web server running on your machine. By default it will respond to requests from any computer. Use the @exec{--local} switch with this command to restrict the project server to responding to requests from localhost. See @secref["raco_pollen_start"].}
To start the project server, return to your terminal and issue two commands:
@terminal{ @terminal{
> cd /directory/containing/your/hello-file > cd /directory/containing/your/hello-file
@ -151,6 +161,12 @@ Paradise Theatre}
Notice what happened — the Pollen project server dynamically regenerated the output file (@filepath{hello.txt}) from the source file (@filepath{hello.txt.pp}) after you edited the source. If you like, try making some more changes to @filepath{hello.txt.pp}, and reloading the browser to see the updates in @filepath{hello.txt}. The project server will regenerate the file whenever it changes. Notice what happened — the Pollen project server dynamically regenerated the output file (@filepath{hello.txt}) from the source file (@filepath{hello.txt.pp}) after you edited the source. If you like, try making some more changes to @filepath{hello.txt.pp}, and reloading the browser to see the updates in @filepath{hello.txt}. The project server will regenerate the file whenever it changes.
@bold{Command line}: to see the changes after each edit, run:
@terminal{
> raco pollen render hello.txt.pp
> cat hello.txt
}
@section{Intermission} @section{Intermission}
@ -208,6 +224,8 @@ In your web browser, reload @link["http://localhost:8080/margin.html"]{@filepath
Still, this is the tiniest tip of the iceberg. The Pollen preprocessor gives you access to everything in the Racket programming language — including string manipulation, math functions, and so on. Still, this is the tiniest tip of the iceberg. The Pollen preprocessor gives you access to everything in the Racket programming language — including string manipulation, math functions, and so on.
@bold{Command line}: type the lozenge using whatever keyboard method you prefer (see @secref["the-lozenge"] for suggestions).
@section{Markdown mode} @section{Markdown mode}
When used as a preprocessor, Pollen's rule is that what you write is what you get. But if you're targeting HTML, who wants to type out all those @code{<tedious>tags</tedious>}? You can make Pollen do the heavy lifting by using an @defterm{authoring mode}. When used as a preprocessor, Pollen's rule is that what you write is what you get. But if you're targeting HTML, who wants to type out all those @code{<tedious>tags</tedious>}? You can make Pollen do the heavy lifting by using an @defterm{authoring mode}.
@ -273,6 +291,13 @@ Pollen is handling three tasks here: interpreting the commands in the source, co
But what if you wanted to use Pollen as a preprocessor that outputs a Markdown file? No problem — just change the source name from @filepath{downtown.html.pmd} to @filepath{downtown.md.pp}. Changing the extension from @filepath{.pmd} to @filepath{.pp} switches Pollen from Markdown mode back to preprocessor mode. And changing the base name from @filepath{downtown.html} to @filepath{downtown.md} updates the name of the output file (and thereby skips the HTML conversion). But what if you wanted to use Pollen as a preprocessor that outputs a Markdown file? No problem — just change the source name from @filepath{downtown.html.pmd} to @filepath{downtown.md.pp}. Changing the extension from @filepath{.pmd} to @filepath{.pp} switches Pollen from Markdown mode back to preprocessor mode. And changing the base name from @filepath{downtown.html} to @filepath{downtown.md} updates the name of the output file (and thereby skips the HTML conversion).
@bold{Command line}: to render the new source file after each edit, run:
@terminal{
> raco pollen render downtown.html.pmd
}
And then view the resulting @filepath{downtown.html} file however you like.
@section{Pollen markup} @section{Pollen markup}
@ -333,6 +358,14 @@ Return to the @link["http://localhost:8080/index.ptree"]{project dashboard} and
Pollen markup takes a little more effort to set up. But it also allows you more flexibility. If you want to do semantic markup, or convert your source into @seclink["fourth-tutorial"]{multiple output formats}, or handle complex page layouts — it's the way to go. (For more, see @seclink["Writing_with_Pollen_markup" Pollen markup takes a little more effort to set up. But it also allows you more flexibility. If you want to do semantic markup, or convert your source into @seclink["fourth-tutorial"]{multiple output formats}, or handle complex page layouts — it's the way to go. (For more, see @seclink["Writing_with_Pollen_markup"
#:doc '(lib "pollen/scribblings/pollen.scrbl")].) #:doc '(lib "pollen/scribblings/pollen.scrbl")].)
@bold{Command line}: to render the new source file after each edit, run:
@terminal{
> raco pollen render uptown.html.pm
}
And then view the resulting @filepath{uptown.html} file however you like.
@section{Templates} @section{Templates}
The HTML pages we just made looked pretty dull. For the last stop on the quick tour, let's fix that. The HTML pages we just made looked pretty dull. For the last stop on the quick tour, let's fix that.
@ -359,6 +392,14 @@ This is a simple HTML file that should look familiar, except for the two templat
Return to your web browser and reload @link["http://localhost:8080/uptown.html"]{@filepath{uptown.html}}. (Or @link["http://localhost:8080/downtown.html"]{@filepath{downtown.html}} — both will work.) The page will be rendered with the new @filepath{template.html}. As before, you can edit the template or the source and the project server will dynamically update the output file. Return to your web browser and reload @link["http://localhost:8080/uptown.html"]{@filepath{uptown.html}}. (Or @link["http://localhost:8080/downtown.html"]{@filepath{downtown.html}} — both will work.) The page will be rendered with the new @filepath{template.html}. As before, you can edit the template or the source and the project server will dynamically update the output file.
@bold{Command line}: to refresh the output after each edit of @filepath{template.html}, run:
@terminal{
> raco pollen render uptown.html.pm downtown.html.pm
}
And then view the resulting @filepath{uptown.html} and @filepath{downtown.html} files however you like.
@section{PS for Scribble users} @section{PS for Scribble users}
Pollen can also be used as a dynamic preview server for Scribble files. From your terminal, do the following: Pollen can also be used as a dynamic preview server for Scribble files. From your terminal, do the following:

@ -49,7 +49,8 @@ Displays a list of available commands.
Start the project server from the current directory using the default port, which is the value of the parameter @racket[current-server-port] (by default, port @id[default-project-server-port]). Start the project server from the current directory using the default port, which is the value of the parameter @racket[current-server-port] (by default, port @id[default-project-server-port]).
This command can be invoked with two optional arguments, and one optional switch.
This command can be invoked with two optional arguments, and two optional switches.
@racket[raco pollen start _path] will start the project server from @racket[_path] rather than the current directory (making @racket[_path] its root directory). @racket[raco pollen start _path] will start the project server from @racket[_path] rather than the current directory (making @racket[_path] its root directory).
@ -67,6 +68,10 @@ If you want to start in the current directory but with a different port, use @li
@terminal{ @terminal{
> raco pollen start . 8088} > raco pollen start . 8088}
@margin-note{Pollen defaults to port @id[default-project-server-port] because it's not commonly used by other network services. But Pollen has no idea what else is running on your machine. If @id[default-project-server-port] is already in use, you'll get an error when you try to start the Pollen project server. In that case, try a different port.}
Adding the optional @exec{-l} or @exec{--launch} switch will open the main project dashboard in your web browser after the project server starts. Adding the optional @exec{-l} or @exec{--launch} switch will open the main project dashboard in your web browser after the project server starts.
Adding the optional @exec{--local} switch will restrict the project server to responding to requests from localhost. (By default, the project server will respond to requests from any client.) Adding the optional @exec{--local} switch will restrict the project server to responding to requests from localhost. (By default, the project server will respond to requests from any client.)
@ -76,6 +81,14 @@ Adding the optional @exec{--local} switch will restrict the project server to re
This command can be invoked two ways: in source mode or directory mode. This command can be invoked two ways: in source mode or directory mode.
In both modes, the optional @exec{--dry-run} or @exec{-d} switch prints the paths that would be rendered by this command without actually doing so.
In both modes, the optional @exec{--force} or @exec{-f} switch forces a fresh render from source, even if the file is already cached, by updating the modification date of the file (à la @exec{touch}). Thus, if modification dates are important to you, don't use this option.
In both modes, the optional @exec{--null} or @exec{-n} switch renders as usual, but doesn't write any files. (Convenient if you're arranging special render behavior, for instance writing to a database or network server.)
@bold{Source mode}: @racket[raco pollen render _source ...] will render only the source paths specified in @racket[_source ...]. Consistent with the usual command-line idiom, this can be a single path, a list of paths, or a pattern: @bold{Source mode}: @racket[raco pollen render _source ...] will render only the source paths specified in @racket[_source ...]. Consistent with the usual command-line idiom, this can be a single path, a list of paths, or a pattern:
@terminal{ @terminal{
@ -89,25 +102,39 @@ Paths can also be specified as output rather than input paths, and the correspon
> raco pollen render foo.html > raco pollen render foo.html
> raco pollen render foo.html bar.html zam.css} > 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{ @terminal{
> raco pollen render -t pdf foo.poly.pm} > raco pollen render -t pdf foo.poly.pm}
See also @seclink["raco-pollen-render-poly"]. See also @seclink["raco-pollen-render-poly"].
The optional @exec{--parallel} or @exec{-p} switch creates a set of parallel rendering jobs. On a multi-core machine, this will usually make your rendering job finish faster. The order of rendering is not guaranteed, of course, so if your project depends on a certain order of rendering, don't use this option. The optional @exec{--parallel} or @exec{-p} switch creates a set of parallel rendering jobs equal to the number of processing cores on the system. On a multi-core machine, this will usually make your rendering job finish faster. The order of rendering is not guaranteed, of course, so if your project depends on a certain order of rendering, don't use this option.
@terminal{
> raco pollen render -p foo.html bar.html zam.css
}
The alternative @exec{--jobs <count>} or @exec{-j <count>} switch does the same thing, but takes one argument that creates @racket[<count>] parallel jobs (which can be more or less than the number of processing cores).
@terminal{ @terminal{
> raco pollen render -p foo.html bar.html zam.css} > raco pollen render -j 4 foo.html bar.html zam.css
}
As a rule of thumb, parallel rendering works best if you do @exec{raco setup} first, which updates Pollen's disk caches:
@italic{Warning}: In all cases, the newly rendered output file will overwrite any previous output file. @terminal{
> raco setup -p
> raco pollen render -p
}
@italic{Warning}: In all cases, the newly rendered output file will overwrite any previous output file.
@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} and @exec{--parallel} switches mentioned above): 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):
The @exec{--subdir} or @exec{-s} switch also renders subdirectories. @racket[current-project-root] remains fixed at the initial directory, just as it would be in the project server after invoking @racket[raco pollen start]. The @exec{--subdir} or @exec{-s} switch also renders subdirectories. @racket[current-project-root] remains fixed at the initial directory, just as it would be in the project server after invoking @racket[raco pollen start].
@ -134,6 +161,7 @@ You can determine the default publishing destination for a project by overriding
Certain files and directories are automatically omitted from the published directory, including Racket and Pollen sources, Pollen caches, and source-control directories (like @tt{.git} and @tt{.svn}). You can omit other files by overriding @racket[default-omitted-path?]. You can override these omissions — that is, force a path to be published — by overriding @racket[default-extra-path?]. Certain files and directories are automatically omitted from the published directory, including Racket and Pollen sources, Pollen caches, and source-control directories (like @tt{.git} and @tt{.svn}). You can omit other files by overriding @racket[default-omitted-path?]. You can override these omissions — that is, force a path to be published — by overriding @racket[default-extra-path?].
The optional @exec{--dry-run} or @exec{-d} switch prints the source and destination directories for publishing without actually doing so. If the destination-directory path cannot be created, an error will arise.
@section{@exec{raco pollen setup}} @section{@exec{raco pollen setup}}
@ -141,6 +169,22 @@ Finds Pollen source files in the current directory, compiles them, and loads the
Can also be invoked as @racket[raco pollen setup _directory], which will set up the files in @racket[_directory]. Can also be invoked as @racket[raco pollen setup _directory], which will set up the files in @racket[_directory].
The optional @exec{--parallel} or @exec{-p} switch creates a set of parallel setup jobs equal to the number of processing cores on the system. On a multi-core machine, this will usually make your setup finish faster.
@terminal{
> raco pollen setup -p
}
The alternative @exec{--jobs <count>} or @exec{-j <count>} switch does the same thing, but takes one argument that creates @racket[<count>] parallel jobs (which can be more or less than the number of processing cores).
@terminal{
> raco pollen setup -j 4
}
@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).}
The optional @exec{--dry-run} or @exec{-d} switch prints the paths that would be compiled by this command without actually doing so.
@section{@exec{raco pollen reset}} @section{@exec{raco pollen reset}}
@ -176,4 +220,37 @@ Result is DEBUG
} }
@section{Logging & the @exec{PLTSTDERR} environment variable}
@margin-note{See @secref["logging" #:doc '(lib "scribblings/reference/reference.scrbl")] for an introduction to Racket's logging system.}
By default, Pollen will log messages at the @racket['info] level or above to the console during any terminal session (e.g., project server or rendering job). So if you start the project server like so:
@terminal{
> raco pollen start
}
You will see log messages starting with:
@terminal{
pollen: starting project server ...
}
And so forth.
You can use Racket's @racket[PLTSTDERR] environment variable to adjust the level of logging. If you provide an explicit log level for Pollen, it will override this default behavior. So if you only want to see messages at the @racket['error] level or above, you would invoke the project server like so:
@terminal|{
> PLTSTDERR=error@pollen raco pollen start
}|
After this, the project server will work normally, but you won't see the usual @racket['info]-level messages, and instead will only see @racket['error] messages or above.
Conversely, if you want more detailed logging, you can invoke the @racket['debug] log level like so:
@terminal|{
> PLTSTDERR=debug@pollen raco pollen start
}|
Then you'll see the usual @racket['info] messages, plus a bunch more.

@ -15,7 +15,7 @@
(render (render
[source-path complete-path?] [source-path complete-path?]
[template-path (or/c #f complete-path?) #f]) [template-path (or/c #f complete-path?) #f])
bytes?] (or/c string? bytes?)]
Renders @racket[_source-path]. The rendering behavior depends on the type of source file (for details, see @secref["File_formats" #:doc '(lib "pollen/scribblings/pollen.scrbl")]): Renders @racket[_source-path]. The rendering behavior depends on the type of source file (for details, see @secref["File_formats" #:doc '(lib "pollen/scribblings/pollen.scrbl")]):
A @racketmodname[pollen/pre] file is rendered without a template. A @racketmodname[pollen/pre] file is rendered without a template.
@ -75,7 +75,7 @@ Note that @racket[_pt-or-pt-source] is used strictly as a list of files to rende
Find a template file for @racket[_source-path], with the following priority: Find a template file for @racket[_source-path], with the following priority:
@itemlist[#:style 'ordered @itemlist[#:style 'ordered
@item{If the @racket[metas] for @racket[_source-path] have a key for @code[(format "~a" default-template-meta-key)], then use the value of this key, e.g. — @item{If the @racket[metas] for @racket[_source-path] have a key for @code[(format "~a" pollen-template-meta-key)], then use the value of this key, e.g. —
@code{◊(define-meta template "my-template.html")} @code{◊(define-meta template "my-template.html")}
@ -88,7 +88,7 @@ If your project has @seclink["fourth-tutorial"]{multiple output targets}, you ca
} }
@item{If this key doesn't exist, or refers to a nonexistent file, look for a default template with the name @code[(format "~a.[output extension]" default-template-prefix)]. Meaning, if @racket[_source-path] is @code[(format "intro.html.~a" default-markup-source-ext)], the output path would be @code["intro.html"], so the default template would be @code[(format "~a.html" default-template-prefix)]. Look for this default template in the same directory as the source file, and then search upwards within successive parent directories. (Corollary: a default template in the project root will apply to all files in the project unless overridden within a subdirectory.)} @item{If this key doesn't exist, or refers to a nonexistent file, look for a default template with the name @code[(format "~a.[output extension]" pollen-template-prefix)]. Meaning, if @racket[_source-path] is @code[(format "intro.html.~a" pollen-markup-source-ext)], the output path would be @code["intro.html"], so the default template would be @code[(format "~a.html" pollen-template-prefix)]. Look for this default template in the same directory as the source file, and then search upwards within successive parent directories. (Corollary: a default template in the project root will apply to all files in the project unless overridden within a subdirectory.)}
@item{If this file doesn't exist, use the fallback template as a last resort. (See @secref["Templates" @item{If this file doesn't exist, use the fallback template as a last resort. (See @secref["Templates"
#:tag-prefixes '("tutorial-2") #:tag-prefixes '("tutorial-2")

@ -1,10 +1,26 @@
#lang scribble/manual #lang scribble/manual
@(require "mb-tools.rkt") @(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)) @(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/setup)) @(my-eval `(require pollen pollen/setup))
@(require (for-syntax racket/base racket/syntax pollen/setup))
@(define-syntax (defoverridable stx)
(syntax-case stx ()
[(_ name predicate? desc ...)
(with-syntax* ([default-name (format-id #'here "default-~a" #'name)]
[value (let ([v (syntax-local-eval #'default-name)])
(cond
[(and (list? v) (andmap symbol? v) (> (length v) 5)) #`'#,'(see below)]
[(or (symbol? v) (list? v)) #`'#,v]
[(procedure? v) '(λ (path) #f)]
[else v]))]
[setup:name (format-id stx "setup:~a" #'name)])
#`(deftogether ((defproc (setup:name) predicate?)
(defthing default-name predicate? #:value value))
desc ...))]))
@title{Setup} @title{Setup}
@defmodule[pollen/setup] @defmodule[pollen/setup]
@ -55,23 +71,6 @@ Every @racket[setup:]@racket[_name] function will resolve the current value of t
Determines the default HTTP port for the project server.} Determines the default HTTP port for the project server.}
@defoverridable[main-export symbol?]{The main X-expression exported from a compiled Pollen source file.}
@defoverridable[meta-export symbol?]{The meta hashtable exported from a compiled Pollen source file.}
@defoverridable[extension-escape-char char?]{Character for escaping output-file extensions within source-file names.}
@deftogether[(
@defoverridable[preproc-source-ext symbol?]
@defoverridable[markup-source-ext symbol?]
@defoverridable[markdown-source-ext symbol?]
@defoverridable[null-source-ext symbol?]
@defoverridable[pagetree-source-ext symbol?]
@defoverridable[template-source-ext symbol?]
@defoverridable[scribble-source-ext symbol?]
)]{File extensions for Pollen source files.}
@defoverridable[main-pagetree string?]{Pagetree that Pollen dashboard loads by default in each directory.} @defoverridable[main-pagetree string?]{Pagetree that Pollen dashboard loads by default in each directory.}
@ -89,8 +88,6 @@ Determines the default HTTP port for the project server.}
@defoverridable[command-char char?]{The magic character that indicates a Pollen command, function, or variable.} @defoverridable[command-char char?]{The magic character that indicates a Pollen command, function, or variable.}
@defoverridable[template-prefix string?]{Prefix of the default template.}
@deftogether[( @deftogether[(
@(defoverridable newline string?) @(defoverridable newline string?)
@ -123,6 +120,13 @@ If the cache can't find a certain file on the watchlist, no error will arise. Th
@history[#:added "1.4"] @history[#:added "1.4"]
} }
@defoverridable[envvar-watchlist (listof string?)]{List of extra environment variables that are used in cache keys. Separate caches will be maintained for each distinct value of an environment variable. @secref["The_POLLEN_environment_variable"] is always used, regardless of how this value is set.
Both the names and the values of environment variables are case-insensitive, so @racket["PUB"] and @racket["pub"] and @racket["pUb"] are all treated the same.
@history[#:added "2.1"]}
@defoverridable[publish-directory (or/c path-string? path-for-some-system?)]{Default target for @secref{raco_pollen_publish}. A complete path is used as is; a relative path is published to the desktop.. @history[#:added "1.1"]} @defoverridable[publish-directory (or/c path-string? path-for-some-system?)]{Default target for @secref{raco_pollen_publish}. A complete path is used as is; a relative path is published to the desktop.. @history[#:added "1.1"]}
@ -140,12 +144,6 @@ If the cache can't find a certain file on the watchlist, no error will arise. Th
@history[#:added "1.1"]} @history[#:added "1.1"]}
@defoverridable[splicing-tag symbol?]{Key used to signal that an X-expression should be spliced into its containing X-expression.}
@defoverridable[poly-source-ext symbol?]{Extension that indicates a source file can target multiple output types.}
@defoverridable[poly-targets (listof symbol?)]{List of symbols that denotes the possible targets of a @racket['poly] source file.} @defoverridable[poly-targets (listof symbol?)]{List of symbols that denotes the possible targets of a @racket['poly] source file.}
@ -155,13 +153,16 @@ If the cache can't find a certain file on the watchlist, no error will arise. Th
@history[#:added "1.5"]} @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[here-path-key 'symbol]{Key used to store the path of the source file in its metas table. No idea why you'd want to change this.} @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} @section{Parameters}
I mean @italic{parameters} in the Racket sense, i.e. values that can be fed to @racket[parameterize]. 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. 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. 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.

@ -32,7 +32,7 @@ As I mentioned in the @secref["big-picture"], Pollen is built using Racket, and
But if not, or if you're just a curious character: But if not, or if you're just a curious character:
One of the key features of Racket as a programming language is that it provides tools to create @italic{other} programming languages. These languages might look & behave @link["http://docs.racket-lang.org/ts-guide/index.html"]{like Racket}. Or they @link["http://hashcollision.org/brainfudge/"]{might not}. These languages might serve a general purpose, but more often they're specialized for a particular purpose, in which case they're known as @italic{domain-specific languages}, or @italic{DSLs}. One of the key features of Racket as a programming language is that it provides tools to create @italic{other} programming languages. These languages might look & behave @link["http://docs.racket-lang.org/ts-guide/index.html"]{like Racket}. Or they @link["http://hashcollision.org/brainfudge/index.html"]{might not}. These languages might serve a general purpose, but more often they're specialized for a particular purpose, in which case they're known as @italic{domain-specific languages}, or @italic{DSLs}.
If you find this a strange idea, you're not alone. Most programmers — and until recently, me too — have never made or used DSLs. If you have a programming problem to solve, you start with a general-purpose language like Python or Java or Ruby, and go from there. Nothing wrong with that. If you find this a strange idea, you're not alone. Most programmers — and until recently, me too — have never made or used DSLs. If you have a programming problem to solve, you start with a general-purpose language like Python or Java or Ruby, and go from there. Nothing wrong with that.

@ -199,11 +199,11 @@ The goal of this whole endeavor was to derive multiple output files from one sou
@seclink["Templates" #:tag-prefixes '("tutorial-2")] should be familiar to you by now. As usual, the name of the template is @tt{template} plus the relevant file extension, so in this case @filepath{template.txt.p}. Add the file as follows: @seclink["Templates" #:tag-prefixes '("tutorial-2")] should be familiar to you by now. As usual, the name of the template is @tt{template} plus the relevant file extension, so in this case @filepath{template.txt.p}. Add the file as follows:
@fileblock["template.txt.p" @codeblock|{ @fileblock["template.txt.p" @codeblock|{
◊(local-require racket/list) ◊(require racket/list)
◊(apply string-append (filter string? (flatten doc))) ◊(apply string-append (filter string? (flatten doc)))
}|] }|]
What we're doing here is converting the X-expression to text in a smarter way. Because we're in a template, we use @racket[local-require] (rather than plain @racket[require]) to bring in @racketmodname[racket/list] so we can use the @racket[flatten] function. What we're doing here is converting the X-expression to text in a smarter way. We use @racket[require] to bring in @racketmodname[racket/list] so we can use the @racket[flatten] function.
To understand what the next line does, just read it from the inside out: ``Take the @racket[doc] export from the source file (which is an X-expression), @racket[flatten] it into a list, @racket[filter] with @racket[string?] (creating a list that's only strings) and @racket[apply] the @racket[string-append] function to these, resulting in one big string.'' Which is exactly what we need for a plain-text file. To understand what the next line does, just read it from the inside out: ``Take the @racket[doc] export from the source file (which is an X-expression), @racket[flatten] it into a list, @racket[filter] with @racket[string?] (creating a list that's only strings) and @racket[apply] the @racket[string-append] function to these, resulting in one big string.'' Which is exactly what we need for a plain-text file.
@ -304,7 +304,7 @@ Then a @filepath{template.ltx.p}:
@fileblock["template.ltx.p" @codeblock|{ @fileblock["template.ltx.p" @codeblock|{
\documentclass[a4paper,12pt]{letter} \documentclass[a4paper,12pt]{letter}
\begin{document} \begin{document}
◊(local-require racket/list) ◊(require racket/list)
◊(apply string-append (filter string? (flatten doc))) ◊(apply string-append (filter string? (flatten doc)))
\end{document} \end{document}
}|] }|]
@ -366,7 +366,7 @@ The template, not as easy:
@fileblock["template.pdf.p" @codeblock|{ @fileblock["template.pdf.p" @codeblock|{
◊(local-require racket/file racket/system) ◊(require racket/file racket/system)
◊(define latex-source ◊string-append{ ◊(define latex-source ◊string-append{
\documentclass[a4paper,12pt]{letter} \documentclass[a4paper,12pt]{letter}
\begin{document} \begin{document}
@ -391,7 +391,7 @@ First, we use @filepath{template.pdf.p} rather than @filepath{template.pdf} for
A quick narrative of the rest: A quick narrative of the rest:
@codeblock|{ @codeblock|{
◊(local-require racket/file racket/system) ◊(require racket/file racket/system)
}| }|
We need @racketmodname[racket/file] for @racket[display-to-file] and @racket[file->bytes]; we need @racketmodname[racket/system] for @racket[system] (to use the command line). We need @racketmodname[racket/file] for @racket[display-to-file] and @racket[file->bytes]; we need @racketmodname[racket/system] for @racket[system] (to use the command line).

@ -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} @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 @itemlist[#:style 'ordered

@ -226,15 +226,22 @@ I am **so** happy to be writing this.
Before you preview this file in the project server, click the @onscreen{Run} button in DrRacket just to see what the file produces. You'll see something like this: Before you preview this file in the project server, click the @onscreen{Run} button in DrRacket just to see what the file produces. You'll see something like this:
@repl-output{'(root (h1 ((id "deep-thought")) "Deep Thought") @repl-output{
(p "I am " (strong "so") " happy to be writing this."))} '(root
  (h1 ((id "deep-thought")) "Deep Thought")
  (p "I am " (strong "so") " happy to be writing this."))
}
You should now be able to recognize this as an X-expression. In authoring mode, Pollen compiles your Markdown into the corresponding HTML entities, but then provides the data as an X-expression rather than finished HTML. You should now be able to recognize this as an X-expression. In authoring mode, Pollen compiles your Markdown into the corresponding HTML entities, but then provides the data as an X-expression rather than finished HTML.
From what you learned in the last section, it should be evident that this X-expression will convert to HTML that looks like this: From what you learned in the last section, it should be evident that this X-expression will convert to HTML that looks like this:
@terminal{<root><h1 id="deep-thought">Deep Thought</h1> @terminal{
<p>I am <strong>so</strong> happy to be writing this.</p></root>} <root>
  <h1 id="deep-thought">Deep Thought</h1>
  <p>I am <strong>so</strong> happy to be writing this.</p>
</root>
}
``But what's this @code{root} tag? That's not HTML.'' An X-expression that holds other X-expressions must have a root tag. So in the spirit of obviousness, every X-expression produced by Pollen in authoring mode will start with @code{root}. If you don't need it, you can discard it (we'll cover this below, in @secref[#:tag-prefixes '("tutorial-2")]{Templates}). Though as you'll learn in the @seclink["third-tutorial"]{third tutorial}, @code{root} also creates a useful hook for further processing — it's not a superfluous accessory. ``But what's this @code{root} tag? That's not HTML.'' An X-expression that holds other X-expressions must have a root tag. So in the spirit of obviousness, every X-expression produced by Pollen in authoring mode will start with @code{root}. If you don't need it, you can discard it (we'll cover this below, in @secref[#:tag-prefixes '("tutorial-2")]{Templates}). Though as you'll learn in the @seclink["third-tutorial"]{third tutorial}, @code{root} also creates a useful hook for further processing — it's not a superfluous accessory.
@ -291,7 +298,7 @@ And two major differences:
@margin-note{``So a template is also a Pollen source file?'' Not quite. More accurately, it's a fragment of Pollen source that is completed by adding the X-expression that comes out of one of your source files. Because of this, there are a few extra limitations on the code you can put in a template, though with easy workarounds (for instance, you can't use @racket[require] in a template, but you can use @racket[local-require], which accomplishes the same thing).} @margin-note{``So a template is also a Pollen source file?'' Not quite. More accurately, it's a fragment of Pollen source that is completed by adding the X-expression that comes out of one of your source files. Because of this, there are a few extra limitations on the code you can put in a template, though with easy workarounds.}
To see how this works, let's return to the source file we started in the last section: To see how this works, let's return to the source file we started in the last section:
@ -364,9 +371,6 @@ Finally, we need to include the X-expression from our source file. By convention
◊(->html (html (head (meta #:charset "UTF-8")) (body doc))) ◊(->html (html (head (meta #:charset "UTF-8")) (body doc)))
} }
@margin-note{You can change the name of @code{doc} by overriding @racket[default-main-export].}
To summarize: this template contains a skeletal HTML page (in X-expression format). We drop @code{doc} into the template to indicate where the X-expression of our source file should be inserted. Finally, we convert the whole X-expression to HTML with @racket[->html]. To summarize: this template contains a skeletal HTML page (in X-expression format). We drop @code{doc} into the template to indicate where the X-expression of our source file should be inserted. Finally, we convert the whole X-expression to HTML with @racket[->html].
``So I have to convert my HTML template to an X-expression?'' No. That's optional. You can also put hard-coded HTML in your template. Here's an equivalent way of writing @filepath{fallback.html.p}, with explicit HTML: ``So I have to convert my HTML template to an X-expression?'' No. That's optional. You can also put hard-coded HTML in your template. Here's an equivalent way of writing @filepath{fallback.html.p}, with explicit HTML:
@ -401,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}: 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" @fileblock["template.html.p"
@codeblock[#:keep-lang-line? #f]{ @codeblock[#:keep-lang-line? #f]{
#lang pollen #lang pollen

@ -195,7 +195,7 @@ Then you have two options for adding attributes. The verbose way corresponds to
Each keyvalue pair is in parentheses, and then the list of pairs is within parentheses, with a @racket[quote] (@litchar{'}) at the front that signals that the text should be used literally. Each keyvalue pair is in parentheses, and then the list of pairs is within parentheses, with a @racket[quote] (@litchar{'}) at the front that signals that the text should be used literally.
But this is boring to type out, so Pollen also allows you to specify attributes with Racket-style @seclink["keyword-args" #:doc '(lib "scribblings/guide/guide.scrbl")]{keyword arguments}: But this is boring to type out, so Pollen also allows you to specify attributes in tag functions with Racket-style @seclink["keyword-args" #:doc '(lib "scribblings/guide/guide.scrbl")]{keyword arguments}:
@fileblock["article.html.pm" @codeblock{ @fileblock["article.html.pm" @codeblock{
#lang pollen #lang pollen
@ -205,6 +205,8 @@ But this is boring to type out, so Pollen also allows you to specify attributes
In this form, each attribute name is prefixed with @litchar{#:}, indicating a keyword argument. As before, the attribute value is in quotation marks following the keyword name. In this form, each attribute name is prefixed with @litchar{#:}, indicating a keyword argument. As before, the attribute value is in quotation marks following the keyword name.
@margin-note{This keyword notation will work by default with any tag. When you're making a custom tag function, use @racket[define-tag-function] (rather than the usual @racket[define]) if you want your tag function to support keyword notation the same way.}
Both of these forms will produce the same X-expression: Both of these forms will produce the same X-expression:
@repl-output{'(span ((class "author")(id "primary")(living "true")) "Prof. Leonard")} @repl-output{'(span ((class "author")(id "primary")(living "true")) "Prof. Leonard")}
@ -513,7 +515,7 @@ This will produce an error in DrRacket:
@errorblock{ @errorblock{
pollen markup error: in '(root "Pi is close to " 3.141592653589793 "." "\n" "The hyperbolic sine of pi is close to " 11.548739357257748 "."), 3.141592653589793 is not a valid element (must be txexpr, string, symbol, XML char, or cdata)} pollen markup error: in '(root "Pi is close to " 3.141592653589793 "." "\n" "The hyperbolic sine of pi is close to " 11.548739357257748 "."), 3.141592653589793 is not a valid element (must be txexpr, string, symbol, XML char, or cdata)}
This code would not, however, produce an error if it were being run as a Pollen preprocessor file, because the prepreocessor automatically converts numbers to strings. If you'd like to verify this, change the suffix to @code{.pp} and run the file again. This code would not, however, produce an error if it were being run as a Pollen preprocessor file, because the preprocessor automatically converts numbers to strings. If you'd like to verify this, change the suffix to @code{.pp} and run the file again.
@subsection[#:tag-prefix "tutorial-3"]{Introducing @filepath{pollen.rkt}} @subsection[#:tag-prefix "tutorial-3"]{Introducing @filepath{pollen.rkt}}

@ -12,7 +12,7 @@ Inconsistent with this system, Pollen's version also appends a build number, whi
@section{Source code} @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. 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,42 @@ Beyond keeping the commit history available, I make no promise to maintain the p
@section{Changelog} @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].
@subsection{Version 3.0}
Changed rendering model to share a namespace between sequential renders, improving speed.
Added @racket[--force] switch to @secref["raco_pollen_render" #:doc '(lib "pollen/scribblings/pollen.scrbl")].
Added @racket[--dry-run] switch to @secref["raco_pollen_publish" #:doc '(lib "pollen/scribblings/pollen.scrbl")].
Downgraded the following @racket[pollen/setup] values from configurable to fixed: @racket[splicing-tag], @racket[preproc-source-ext], @racket[markup-source-ext], @racket[markdown-source-ext], @racket[null-source-ext], @racket[pagetree-source-ext], @racket[template-source-ext], @racket[scribble-source-ext], @racket[poly-source-ext], @racket[cache-dir-name], @racket[cache-subdir-name], @racket[template-prefix], @racket[fallback-template-prefix], @racket[template-meta-key], @racket[main-export], @racket[meta-export], @racket[meta-tag-name], @racket[define-meta-name].
@subsection{Version 2.2}
Added @racket[--null] and @racket[--dry-run] switches to @secref["raco_pollen_render" #:doc '(lib "pollen/scribblings/pollen.scrbl")].
Extended the @racket[define-meta] form to allow multiple keyvalue pairs.
Changed handling of @racket[current-metas] so that values can be updated by tag functions during the evaluation of a source file.
Switched to MIT license.
@subsection{Version 2.1}
Added @racket[setup:envvar-watchlist].
@seclink["raco-pollen" #:doc '(lib "pollen/scribblings/pollen.scrbl")]{@racketfont{raco pollen}}: Introduced support for parallel processing by adding @racket[--parallel] and @racket[--jobs] options to @secref["raco_pollen_setup" #:doc '(lib "pollen/scribblings/pollen.scrbl")] and @secref["raco_pollen_render" #:doc '(lib "pollen/scribblings/pollen.scrbl")].
@subsection{Version 2.0} @subsection{Version 2.0}
Dropped support for Racket versions earlier than 6.3. Dropped support for Racket versions earlier than 6.3.

@ -1,6 +1,9 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base racket/syntax) (require (for-syntax racket/base racket/syntax)
racket/runtime-path) racket/runtime-path
racket/path
"private/constants.rkt")
(provide (all-from-out "private/constants.rkt"))
(define-syntax-rule (define+provide ID EXPR ...) (define-syntax-rule (define+provide ID EXPR ...)
(begin (begin
@ -16,10 +19,13 @@
(let-values ([(dir name dir?) (split-path path)]) (let-values ([(dir name dir?) (split-path path)])
dir)) dir))
(define (get-path-to-override [file-or-dir (current-directory)]) (provide find-nearest-default-directory-require)
(define starting-dir (if (directory-exists? file-or-dir) (define (find-nearest-default-directory-require maybe-dir)
file-or-dir (define starting-dir (cond
(dirname file-or-dir))) [(not maybe-dir) (current-directory)]
[(directory-exists? maybe-dir) maybe-dir]
[else (define dir (dirname maybe-dir))
(and (not (eq? 'relative dir)) (simplify-path (path->complete-path dir (current-directory))))]))
(let loop ([dir starting-dir][path default-directory-require]) (let loop ([dir starting-dir][path default-directory-require])
(and dir ; dir is #f when it hits the top of the filesystem (and dir ; dir is #f when it hits the top of the filesystem
(let ([simplified-path (simplify-path (path->complete-path path starting-dir))]) (let ([simplified-path (simplify-path (path->complete-path path starting-dir))])
@ -40,21 +46,28 @@
#'(begin #'(begin
(provide (prefix-out setup: NAME-THUNKED) DEFAULT-NAME) (provide (prefix-out setup: NAME-THUNKED) DEFAULT-NAME)
(define DEFAULT-NAME DEFAULT-VALUE) (define DEFAULT-NAME DEFAULT-VALUE)
(define NAME-FAIL-THUNKED (λ _ DEFAULT-NAME))
;; can take a dir argument that sets start point for (get-path-to-override) search. ;; can take a dir argument that sets start point for (get-path-to-override) search.
(define NAME-THUNKED (λ get-path-args (define (NAME-THUNKED [dir #false])
(with-handlers ([exn:fail? NAME-FAIL-THUNKED]) ;; exn:fail:contract? is raised if setup submodule doesn't exist
(dynamic-require `(submod ,(apply get-path-to-override get-path-args) WORLD-SUBMOD) 'NAME NAME-FAIL-THUNKED))))))])) ;; 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 (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)
'NAME
(λ () DEFAULT-NAME))))))]))
(define-settable cache-watchlist null)
(define-settable preproc-source-ext 'pp) (define-settable cache-watchlist null)
(define-settable markup-source-ext 'pm) (define-settable envvar-watchlist null)
(define-settable markdown-source-ext 'pmd)
(define-settable null-source-ext 'p)
(define-settable pagetree-source-ext 'ptree)
(define-settable template-source-ext 'pt)
(define-settable scribble-source-ext 'scrbl)
;; these are deliberately not settable because they're just internal signalers, no effect on external interface ;; these are deliberately not settable because they're just internal signalers, no effect on external interface
(define+provide default-mode-auto 'auto) (define+provide default-mode-auto 'auto)
@ -64,31 +77,19 @@
(define+provide default-mode-pagetree 'ptree) (define+provide default-mode-pagetree 'ptree)
(define+provide default-mode-template 'template) (define+provide default-mode-template 'template)
(define-settable old-cache-names '("pollen.cache" "pollen-cache")) (define+provide default-cache-names (cons pollen-cache-dir-name pollen-old-cache-names))
(define-settable cache-dir-name "compiled")
(define-settable cache-subdir-name "pollen")
(define+provide default-cache-names (list* (cache-dir-name) (old-cache-names)))
(define-settable decodable-extensions (list (markup-source-ext) (pagetree-source-ext))) (define-settable decodable-extensions (list pollen-markup-source-ext pollen-pagetree-source-ext))
(define-settable main-pagetree (format "index.~a" (pagetree-source-ext))) (define-settable main-pagetree (format "index.~a" pollen-pagetree-source-ext))
(define-settable pagetree-root-node 'pagetree-root) (define-settable pagetree-root-node 'pagetree-root)
(define-settable main-root-node 'root) (define-settable main-root-node 'root)
(define-settable command-char #\◊) (define-settable command-char #\◊)
(define-settable template-command-char #\∂) (define-settable template-command-char #\∂)
(define-settable template-prefix "template")
(define-settable fallback-template-prefix "fallback")
(define-settable template-meta-key "template")
(define-settable main-export 'doc) ; don't forget to change fallback template too
(define-settable meta-export 'metas)
(define-settable meta-tag-name 'meta)
(define-settable define-meta-name 'define-meta)
;; tags from https://developer.mozilla.org/en-US/docs/Web/HTML/Block-level_elements ;; tags from https://developer.mozilla.org/en-US/docs/Web/HTML/Block-level_elements
(define-settable block-tags (cons (main-root-node) '(address article aside blockquote body canvas dd div dl fieldset figcaption figure footer form h1 h2 h3 h4 h5 h6 header hgroup hr li main nav noscript ol output p pre section table tfoot ul video))) (define-settable block-tags (cons (main-root-node) '(address article aside blockquote body canvas dd div dl dt fieldset figcaption figure footer form h1 h2 h3 h4 h5 h6 header hgroup hr li main nav noscript ol output p pre section table tfoot ul video)))
(define-settable newline "\n") (define-settable newline "\n")
(define-settable linebreak-separator (newline)) (define-settable linebreak-separator (newline))
@ -103,6 +104,11 @@
(define+provide current-render-source (make-parameter #f)) (define+provide current-render-source (make-parameter #f))
;; used to distinguish one-shot rendering (e.g., using `raco pollen setup` or `render`
;; from an interactive session with the project server (using `raco pollen start`)
;; in one-shot mode, certain features needed for dynamic recompilation are disabled for speed.
(define+provide current-session-interactive? (make-parameter #false))
(define-settable dashboard-css "poldash.css") (define-settable dashboard-css "poldash.css")
(define-runtime-path server-extras-dir "private/server-extras") (define-runtime-path server-extras-dir "private/server-extras")
@ -110,8 +116,6 @@
(define-settable publish-directory "publish") (define-settable publish-directory "publish")
(define-settable extension-escape-char #\_)
(define-settable compile-cache-active #t) (define-settable compile-cache-active #t)
(define-settable render-cache-active #t) (define-settable render-cache-active #t)
(define-settable compile-cache-max-size (* 10 1024 1024)) ; = 10 megabytes (define-settable compile-cache-max-size (* 10 1024 1024)) ; = 10 megabytes
@ -124,14 +128,11 @@
(define-settable trim-whitespace? #t) (define-settable trim-whitespace? #t)
(define-settable here-path-key 'here-path)
(define-settable splicing-tag '@)
(define-settable poly-source-ext 'poly) ; extension that signals source can be used for multiple output targets
(define-settable poly-targets '(html)) ; current target applied to multi-output source files (define-settable poly-targets '(html)) ; current target applied to multi-output source files
(define+provide current-poly-target (make-parameter (car (poly-targets)))) (define+provide current-poly-target (make-parameter (car (poly-targets))))
(define-settable index-pages '("index.html")) (define-settable index-pages '("index.html"))
(define-settable allow-unbound-ids? #true) (define-settable allow-unbound-ids? #true)
(define-settable external-renderer #false)

@ -53,7 +53,7 @@
(make-keyword-procedure (make-keyword-procedure
(λ (outer-kws outer-kw-args . ids) (λ (outer-kws outer-kw-args . ids)
(define tag-proc (apply compose1 (for/list ([id (in-list ids)]) (define tag-proc (apply compose1 (for/list ([id (in-list ids)])
(make-one-tag-function outer-kws outer-kw-args id)))) (make-one-tag-function outer-kws outer-kw-args id))))
(define tag-proc-name (string->symbol (format "pollen-tag:~a" (string-join (map symbol->string ids) "+")))) (define tag-proc-name (string->symbol (format "pollen-tag:~a" (string-join (map symbol->string ids) "+"))))
(procedure-rename tag-proc tag-proc-name)))) (procedure-rename tag-proc tag-proc-name))))
@ -78,27 +78,33 @@
(define-syntax (define-tag-function stx) (define-syntax (define-tag-function stx)
(syntax-parse stx (syntax-parse stx
#:literals (λ) #:literals (λ)
[(_ (ID:id ARG:id ...) EXPR:expr ...) [(THIS (ID:id ARG:id ...) EXPR:expr ...)
#'(define-tag-function ID (λ (ARG ...) EXPR ...))] #'(THIS ID (λ (ARG ...) EXPR ...))]
[(_ ID:id (λ (ATTRS:id ELEMS:id ARG:id ...) EXPR:expr ...)) [(_ ID:id (λ (ATTRS:id ELEMS:id ARG:id ...) EXPR:expr ...))
#:fail-when (> (length (syntax->list #'(ARG ...))) 0) "tag function must have exactly 2 positional arguments" #:fail-when (> (length (syntax->list #'(ARG ...))) 0) "tag function must have exactly 2 positional arguments"
#:fail-when (check-duplicate-identifier (list #'ATTRS #'ELEMS)) "duplicate variable name" #:fail-when (check-duplicate-identifier (list #'ATTRS #'ELEMS)) "duplicate variable name"
#:fail-when (null? (syntax->list #'(EXPR ...))) "body of definition cannot be empty" #:fail-when (null? (syntax->list #'(EXPR ...))) "body of definition cannot be empty"
#'(define ID ;; the srcloc of the `lambda` expression determines the srcloc of errors raised within its body
#`(define ID
(make-keyword-procedure (make-keyword-procedure
(λ (kws kwargs . args) #,(syntax/loc #'ID (lambda (kws kwargs . args)
(define tx-proc (keyword-apply default-tag-function kws kwargs (list 'ID))) (let ([elems (match args
(define tx (apply tx-proc args)) [(list* _ elems) elems]
(define-values (_ ATTRS ELEMS) (txexpr->values tx)) [_ #false])])
EXPR ...)))])) (when elems
(unless (and (list? elems) (andmap txexpr-element? elems))
(raise-argument-error 'ID (format "elements need to be passed to tag function as individual trailing arguments (or, if you want to pass them as a single list, use `(apply ~a ···)` here instead of `(~a ···)`)" 'ID 'ID) (car elems)))))
(define tx-proc (keyword-apply default-tag-function kws kwargs (list 'ID)))
(define tx (apply tx-proc args))
(define-values (_ ATTRS ELEMS) (txexpr->values tx))
EXPR ...))))]))
(module+ test (module+ test
(require)
(define foo2 (default-tag-function 'foo)) (define foo2 (default-tag-function 'foo))
(define-tag-function (foo attrs elems) (define-tag-function (foo attrs elems)
`(foo ,(reverse attrs) ,@elems)) `(foo ,(reverse attrs) ,@elems))
(check-txexprs-equal? (foo) (foo2))
(check-txexprs-equal? ◊foo[#:zim "zam"]{hello} ◊foo2[#:zim "zam"]{hello}) (check-txexprs-equal? ◊foo[#:zim "zam"]{hello} ◊foo2[#:zim "zam"]{hello})
(check-txexprs-equal? ◊foo[#:ding "dong" '((zim "zam"))]{hello} ◊foo2[#:ding "dong" '((zim "zam"))]{hello}) (check-txexprs-equal? ◊foo[#:ding "dong" '((zim "zam"))]{hello} ◊foo2[#:ding "dong" '((zim "zam"))]{hello})
(check-txexprs-equal? ◊foo['zim: "zam" #:ding "dong" ]{hello} ◊foo2['zim: "zam" #:ding "dong" ]{hello}) (check-txexprs-equal? ◊foo['zim: "zam" #:ding "dong" ]{hello} ◊foo2['zim: "zam" #:ding "dong" ]{hello})

@ -6,10 +6,8 @@
(define paren-match (cadr matches)) (define paren-match (cadr matches))
paren-match) paren-match)
(define splicing-tag (setup:splicing-tag))
(define (has-outer-splice-tag? x) (define (has-outer-splice-tag? x)
(and (pair? x) (eq? (get-tag x) splicing-tag))) (and (pair? x) (eq? (get-tag x) pollen-splicing-tag)))
(define+provide/contract (->html x-arg-maybe-spliced (define+provide/contract (->html x-arg-maybe-spliced
#:tag [tag #f] #:tag [tag #f]
@ -31,7 +29,7 @@
(define x (if (list? x-arg) (define x (if (list? x-arg)
(splice (if (txexpr? x-arg) (splice (if (txexpr? x-arg)
x-arg x-arg
(cons 'html x-arg)) splicing-tag) ; list of txexpr-elements (cons 'html x-arg)) pollen-splicing-tag) ; list of txexpr-elements
x-arg)) x-arg))
(when (and (not (txexpr? x)) attrs (not tag)) (when (and (not (txexpr? x)) attrs (not tag))

@ -3,5 +3,4 @@
(module setup racket/base (module setup racket/base
(provide (all-defined-out)) (provide (all-defined-out))
(define compile-cache-active #f) (define compile-cache-active #f))
(define extension-escape-char #\$))

@ -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,5 @@
#lang racket/base
(module setup racket/base
(provide poly-targets)
(define poly-targets '(html txt)))

@ -1,2 +1,2 @@
◊(local-require racket/list) ◊(require racket/list)
◊(apply string-append (filter string? (flatten doc))) ◊(apply string-append (filter string? (flatten doc)))

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

@ -1,2 +1,2 @@
◊(local-require racket/list) ◊(require racket/list)
◊(apply string-append (filter string? (flatten doc))) ◊(apply string-append (filter string? (flatten doc)))

@ -3,7 +3,7 @@
;; define-runtime-path only allowed at top level ;; define-runtime-path only allowed at top level
(define-runtime-path test-dir "data/escape-ext") (define-runtime-path test-dir "data/escape-ext")
(define-runtime-path test-file "data/escape-ext/test$html.pp") (define-runtime-path test-file "data/escape-ext/test_html.pp")
(define-runtime-path result-file "data/escape-ext/test.html") (define-runtime-path result-file "data/escape-ext/test.html")
;; `find-exe` avoids reliance on $PATH of the host system ;; `find-exe` avoids reliance on $PATH of the host system

@ -0,0 +1,12 @@
#lang at-exp racket/base
(require rackunit
racket/runtime-path
pollen/file)
(define-runtime-path example "data/ext/example.html")
(define-runtime-path example-pm "data/ext/example.html.pm")
(define-runtime-path another "data/ext/sub/another.html")
(define-runtime-path another-pm "data/ext/sub/another.html.pm")
(check-equal? (get-markup-source example) example-pm)
(check-equal? (get-markup-source another) another-pm)

@ -7,4 +7,18 @@
(provide val)) (provide val))
(require rackunit 'metatest) (require rackunit 'metatest)
(check-equal? val "value") (check-equal? val "value")
;; check that exported metas are a copy of final state of current-metas
(module metatest2 pollen
(define-meta key "value")
(define (tag . xs)
(current-metas (hash-set (current-metas) 'key "reset"))
"")
(tag "hello")
(define val (hash-ref metas 'key))
(provide val))
(require (prefix-in 2: 'metatest2))
(check-equal? val "value")
(check-equal? (hash-ref 2:metas 'key) "reset")

@ -1,44 +0,0 @@
#lang at-exp racket/base
(require rackunit racket/port racket/system racket/runtime-path compiler/find-exe pollen/setup)
;; define-runtime-path only allowed at top level
(define-runtime-path override-dir "data/override")
(define-runtime-path test.ptree "data/override/test.ptree")
(define-runtime-path test.html.pm "data/override/test.html.pm")
(define-runtime-path test.html.pmd "data/override/test.html.pmd")
(define-runtime-path test.html.pp "data/override/test.html.pp")
(define-runtime-path test.ptreeover "data/override/test.ptreeover")
(define-runtime-path test.html.pmover "data/override/test.html.pmover")
(define-runtime-path test.html.pmdover "data/override/test.html.pmdover")
(define-runtime-path test.html.ppover "data/override/test.html.ppover")
(define-runtime-path test-cmd.html.ppover "data/override/test-cmd.html.ppover")
(define-runtime-path test-exports.html.ppover "data/override/test-exports.html.ppover")
(define-runtime-path test-require.html.pmover "data/override/test-require.html.pmover")
;; `find-exe` avoids reliance on $PATH of the host system
(define racket-path (find-exe))
;; parameterize needed to pick up override file
(parameterize ([current-directory override-dir]
[current-project-root override-dir])
(when racket-path
(define (run path)
(define cmd-string (format "'~a' ~a" racket-path path))
(with-output-to-string (λ () (system cmd-string))))
;; raco is in same dir as racket
(define path-to-raco (path->string (simplify-path (build-path (find-exe) 'up "raco"))))
;; files with ordinary extensions will not be recognized in override dir, and thus behave like preproc
(check-equal? (run test.ptree) "test\n====")
(check-equal? (run test.html.pm) "test\n====")
(check-equal? (run test.html.pmd) "test\n====")
(check-equal? (run test.html.pp) "test\n====")
(check-equal? (run test.ptreeover) "'(pagetree-root test ====)")
(check-equal? (run test.html.pmover) "'(rootover \"test\" \"\\n\" \"====\")")
(check-equal? (run test.html.pmdover) "'(rootover (h1 ((id \"test\")) \"test\"))")
(check-equal? (run test.html.ppover) "test\n====")
(check-equal? (run test-cmd.html.ppover) "2")
(check-equal? (dynamic-require test-exports.html.ppover 'docover) "2")
(check-equal? (hash-ref (dynamic-require test-exports.html.ppover 'metasover) 'dog) "Roxy")
(check-equal? (dynamic-require test-require.html.pmover 'docover) '(rootover "foobar"))))

@ -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)

@ -0,0 +1,30 @@
#lang at-exp racket/base
(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")
(define-runtime-path pollen.rkt "data/poly-output-path/pollen.rkt")
(define-runtime-path test.poly.pm "data/poly-output-path/test.poly.pm")
(define-runtime-path test.txt "data/poly-output-path/test.txt")
(define-runtime-path test.html "data/poly-output-path/test.html")
(define-runtime-path pollen-cache "data/poly-output-path/compiled")
(parameterize ([current-output-port (open-output-string)]
[current-directory poly-output-path-dir]
[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-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 (require rackunit
pollen/setup pollen/setup
racket/runtime-path racket/runtime-path
pollen/render) pollen/render
racket/file)
;; define-runtime-path only allowed at top level ;; define-runtime-path only allowed at top level
(define-runtime-path poly-dir "data/poly") (define-runtime-path poly-dir "data/poly")
(define-runtime-path poly-source "data/poly/test.poly.pm") (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] (parameterize ([current-directory poly-dir]
[current-project-root poly-dir] [current-project-root poly-dir]
@ -14,4 +18,20 @@
(parameterize ([current-poly-target 'txt]) (parameterize ([current-poly-target 'txt])
(check-equal? (render poly-source) "TITLE is **big**")) (check-equal? (render poly-source) "TITLE is **big**"))
(parameterize ([current-poly-target 'html]) (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)))

@ -16,7 +16,8 @@
;; test makes sure that file render changes after pollen.rkt changes ;; test makes sure that file render changes after pollen.rkt changes
(parameterize ([current-output-port (open-output-string)] (parameterize ([current-output-port (open-output-string)]
[current-directory rerequire-dir] [current-directory rerequire-dir]
[current-project-root rerequire-dir]) [current-project-root rerequire-dir]
[current-session-interactive? #true])
(display-to-file @string-append{#lang racket/base (display-to-file @string-append{#lang racket/base
(provide id) (provide id)

@ -130,11 +130,18 @@ if zero is False:
(unless (running?) (unless (running?)
(start python-executable line-numbers? css-class)) (start python-executable line-numbers? css-class))
(cond [(running?) (cond [(running?)
;; order of writing arguments is significant: cooperates with pipe.py ;; This works with a simple wrapper around Pygments defined in pipe.py.
(displayln lang pyg-out) ;; First send over the configuration options, then code to highlight.
(displayln (string-join (map number->string hl-lines) " ") pyg-out) ;; pipe.py also supports an encoding option, but seems unnecessary to
;; use at this point.
(fprintf pyg-out "__LANG__ ~a~n" lang)
(fprintf pyg-out "__LINES__ ~a~n" (string-join (map number->string hl-lines) " "))
(fprintf pyg-out "__LINENOS__ ~a~n"
(if line-numbers? "true" "false"))
(displayln code pyg-out) (displayln code pyg-out)
(displayln "__END__" pyg-out) (displayln "__END__" pyg-out)
;; Read back the highlighted code
(let loop ([s ""]) (let loop ([s ""])
(match (read-line pyg-in 'any) (match (read-line pyg-in 'any)
["__END__" (with-input-from-string s read-html-as-xexprs)] ["__END__" (with-input-from-string s read-html-as-xexprs)]

@ -1,13 +1,22 @@
#lang racket/base #lang racket/base
(require racket/list racket/string sugar/define sugar/test txexpr/base racket/match sugar/unstable/container sugar/coerce sugar/unstable/len "../private/whitespace.rkt") (require racket/list
racket/string
sugar/define
sugar/test
txexpr/base
racket/match
sugar/unstable/container
sugar/coerce
sugar/unstable/len
"../private/whitespace.rkt")
(provide whitespace? whitespace/nbsp?) (provide whitespace? whitespace/nbsp?)
(define (make-replacer query+replacement) (define ((make-replacer query+replacement) str)
(let ([queries (map car query+replacement)] (for/fold ([str str])
[replacements (map second query+replacement)]) ([qr (in-list query+replacement)])
;; reverse because first in list should be first applied to str (and compose1 works right-to-left) (match-define (list query replacement) qr)
(apply compose1 (reverse (map (λ (query replacement) (λ (str) (regexp-replace* query str replacement))) queries replacements))))) (regexp-replace* query str replacement)))
(define+provide/contract (smart-dashes str) (define+provide/contract (smart-dashes str)
(string? . -> . string?) (string? . -> . string?)
@ -28,16 +37,25 @@
(define tricky-string "\"Why,\" she could've asked, \"are we in Oahu watching 'Mame'?\"") (define tricky-string "\"Why,\" she could've asked, \"are we in Oahu watching 'Mame'?\"")
(check-equal? (smart-quotes tricky-string) (check-equal? (smart-quotes tricky-string)
"“Why,” she couldve asked, “are we in Oahu watching Mame?”") "“Why,” she couldve asked, “are we in Oahu watching Mame?”")
(check-equal? (smart-quotes "\"what's in it for me?\",")
"“whats in it for me?”,")
(check-equal? (smart-quotes tricky-string (check-equal? (smart-quotes tricky-string
#:apostrophe "zing" #:apostrophe "zing"
#:double-open "«" #:double-close "»" #:double-open "«" #:double-close "»"
#:single-open "" #:single-close "") #:single-open "" #:single-close "")
"«Why,» she couldzingve asked, «are we in Oahu watching Mame") "«Why,» she couldzingve asked, «are we in Oahu watching Mame")
(check-equal? (smart-quotes "\"\'Impossible.\' Yes.\"") "Impossible. Yes.”") (check-equal? (smart-quotes "\"\'Impossible.\' Yes.\"") "Impossible. Yes.”")
(check-equal? (smart-quotes "(\"No.\")") "(“No.”)")
(check-equal? (smart-quotes '(div "don'" (em "t"))) '(div "don" (em "t"))) (check-equal? (smart-quotes '(div "don'" (em "t"))) '(div "don" (em "t")))
(check-equal? (smart-quotes '(div "do '" (em "not'"))) '(div "do " (em "not")))) (check-equal? (smart-quotes '(div "do '" (em "not'"))) '(div "do " (em "not"))))
(define sentence-ender-exceptions (regexp-quote ",.:;?!])}"))
(define (at-beginning-pat str)
(pregexp (format "(?<!\\w)~a(?=\\S)" (regexp-quote str))))
(define (at-end-pat str)
(pregexp (format "(?<=\\S)~a(?!\\w)" (regexp-quote str))))
(define+provide/contract (smart-quotes x (define+provide/contract (smart-quotes x
#:apostrophe [apostrophe-str ""] #:apostrophe [apostrophe-str ""]
#:single-open [single-open-str ""] #:single-open [single-open-str ""]
@ -52,15 +70,18 @@
#:double-close string?) . ->* . (or/c string? txexpr?)) #:double-close string?) . ->* . (or/c string? txexpr?))
(define quotes (define quotes
`((#px"(?<=\\w)'(?=\\w)" ,apostrophe-str) ; apostrophe (list
(#px"(?<!\\w)'(?=\\S)" ,single-open-str) ; single_at_beginning (list #px"(?<=\\w)'(?=\\w)" apostrophe-str) ; apostrophe
(#px"(?<=\\S)'(?!\\w)" ,single-close-str) ; single_at_end (list (pregexp (format "(?<!\\w)'(?=[~a])" sentence-ender-exceptions)) single-close-str) ; sentence ender on outside exceptions
(#px"(?<!\\w)\"(?=\\S)" ,double-open-str) ; double_at_beginning (list (at-beginning-pat "'") single-open-str) ; single_at_beginning
(#px"(?<=\\S)\"(?!\\w)" ,double-close-str))) ; double_at_end (list (at-end-pat "'") single-close-str) ; single_at_end
(list (pregexp (format "(?<!\\w)\"(?=[~a])" sentence-ender-exceptions)) double-close-str) ; sentence ender on outside exceptions
(list (at-beginning-pat "\"") double-open-str) ; double_at_beginning
(list (at-end-pat "\"") double-close-str))) ; double_at_end
(cond (match x
[(string? x) ((make-replacer quotes) x)] [(? string?) ((make-replacer quotes) x)]
[(txexpr? x) [(? txexpr?)
;; convert the quotes as if the txexpr were a flat string, to get proximity right ;; convert the quotes as if the txexpr were a flat string, to get proximity right
;; then replace the actual strings with substrings from this converted result ;; then replace the actual strings with substrings from this converted result
;; todo: handle entities & chars correctly, for now they are ignored ;; todo: handle entities & chars correctly, for now they are ignored
@ -70,16 +91,16 @@
c)) c))
(define offset 0) (define offset 0)
(let loop ([x x]) (let loop ([x x])
(cond (match x
[(txexpr? x) (txexpr (get-tag x) (get-attrs x) (map loop (get-elements x)))] [(? txexpr?) (txexpr (get-tag x) (get-attrs x) (map loop (get-elements x)))]
[(string? x) [(? string?)
(define prev-offset offset) (define prev-offset offset)
(set! offset (+ prev-offset (string-length x))) (set! offset (+ prev-offset (string-length x)))
(list->string (list->string
(for/list ([c (in-vector char-vec prev-offset offset)]) (for/list ([c (in-vector char-vec prev-offset offset)])
c))] c))]
[else x]))] [_ x]))]
[else x])) [_ x]))
; wrap initial quotes for hanging punctuation ; wrap initial quotes for hanging punctuation
; todo: improve this ; todo: improve this
@ -92,23 +113,25 @@
(define two-or-more-char-string? (λ (i) (and (string? i) (>= (string-length i) 2)))) (define two-or-more-char-string? (λ (i) (and (string? i) (>= (string-length i) 2))))
(define-values (tag attr elements) (txexpr->values nx)) (define-values (tag attr elements) (txexpr->values nx))
(make-txexpr tag attr (make-txexpr tag attr
(if (and (list? elements) (not (empty? elements))) (match elements
(let ([new-car-elements (match (car elements) [(cons elem other-elems)
[(? two-or-more-char-string? tcs) (define new-car-elements
(define str-first (get tcs 0)) (match elem
(define str-rest (get tcs 1 (string-length tcs))) [(? two-or-more-char-string? tcs)
(cond (define str-first (get tcs 0))
[(str-first . in? . '("\"" "")) (define str-rest (get tcs 1 (string-length tcs)))
;; can wrap with any inline tag (cond
;; so that linebreak detection etc still works [(str-first . in? . '("\"" ""))
`(,@double-pp ,(->string #\“) ,str-rest)] ;; can wrap with any inline tag
[(str-first . in? . '("\'" "")) ;; so that linebreak detection etc still works
`(,@single-pp ,(->string #\) ,str-rest)] `(,@double-pp ,(->string #\“) ,str-rest)]
[else tcs])] [(str-first . in? . '("\'" ""))
[(? txexpr? nx) (wrap-hanging-quotes nx)] `(,@single-pp ,(->string #\) ,str-rest)]
[else (car elements)])]) [else tcs])]
(cons new-car-elements (cdr elements))) [(? txexpr? nx) (wrap-hanging-quotes nx)]
elements))) [_ elem]))
(cons new-car-elements other-elems)]
[_ elements])))
(module-test-external (module-test-external
(check-equal? (wrap-hanging-quotes '(p "\"Hi\" there")) '(p (dquo "" "Hi\" there"))) (check-equal? (wrap-hanging-quotes '(p "\"Hi\" there")) '(p (dquo "" "Hi\" there")))
@ -129,32 +152,35 @@
(define tags-to-pay-attention-to '(p aside)) ; only apply to paragraphs (define tags-to-pay-attention-to '(p aside)) ; only apply to paragraphs
(define (replace-last-space str) (define (replace-last-space str)
(if (#\space . in? . str) (cond
(let ([reversed-str-list (reverse (string->list str))] [(#\space . in? . str)
[reversed-nbsp (reverse (string->list (->string nbsp)))]) (define reversed-str-list (reverse (string->list str)))
(define-values (last-word-chars other-chars) (define reversed-nbsp (reverse (string->list (->string nbsp))))
(splitf-at reversed-str-list (λ (i) (not (eq? i #\space))))) (define-values (last-word-chars other-chars)
(splitf-at reversed-str-list (λ (i) (not (eq? i #\space)))))
(define front-chars (if (< (len last-word-chars) minimum-word-length) ; OK for long words to be on their own line (define front-chars
; first char of other-chars will be the space, so use cdr (cond
(string-append (list->string (reverse (cdr other-chars))) (->string nbsp)) [(< (len last-word-chars) minimum-word-length) ; OK for long words to be on their own line
(list->string (reverse other-chars)))) ; first char of other-chars will be the space, so use cdr
(define last-word (list->string (reverse last-word-chars))) (string-append (list->string (reverse (cdr other-chars))) (->string nbsp))]
`(,front-chars ,(last-word-proc last-word))) ; don't concatenate last word bc last-word-proc might be a txexpr wrapper [else (list->string (reverse other-chars))]))
(list str))) (define last-word (list->string (reverse last-word-chars)))
`(,front-chars ,(last-word-proc last-word))] ; don't concatenate last word bc last-word-proc might be a txexpr wrapper
[else (list str)]))
(define (find-last-word-space x) ; recursively traverse xexpr (define (find-last-word-space x) ; recursively traverse xexpr
(cond (match x
[(string? x) (replace-last-space x)] ; todo: this assumes a paragraph only has one string in it. [(? string?) (replace-last-space x)] ; todo: this assumes a paragraph only has one string in it.
[(txexpr? x) [(? txexpr?)
(let-values([(tag attr elements) (txexpr->values x)]) (define-values (tag attr elements) (txexpr->values x))
(if (> (length elements) 0) ; elements is list of xexprs (match elements
(let-values ([(all-but-last last) (split-at elements (sub1 (length elements)))]) [(list all-but-last ... last-item) ; elements is list of xexprs
(define result (find-last-word-space (car last))) (define result-items (match (find-last-word-space last-item)
(define result-items (if (txexpr? result) (list result) result)) ; might be txexpr, or list of new elements [(? txexpr? tx) (list tx)]
(make-txexpr tag attr `(,@all-but-last ,@result-items))) [other other])) ; might be txexpr, or list of new elements
x))] (make-txexpr tag attr `(,@all-but-last ,@result-items))]
[else x])) [_ x])]
[_ x]))
(if ((car x) . in? . tags-to-pay-attention-to) (if ((car x) . in? . tags-to-pay-attention-to)
(find-last-word-space x) (find-last-word-space x)

Loading…
Cancel
Save