add support for multiple languages (incl French); remove typed/hyphenate support (for lack of interest)

main
Matthew Butterick 9 years ago
parent f51953c601
commit f379e40e8a

@ -14,10 +14,6 @@ Then require it in your Racket file, in standard mode:
In safe mode (with contracts):
(require (submod hyphenate safe))
Or in typed mode:
(require typed/hyphenate)
And enjoy:

@ -0,0 +1,44 @@
#lang racket/base
(require (for-syntax racket/base syntax/strip-context))
(provide build-main)
(define-syntax (build-main stx)
(syntax-case stx ()
[(_ dir)
(with-syntax ([patterns-path (datum->syntax stx (format "~a/patterns.rkt" (syntax->datum #'dir)))]
[exceptions-path (datum->syntax stx (format "~a/exceptions.rkt" (syntax->datum #'dir)))])
(replace-context stx
#'(begin
(require txexpr sugar/define (only-in xml xexpr/c)
(prefix-in core: hyphenate/core) hyphenate/params patterns-path exceptions-path)
(provide (all-from-out hyphenate/params))
(module+ safe
;; An exception-word is a string of word characters or hyphens.
(define (exception-word? x)
(and (string? x) (regexp-match #px"^[\\w-]+$" x) #t))
(define (exception-words? xs)
(and (list? xs) (andmap exception-word? xs))))
(define+provide+safe hyphenate
((xexpr?) ((or/c char? string?)
#:exceptions exception-words?
#:min-length (or/c integer? #f)
#:omit-word (string? . -> . any/c)
#:omit-string (string? . -> . any/c)
#:omit-txexpr (txexpr? . -> . any/c)
#:min-left-length (or/c (and/c integer? positive?) #f)
#:min-right-length (or/c (and/c integer? positive?) #f)) . ->* . xexpr/c)
(make-keyword-procedure (λ (kws kw-args . rest)
(parameterize ([current-word-cache (make-hash)]
[current-patterns patterns]
[current-exceptions exceptions])
(keyword-apply core:hyphenate kws kw-args rest)))))
(define+provide+safe unhyphenate
((xexpr/c) ((or/c char? string?)
#:omit-word (string? . -> . any/c)
#:omit-string (string? . -> . any/c)
#:omit-txexpr (txexpr? . -> . any/c)) . ->* . xexpr/c)
(make-keyword-procedure (λ (kws kw-args . rest)
(keyword-apply core:unhyphenate kws kw-args rest)))))))]))

@ -0,0 +1,194 @@
#lang racket/base
(require txexpr racket/string racket/list "params.rkt")
(provide hyphenate unhyphenate word->hyphenation-points convert-exception-word string->hashpair)
;; module default values
(define default-min-length 5)
(define default-min-left-length 2)
(define default-min-right-length 2)
(define default-joiner #\u00AD)
(define (cache-word pat)
(hash-set! (current-word-cache) (car pat) (cdr pat)))
;; Convert the hyphenated pattern into a point array for use later.
(define (convert-exception-word exception)
(define (make-key x)
(format ".~a." (string-replace x "-" "")))
(define (make-value x)
`(0 ,@(map (λ(x) (if (equal? x "-") 1 0)) (regexp-split #px"[a-z]" x)) 0))
(list (make-key exception) (make-value exception)))
(define (add-exception-word word)
(current-exceptions (apply hash-set (current-exceptions) (convert-exception-word word))))
(define (string->natural i)
(let* ([result (string->number i)]
[result (and (number? result) (inexact->exact result))]
[result (and (exact-nonnegative-integer? result) result)])
result))
(define (string->hashpair pat)
(define boundary-name ".")
;; first convert the pattern to a list of alternating letters and numbers.
;; insert zeroes where there isn't a number in the pattern.
(define new-pat
(let* ([pat (regexp-match* #rx"." pat)] ; convert to list
[pat (map (λ(i) (or (string->natural i) i)) pat)] ; convert numbers
[pat (if (string? (car pat)) (cons 0 pat) pat)] ; add zeroes to front where needed
[pat (if (string? (car (reverse pat))) (reverse (cons 0 (reverse pat))) pat)]) ; and back
(apply append
(reverse (for/fold([acc null])
([current (in-list pat)][i (in-naturals)])
(if (= i (sub1 (length pat)))
(cons (reverse (list current)) acc)
(let ([next (list-ref pat (add1 i))])
;; insert zeroes where there isn't a number
(cons (reverse (if (and (or (equal? current boundary-name) (string? current)) (string? next))
(list current 0)
(list current))) acc))))))))
;; then slice out the string & numerical parts to be a key / value pair.
(define value (filter exact-nonnegative-integer? new-pat))
(define key (filter string? new-pat))
(list (apply string-append key) value))
(define (make-points word)
;; walk through all the substrings and see if there's a matching pattern.
;; if so, pad it out to full length (so we can (apply map max ...) later on)
(define word-with-dots (format ".~a." (string-downcase word)))
(define matching-patterns
(cond
[(hash-has-key? (current-word-cache) word-with-dots) (list (hash-ref (current-word-cache) word-with-dots))]
[(hash-has-key? (current-exceptions) word-with-dots) (list (hash-ref (current-exceptions) word-with-dots))]
[else
(let ([word-as-list (string->list word-with-dots)])
;; ensures there's at least one (null) element in return value
(define starting-value (make-list (add1 (length word-as-list)) 0))
(reverse (for*/fold ([acc (cons starting-value null)])
([len (in-range (length word-as-list))]
[index (in-range (- (length word-as-list) len))])
(define substring (list->string (take (drop word-as-list index) (add1 len))))
(cond
[(hash-has-key? (current-patterns) substring)
(define value (hash-ref (current-patterns) substring))
;; put together head padding + value + tail padding
(define pattern-to-add (append (make-list index 0) value (make-list (- (add1 (length word-as-list)) (length value) index) 0)))
(cons pattern-to-add acc)]
[else acc]))))]))
(define (apply-map-max xss)
(if (ormap empty? (list xss (car xss)))
empty
(cons (apply max (map car xss))
(apply-map-max (map cdr xss)))))
(define max-value-pattern (apply-map-max matching-patterns))
(cache-word (cons word-with-dots max-value-pattern))
;; for point list,
;; drop first two elements because they represent hyphenation weight
;; before the starting "." and between "." and the first letter.
;; drop last element because it represents hyphen after last "."
;; after you drop these two, then each number corresponds to
;; whether a hyphen goes after that letter.
(drop-right (drop max-value-pattern 2) 1))
;; Find hyphenation points in a word. This is not quite synonymous with syllables.
(define (word->hyphenation-points word
[min-length default-min-length]
[min-left-length default-min-left-length]
[min-right-length default-min-right-length])
#;((string?) ((or/c #f exact-nonnegative-integer?)(or/c #f exact-nonnegative-integer?)(or/c #f exact-nonnegative-integer?)) . ->* . (listof string?))
(define (add-no-hyphen-zone points)
;; points is a list corresponding to the letters of the word.
;; to create a no-hyphenation zone of length n, zero out the first n-1 points
;; and the last n points (because the last value in points is always superfluous)
(let* ([min-left-length (min (or min-left-length default-min-left-length) (length points))]
[min-right-length (min (or min-right-length default-min-right-length) (length points))])
(define points-with-zeroes-on-left
(append (make-list (sub1 min-left-length) 0) (drop points (sub1 min-left-length))))
(define points-with-zeroes-on-left-and-right
(append (drop-right points-with-zeroes-on-left min-right-length) (make-list min-right-length 0)))
points-with-zeroes-on-left-and-right))
(define (make-pieces word)
(define-values (word-pieces last-piece)
(for/fold ([word-pieces empty]
[current-piece empty])
([str (in-list (regexp-match* #rx"." word))] ; explodes word into list of one-character strings (char list is slower)
[point (in-list (add-no-hyphen-zone (make-points word)))])
(define updated-current-piece (cons str current-piece))
(if (even? point)
(values word-pieces updated-current-piece) ; even point denotes character
(values (cons (string-join (reverse updated-current-piece) "") word-pieces) empty)))) ; odd point denotes char + syllable
(reverse (cons (string-join (reverse last-piece) "") word-pieces)))
(if (and min-length (< (string-length word) min-length))
(list word)
(make-pieces word)))
;; joiner contract allows char or string; this coerces to string.
(define (joiner->string joiner)
(format "~a" joiner))
(define (apply-proc proc x [omit-string (λ(x) #f)] [omit-txexpr (λ(x) #f)])
(let loop ([x x])
(cond
[(and (string? x) (not (omit-string x))) (proc x)]
[(and (txexpr? x) (not (omit-txexpr x)))
(make-txexpr (get-tag x) (get-attrs x) (map loop (get-elements x)))]
[else x])))
(require sugar/debug)
(define (hyphenate x [joiner default-joiner]
#:exceptions [extra-exceptions empty]
#:min-length [min-length default-min-length]
#:min-left-length [min-left-length default-min-left-length]
#:min-right-length [min-right-length default-min-right-length]
#:omit-word [omit-word? (λ(x) #f)]
#:omit-string [omit-string? (λ(x) #f)]
#:omit-txexpr [omit-txexpr? (λ(x) #f)])
;; todo?: connect this regexp pattern to the one used in word? predicate
(for-each add-exception-word extra-exceptions)
(define word-pattern #px"\\w+") ;; more restrictive than exception-word
(define (replacer word . words)
(if (not (omit-word? word))
(string-join (word->hyphenation-points word min-length min-left-length min-right-length) (joiner->string joiner))
word))
(define (insert-hyphens text)
(regexp-replace* word-pattern text replacer))
(apply-proc insert-hyphens x omit-string? omit-txexpr?))
(define (unhyphenate x [joiner default-joiner]
#:omit-word [omit-word? (λ(x) #f)]
#:omit-string [omit-string? (λ(x) #f)]
#:omit-txexpr [omit-txexpr? (λ(x) #f)])
(define word-pattern (pregexp (format "[\\w~a]+" joiner)))
(define (replacer word . words)
(if (not (omit-word? word))
(string-replace word (joiner->string joiner) "")
word))
(define (remove-hyphens text)
(regexp-replace* word-pattern text replacer))
(apply-proc remove-hyphens x omit-string? omit-txexpr?))
#;(module+ main
(report (current-word-cache))
(hyphenate "snowman" "-")
(parameterize ([current-word-cache (make-hash)]
[current-exceptions '("snow-man")])
;(reset-patterns)
(report (current-patterns))
(hyphenate "snowman" "-"))
(report (current-word-cache))
(hyphenate "snowman" "-" )
#;(define t "supercalifragilisticexpialidocious")
#;(hyphenate t "-"))

@ -0,0 +1,17 @@
#lang racket/base
(module reader racket/base
(require racket/port syntax/strip-context)
(provide (rename-out [exception-prep-read read]
[exception-prep-read-syntax read-syntax]))
(define (exception-prep-read in)
(syntax->datum (exception-prep-read-syntax #f in)))
(define (exception-prep-read-syntax src in)
(with-syntax ([str (port->string in)])
(strip-context
#'(module exception-prep racket/base
(require racket/string racket/list hyphenate/core)
(provide exceptions)
(define exceptions (apply hash (append-map convert-exception-word (string-split str)))))))))

@ -0,0 +1,4 @@
#lang racket
(require hyphenate/fr rackunit)
(hyphenate "formidable")

@ -0,0 +1,3 @@
#lang racket/base
(require hyphenate/bootstrap)
(build-main fr)

@ -0,0 +1 @@
#lang hyphenate/exception-prep

File diff suppressed because it is too large Load Diff

@ -1,3 +0,0 @@
#lang racket/base
(require sugar/define)
(require-via-wormhole "../typed/hyphenate/core-predicates.rkt")

@ -1,5 +0,0 @@
#lang racket/base
(require sugar/define)
(require-via-wormhole "../typed/hyphenate/exceptions.rkt")
(provide default-exceptions)

@ -1,3 +0,0 @@
#lang info
(define scribblings '(("scribblings/hyphenate.scrbl" ())))
(define compile-omit-paths '("tests.rkt"))

@ -1,3 +0,0 @@
#lang racket/base
(require (for-syntax racket/base sugar/string sugar/coerce racket/syntax))
(require sugar/list txexpr)

@ -1,22 +0,0 @@
#lang racket/base
(require sugar/define txexpr (only-in xml xexpr/c))
(require-via-wormhole "../typed/hyphenate/main.rkt")
(provide+safe
[hyphenate ((xexpr?)
((or/c char? string?)
#:exceptions exception-words?
#:min-length (or/c integer? #f)
#:omit-word (string? . -> . any/c)
#:omit-string (string? . -> . any/c)
#:omit-txexpr (txexpr? . -> . any/c)
#:min-left-length (or/c (and/c integer? positive?) #f)
#:min-right-length (or/c (and/c integer? positive?) #f)) . ->* . xexpr/c)]
[unhyphenate ((xexpr/c)
((or/c char? string?)
#:omit-word (string? . -> . any/c)
#:omit-string (string? . -> . any/c)
#:omit-txexpr (txexpr? . -> . any/c)) . ->* . xexpr/c)]
reset-patterns
[word->hyphenation-points ((string?) ((or/c #f exact-nonnegative-integer?)(or/c #f exact-nonnegative-integer?)(or/c #f exact-nonnegative-integer?)) . ->* . (listof string?))]
[exception-word? (string? . -> . boolean?)])

@ -1,4 +0,0 @@
#lang racket/base
(require sugar/define)
(require-via-wormhole "../typed/hyphenate/patterns-hashed.rkt")
(provide hashed-patterns)

@ -1,3 +0,0 @@
#lang racket/base
(require sugar/define)
(require-via-wormhole "../typed/hyphenate/patterns.rkt")

@ -1,107 +0,0 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax))
(define-syntax (eval-as-untyped stx)
(syntax-case stx ()
[(_ exprs ...)
(with-syntax ([sym (syntax-e (generate-temporary))])
(datum->syntax stx `(begin
(module ,(syntax->datum #'sym) typed/racket/base/no-check
(require rackunit "main.rkt" txexpr)
,@(syntax->datum #'(exprs ...)))
(require ',(syntax->datum #'sym))) stx))]))
(define-syntax (eval-as-untyped-safe stx)
(syntax-case stx ()
[(_ exprs ...)
(with-syntax ([sym (syntax-e (generate-temporary))])
(datum->syntax stx `(begin
(module ,(syntax->datum #'sym) typed/racket/base/no-check
(require rackunit (submod "main.rkt" safe) txexpr)
,@(syntax->datum #'(exprs ...)))
(require ',(syntax->datum #'sym))) stx))]))
(define-syntax (eval-as-typed stx)
(syntax-case stx ()
[(_ exprs ...)
(with-syntax ([sym (syntax-e (generate-temporary))])
(datum->syntax stx `(begin
(module ,(syntax->datum #'sym) typed/racket
(require typed/rackunit "../typed/hyphenate/main.rkt" typed/txexpr)
,@(syntax->datum #'(exprs ...)))
(require ',(syntax->datum #'sym))) stx))]))
(define-syntax-rule (eval-as-typed-and-untyped exprs ...)
(begin
(eval-as-untyped exprs ...)
(eval-as-untyped-safe exprs ...)
(eval-as-typed exprs ...)))
(eval-as-typed-and-untyped
(reset-patterns)
(define omit-em-tag (λ:([x : Txexpr]) (member (car x) '(em))))
(define omit-p-tag (λ:([x : Txexpr]) (member (car x) '(p))))
(define omit-foo-zam-tag (λ:([x : Txexpr]) (member (car x) '(foo zam))))
(define ends-with-s (λ:([x : String]) (regexp-match #rx"s$" x)))
(define omit-script-tag (λ:([x : Txexpr]) (member (car x) '(script))))
(define tx-with-attr (λ:([x : Txexpr]) (with-handlers ([exn:fail? (λ(exn) #f)])
(equal? (attr-ref x 'hyphens) "no-thanks"))))
(check-equal? (hyphenate "edges") "edges") ;; word without matching patterns
(check-equal? (hyphenate "polymorphism") "poly\u00ADmor\u00ADphism")
(check-equal? (hyphenate "POLYmorPHISM") "POLY\u00ADmor\u00ADPHISM")
(check-equal? (hyphenate "polymorphism" #:min-length 100) "polymorphism")
(check-equal? (hyphenate "ugly" #:min-length 1) "ug\u00ADly")
(check-equal? (unhyphenate "poly\u00ADmor\u00ADphism") "polymorphism")
(check-equal? (hyphenate "polymorphism" #\-) "poly-mor-phism")
(check-equal? (hyphenate "polymorphism" "foo") "polyfoomorfoophism")
(check-equal? (unhyphenate "polyfoomorfoophism" "foo") "polymorphism")
(check-equal? (hyphenate "circular polymorphism squandering") "cir\u00ADcu\u00ADlar poly\u00ADmor\u00ADphism squan\u00ADder\u00ADing")
(check-equal? (hyphenate '(p "circular polymorphism" amp (em "squandering"))) '(p "cir\u00ADcu\u00ADlar poly\u00ADmor\u00ADphism" amp (em "squan\u00ADder\u00ADing")))
(check-equal? (hyphenate "present project") "present project") ; exception words
;; test these last so exceptions have been set up already
(check-equal? (word->hyphenation-points "polymorphism") '("poly" "mor" "phism"))
(check-equal? (word->hyphenation-points "present") '("present")) ; exception word
(check-true (exception-word? "Foobar"))
(check-true (exception-word? "foobar"))
(check-false (exception-word? "foobar!"))
(check-true (exception-word? "foo-bar"))
(check-false (exception-word? "foo bar"))
;; omit certain tags
(check-equal? (hyphenate '(p "circular polymorphism" amp (em "squandering")) #:omit-txexpr omit-em-tag)
'(p "cir\u00ADcu\u00ADlar poly\u00ADmor\u00ADphism" amp (em "squandering")))
(check-equal? (hyphenate '(p "circular polymorphism" amp (em "squandering")) #:omit-txexpr omit-p-tag)
'(p "circular polymorphism" amp (em "squandering")))
(check-equal? (hyphenate '(p (foo "circular") (bar "circular") (zam "circular")) #:omit-txexpr omit-foo-zam-tag)
'(p (foo "circular") (bar "cir\u00ADcu\u00ADlar") (zam "circular")))
; omit txexprs with an attribute
(check-equal? (hyphenate '(p (foo ((hyphens "no-thanks")) "circular") (foo "circular"))
#:omit-txexpr tx-with-attr)
'(p (foo ((hyphens "no-thanks")) "circular") (foo "cir\u00ADcu\u00ADlar")))
;; omit strings that end with "s"
(check-equal? (hyphenate '(p (foo "curses tailfeathers") (foo "curses tailfeather")) #:omit-string ends-with-s)
'(p (foo "curses tailfeathers") (foo "curs\u00ADes tail\u00ADfeath\u00ADer")))
;; omit words that end with "s"
(check-equal? (hyphenate '(p (foo "curses tailfeathers") (foo "curses tailfeather")) #:omit-word ends-with-s)
'(p (foo "curses tailfeathers") (foo "curses tail\u00ADfeath\u00ADer")))
(check-equal? (unhyphenate '(p (script "tail-feathers") (em "tail-feathers")) #\- #:omit-txexpr omit-script-tag)
'(p (script "tail-feathers") (em "tailfeathers")))
(check-equal? (unhyphenate '(p "cir-cu-lar poly-mor-phism" "cir-cu-lar poly-mor-phisms") #\- #:omit-string ends-with-s)
'(p "circular polymorphism" "cir-cu-lar poly-mor-phisms"))
(check-equal? (hyphenate "polymorphism" #\- #:min-left-length 5 #:min-right-length 5) "polymor-phism")
(check-equal? (hyphenate "polymorphism" #\- #:min-left-length 3 #:min-right-length 7) "poly-morphism")
(check-equal? (hyphenate "polymorphism" #\- #:min-left-length 7 #:min-right-length 7) "polymorphism")
(check-equal? (hyphenate "polymorphism" #\* #:exceptions '("polymo-rphism")) "polymo*rphism"))

@ -1,5 +1,7 @@
#lang info
(define collection 'multi)
(define deps '("base" "sugar" "txexpr" "typed-racket-lib" "typed-racket-more" "rackunit-lib"))
(define collection "hyphenate")
(define deps '("base" "sugar" "txexpr" "rackunit-lib"))
(define update-implies '("txexpr" "sugar"))
(define build-deps '("scribble-lib" "racket-doc" "typed-racket-doc"))
(define build-deps '("scribble-lib" "racket-doc"))
(define scribblings '(("scribblings/hyphenate.scrbl" ())))
(define compile-omit-paths '("tests.rkt"))

@ -0,0 +1,7 @@
#lang racket
(require "us.rkt")
(provide (all-from-out "us.rkt"))
(module+ safe
(require (submod "us.rkt" safe))
(provide (all-from-out (submod "us.rkt" safe))))

@ -0,0 +1,6 @@
#lang racket/base
(provide (all-defined-out))
(define current-patterns (make-parameter (make-hash)))
(define current-exceptions (make-parameter (make-hash)))
(define current-word-cache (make-parameter (make-hash)))

@ -0,0 +1,17 @@
#lang racket/base
(module reader racket/base
(require racket/port syntax/strip-context)
(provide (rename-out [pattern-prep-read read]
[pattern-prep-read-syntax read-syntax]))
(define (pattern-prep-read in)
(syntax->datum (pattern-prep-read-syntax #f in)))
(define (pattern-prep-read-syntax src in)
(with-syntax ([str (port->string in)])
(strip-context
#'(module pattern-prep racket/base
(require hyphenate/core racket/list racket/string)
(provide patterns)
(define patterns (apply hash (append-map string->hashpair (string-split str)))))))))

File diff suppressed because one or more lines are too long

@ -11,14 +11,10 @@
@author[(author+email "Matthew Butterick" "mb@mbtype.com")]
@defmodule[#:multi (hyphenate (submod hyphenate safe) typed/hyphenate)]
@defmodule[#:multi (hyphenate (submod hyphenate safe))]
A simple hyphenation engine that uses the KnuthLiang hyphenation algorithm originally developed for TeX. I have added little to their work. Accordingly, I take little credit.
I originally put together this module to handle hyphenation for my web-based book @link["http://practicaltypography.com"]{Butterick's Practical Typography} (which I made with Racket & Scribble). Though support for CSS-based hyphenation in web browsers is @link["http://caniuse.com/#search=hyphen"]{still iffy}, soft hyphens work reliably well. But putting them into the text manually is a drag. Thus a module was born.
I thank Benjamin Greenman and Alexander Knauth for helpful suggestions on the typed version.
@section{Installation}
At the command line:
@ -29,17 +25,12 @@ After that, you can update the package like so:
@section{Importing the module}
The module can be invoked three ways: fast, safe, and typed.
The module can be invoked two ways: fast or safe.
Fast mode is the default, which you get by importing the module in the usual way: @code{(require hyphenate)}.
Safe mode enables the function contracts documented below. Use safe mode by importing the module as @code{(require (submod hyphenate safe))}.
The typed version is invoked as @code{(require typed/hyphenate)}. The typed version is implemented ``natively'' in the sense that it is compiled separately with type annotations. It is not a @racket[require/typed] wrapper around the untyped code. This avoids the contract barrier that is otherwise automatically imposed between typed and untyped code.
@margin-note{I explain more about this cross-compiling technique in @link["http://unitscale.com/mb/technique/dual-typed-untyped-library.html"]{Making a dual typed / untyped Racket library}.}
@section{Interface}
@defproc[
@ -203,6 +194,33 @@ Keep in mind that soft hyphens could appear in your input string. Certain word p
]
@section{French}
@defmodule[#:multi (hyphenate/fr (submod hyphenate/fr safe))]
French hyphenation is available by importing the module as @racketmodname[hyphenate/fr] or @racketmodname[(submod hyphenate/fr safe)] and using the @racket[hyphenate] function normally. Below, notice that the word ``formidable'' hyphenates differently in French.
@examples[#:eval my-eval
(hyphenate "formidable" #\-)
(module fr racket/base
(require hyphenate/fr)
(hyphenate "formidable" #\-))
(require 'fr)
]
The two languages are in separate submodules for performance reasons. That way, they can maintain separate caches of hyphenated words.
There is no way to use @racket[hyphenate] in ``polyglot'' mode, where English and French are detected automatically. It is possible, however, to mix both the English and French @racket[hyphenate] functions in a single file, and apply them as needed. To avoid a name conflict between the two @racket[hyphenate] functions, you'll need to use @racket[prefix-in]:
@examples[#:eval my-eval
(require (prefix-in fr: hyphenate/fr))
(hyphenate "formidable" #\-)
(fr:hyphenate "formidable" #\-)
]
@section{License & source code}
This module is licensed under the LGPL.

File diff suppressed because one or more lines are too long

@ -0,0 +1,319 @@
/* See the beginning of "manual.css". */
/* Monospace: */
.RktIn, .RktRdr, .RktPn, .RktMeta,
.RktMod, .RktKw, .RktVar, .RktSym,
.RktRes, .RktOut, .RktCmt, .RktVal,
.RktBlk, .RktErr {
font-family: 'Source Code Pro', monospace;
white-space: inherit;
font-size: 1rem;
}
/* this selctor grabs the first linked Racket symbol
in a definition box (i.e., the symbol being defined) */
a.RktValDef, a.RktStxDef, a.RktSymDef,
span.RktValDef, span.RktStxDef, span.RktSymDef
{
font-size: 1.15rem;
color: black;
font-weight: 600;
}
.inheritedlbl {
font-family: 'Fira', sans;
}
.RBackgroundLabelInner {
font-family: inherit;
}
/* ---------------------------------------- */
/* Inherited methods, left margin */
.inherited {
width: 95%;
margin-top: 0.5em;
text-align: left;
background-color: inherit;
}
.inherited td {
font-size: 82%;
padding-left: 0.5rem;
line-height: 1.3;
text-indent: 0;
padding-right: 0;
}
.inheritedlbl {
font-style: normal;
}
/* ---------------------------------------- */
/* Racket text styles */
.RktIn {
color: #cc6633;
background-color: #eee;
}
.RktInBG {
background-color: #eee;
}
.refcolumn .RktInBG {
background-color: white;
}
.RktRdr {
}
.RktPn {
color: #843c24;
}
.RktMeta {
color: black;
}
.RktMod {
color: inherit;
}
.RktOpt {
color: black;
}
.RktKw {
color: black;
}
.RktErr {
color: red;
font-style: italic;
font-weight: 400;
}
.RktVar {
position: relative;
left: -1px; font-style: italic;
color: #444;
}
.SVInsetFlow .RktVar {
font-weight: 400;
color: #444;
}
.RktSym {
color: inherit;
}
.RktValLink, .RktStxLink, .RktModLink {
text-decoration: none;
color: #07A;
font-weight: 500;
font-size: 1rem;
}
/* for syntax links within headings */
h2 a.RktStxLink, h3 a.RktStxLink, h4 a.RktStxLink, h5 a.RktStxLink,
h2 a.RktValLink, h3 a.RktValLink, h4 a.RktValLink, h5 a.RktValLink,
h2 .RktSym, h3 .RktSym, h4 .RktSym, h5 .RktSym,
h2 .RktMod, h3 .RktMod, h4 .RktMod, h5 .RktMod,
h2 .RktVal, h3 .RktVal, h4 .RktVal, h5 .RktVal,
h2 .RktPn, h3 .RktPn, h4 .RktPn, h5 .RktPn {
color: #333;
font-size: 1.65rem;
font-weight: 400;
}
.toptoclink .RktStxLink, .toclink .RktStxLink,
.toptoclink .RktValLink, .toclink .RktValLink,
.toptoclink .RktModLink, .toclink .RktModLink {
color: inherit;
}
.tocset .RktValLink, .tocset .RktStxLink, .tocset .RktModLink {
color: black;
font-weight: 400;
font-size: 0.9rem;
}
.tocset td a.tocviewselflink .RktValLink,
.tocset td a.tocviewselflink .RktStxLink,
.tocset td a.tocviewselflink .RktMod,
.tocset td a.tocviewselflink .RktSym {
font-weight: lighter;
color: white;
}
.RktRes {
color: #0000af;
}
.RktOut {
color: #960096;
}
.RktCmt {
color: #c2741f;
}
.RktVal {
color: #228b22;
}
/* ---------------------------------------- */
/* Some inline styles */
.together { /* for definitions grouped together in one box */
width: 100%;
border-top: 2px solid white;
}
tbody > tr:first-child > td > .together {
border-top: 0px; /* erase border on first instance of together */
}
.RktBlk {
white-space: pre;
text-align: left;
}
.highlighted {
font-size: 1rem;
background-color: #fee;
}
.defmodule {
font-family: 'Source Code Pro';
padding: 0.25rem 0.75rem 0.25rem 0.5rem;
margin-bottom: 1rem;
width: 100%;
background-color: hsl(60, 29%, 94%);
}
.defmodule a {
color: #444;
}
.defmodule td span.hspace:first-child {
position: absolute;
width: 0;
display: inline-block;
}
.defmodule .RpackageSpec .Smaller,
.defmodule .RpackageSpec .stt {
font-size: 1rem;
}
.specgrammar {
float: none;
padding-left: 1em;
}
.RBibliography td {
vertical-align: text-top;
padding-top: 1em;
}
.leftindent {
margin-left: 2rem;
margin-right: 0em;
}
.insetpara {
margin-left: 1em;
margin-right: 1em;
}
.SCodeFlow .Rfilebox {
margin-left: -1em; /* see 17.2 of guide, module languages */
}
.Rfiletitle {
text-align: right;
background-color: #eee;
}
.SCodeFlow .Rfiletitle {
border-top: 1px dotted gray;
border-right: 1px dotted gray;
}
.Rfilename {
border-top: 0;
border-right: 0;
padding-left: 0.5em;
padding-right: 0.5em;
background-color: inherit;
}
.Rfilecontent {
margin: 0.5em;
}
.RpackageSpec {
padding-right: 0;
}
/* ---------------------------------------- */
/* For background labels */
.RBackgroundLabel {
float: right;
width: 0px;
height: 0px;
}
.RBackgroundLabelInner {
position: relative;
width: 25em;
left: -25.5em;
top: 0.20rem; /* sensitive to monospaced font choice */
text-align: right;
z-index: 0;
font-weight: 300;
font-family: 'Source Code Pro';
font-size: 0.9rem;
color: gray;
}
.RpackageSpec .Smaller {
font-weight: 300;
font-family: 'Source Code Pro';
font-size: 0.9rem;
}
.RForeground {
position: relative;
left: 0px;
top: 0px;
z-index: 1;
}
/* ---------------------------------------- */
/* For section source modules & tags */
.RPartExplain {
background: #eee;
font-size: 0.9rem;
margin-top: 0.2rem;
padding: 0.2rem;
text-align: left;
}

@ -0,0 +1,98 @@
/* For the Racket manual style */
AddOnLoad(function() {
/* Look for header elements that have x-source-module and x-part tag.
For those elements, add a hidden element that explains how to
link to the section, and set the element's onclick() to display
the explanation. */
var tag_names = ["h1", "h2", "h3", "h4", "h5"];
for (var j = 0; j < tag_names.length; j++) {
elems = document.getElementsByTagName(tag_names[j]);
for (var i = 0; i < elems.length; i++) {
var elem = elems.item(i);
AddPartTitleOnClick(elem);
}
}
})
function AddPartTitleOnClick(elem) {
var mod_path = elem.getAttribute("x-source-module");
var tag = elem.getAttribute("x-part-tag");
if (mod_path && tag) {
// Might not be present:
var prefixes = elem.getAttribute("x-part-prefixes");
var info = document.createElement("div");
info.className = "RPartExplain";
/* The "top" tag refers to a whole document: */
var is_top = (tag == "\"top\"");
info.appendChild(document.createTextNode("Link to this "
+ (is_top ? "document" : "section")
+ " with "));
/* Break `secref` into two lines if the module path and tag
are long enough: */
var is_long = (is_top ? false : ((mod_path.length
+ tag.length
+ (prefixes ? (16 + prefixes.length) : 0))
> 60));
var line1 = document.createElement("div");
var line1x = ((is_long && prefixes) ? document.createElement("div") : line1);
var line2 = (is_long ? document.createElement("div") : line1);
function add(dest, str, cn) {
var s = document.createElement("span");
s.className = cn;
s.style.whiteSpace = "nowrap";
s.appendChild(document.createTextNode(str));
dest.appendChild(s);
}
/* Construct a `secref` call with suitable syntax coloring: */
add(line1, "\xA0@", "RktRdr");
add(line1, (is_top ? "other-doc" : "secref"), "RktSym");
add(line1, "[", "RktPn");
if (!is_top)
add(line1, tag, "RktVal");
if (is_long) {
/* indent additional lines: */
if (prefixes)
add(line1x, "\xA0\xA0\xA0\xA0\xA0\xA0\xA0\xA0", "RktPn");
add(line2, "\xA0\xA0\xA0\xA0\xA0\xA0\xA0\xA0", "RktPn");
}
if (prefixes) {
add(line1x, " #:tag-prefixes ", "RktPn");
add(line1x, "'", "RktVal");
add(line1x, prefixes, "RktVal");
}
if (!is_top)
add(line2, " #:doc ", "RktPn");
add(line2, "'", "RktVal");
add(line2, mod_path, "RktVal");
add(line2, "]", "RktPn");
info.appendChild(line1);
if (is_long)
info.appendChild(line1x);
if (is_long)
info.appendChild(line2);
info.style.display = "none";
/* Add the new element afterthe header: */
var n = elem.nextSibling;
if (n)
elem.parentNode.insertBefore(info, n);
else
elem.parentNode.appendChild(info);
/* Clicking the header shows the explanation element: */
elem.onclick = function () {
if (info.style.display == "none")
info.style.display = "block";
else
info.style.display = "none";
}
}
}

@ -0,0 +1,743 @@
/* See the beginning of "scribble.css".
This file is used by the `scribble/manual` language, along with
"manual-racket.css". */
@import url("manual-fonts.css");
* {
margin: 0;
padding: 0;
}
@media all {html {font-size: 15px;}}
@media all and (max-width:940px){html {font-size: 14px;}}
@media all and (max-width:850px){html {font-size: 13px;}}
@media all and (max-width:830px){html {font-size: 12px;}}
@media all and (max-width:740px){html {font-size: 11px;}}
/* CSS seems backward: List all the classes for which we want a
particular font, so that the font can be changed in one place. (It
would be nicer to reference a font definition from all the places
that we want it.)
As you read the rest of the file, remember to double-check here to
see if any font is set. */
/* Monospace: */
.maincolumn, .refpara, .refelem, .tocset, .stt, .hspace, .refparaleft, .refelemleft {
font-family: 'Source Code Pro', monospace;
white-space: inherit;
font-size: 1rem;
}
.stt {
font-weight: 500;
}
h2 .stt {
font-size: 2.7rem;
}
.toptoclink .stt {
font-size: inherit;
}
.toclink .stt {
font-size: 90%;
}
.RpackageSpec .stt {
font-weight: 300;
font-family: 'Source Code Pro';
font-size: 0.9rem;
}
h3 .stt, h4 .stt, h5 .stt {
color: #333;
font-size: 1.65rem;
font-weight: 400;
}
/* Serif: */
.main, .refcontent, .tocview, .tocsub, .sroman, i {
font-family: 'Charter', serif;
font-size: 1.18rem;
}
/* Sans-serif: */
.version, .versionNoNav, .ssansserif {
font-family: 'Fira', sans-serif;
}
.ssansserif {
font-family: 'Fira';
font-weight: 500;
font-size: 0.9em;
}
.tocset .ssansserif {
font-size: 100%;
}
/* ---------------------------------------- */
p, .SIntrapara {
display: block;
margin: 0 0 1em 0;
line-height: 1.4;
}
.compact {
padding: 0 0 1em 0;
}
li {
list-style-position: outside;
margin-left: 1.2em;
}
h1, h2, h3, h4, h5, h6, h7, h8 {
font-family: 'Fira';
font-weight: 300;
font-size: 1.6rem;
color: #333;
margin-top: inherit;
margin-bottom: 1rem;
line-height: 1.25;
-moz-font-feature-settings: 'tnum=1';
-moz-font-feature-settings: 'tnum' 1;
-webkit-font-feature-settings: 'tnum' 1;
-o-font-feature-settings: 'tnum' 1;
-ms-font-feature-settings: 'tnum' 1;
font-feature-settings: 'tnum' 1;
}
h3, h4, h5, h6, h7, h8 {
border-top: 1px solid black;
}
h2 { /* per-page main title */
font-family: 'Miso';
font-weight: bold;
margin-top: 4rem;
font-size: 3rem;
line-height: 1.1;
width: 90%;
}
h3, h4, h5, h6, h7, h8 {
margin-top: 2em;
padding-top: 0.1em;
margin-bottom: 0.75em;
}
/* ---------------------------------------- */
/* Main */
body {
color: black;
background-color: white;
}
.maincolumn {
width: auto;
margin-top: 4rem;
margin-left: 17rem;
margin-right: 2rem;
margin-bottom: 10rem; /* to avoid fixed bottom nav bar */
max-width: 700px;
min-width: 370px; /* below this size, code samples don't fit */
}
a {
text-decoration: inherit;
}
a, .toclink, .toptoclink, .tocviewlink, .tocviewselflink, .tocviewtoggle, .plainlink,
.techinside, .techoutside:hover, .techinside:hover {
color: #07A;
}
a:hover {
text-decoration: underline;
}
/* ---------------------------------------- */
/* Navigation */
.navsettop, .navsetbottom {
left: 0;
width: 15rem;
height: 6rem;
font-family: 'Fira';
font-size: 0.9rem;
border-bottom: 0px solid hsl(216, 15%, 70%);
background-color: inherit;
padding: 0;
}
.navsettop {
position: absolute;
top: 0;
left: 0;
margin-bottom: 0;
border-bottom: 0;
}
.navsettop a, .navsetbottom a {
color: black;
}
.navsettop a:hover, .navsetbottom a:hover {
background: hsl(216, 78%, 95%);
text-decoration: none;
}
.navleft, .navright {
position: static;
float: none;
margin: 0;
white-space: normal;
}
.navleft a {
display: inline-block;
}
.navright a {
display: inline-block;
text-align: center;
}
.navleft a, .navright a, .navright span {
display: inline-block;
padding: 0.5rem;
min-width: 1rem;
}
.navright {
height: 2rem;
white-space: nowrap;
}
.navsetbottom {
display: none;
}
.nonavigation {
color: #889;
}
.searchform {
display: block;
margin: 0;
padding: 0;
border-bottom: 1px solid #eee;
height: 4rem;
}
.nosearchform {
margin: 0;
padding: 0;
height: 4rem;
}
.searchbox {
font-size: 1rem;
width: 12rem;
margin: 1rem;
padding: 0.25rem;
vertical-align: middle;
background-color: white;
}
#search_box {
font-size: 0.8rem;
}
/* ---------------------------------------- */
/* Version */
.versionbox {
position: absolute;
float: none;
top: 0.25rem;
left: 17rem;
z-index: 11000;
height: 2em;
font-size: 70%;
font-weight: lighter;
width: inherit;
margin: 0;
}
.version, .versionNoNav {
font-size: inherit;
}
.version:before, .versionNoNav:before {
content: "v.";
}
/* ---------------------------------------- */
/* Margin notes */
/* cancel scribble.css styles: */
.refpara, .refelem {
position: static;
float: none;
height: auto;
width: auto;
margin: 0;
}
.refcolumn {
position: static;
display: block;
width: auto;
font-size: inherit;
margin: 2rem;
margin-left: 2rem;
padding: 0.5em;
padding-left: 0.75em;
padding-right: 1em;
background: hsl(60, 29%, 94%);
border: 1px solid #ccb;
border-left: 0.4rem solid #ccb;
}
/* slightly different handling for margin-note* on narrow screens */
@media all and (max-width:1260px) {
span.refcolumn {
float: right;
width: 50%;
margin-left: 1rem;
margin-bottom: 0.8rem;
margin-top: 1.2rem;
}
}
.refcontent, .refcontent p {
line-height: 1.5;
margin: 0;
}
.refcontent p + p {
margin-top: 1em;
}
.refcontent a {
font-weight: 400;
}
.refpara, .refparaleft {
top: -1em;
}
@media all and (max-width:600px) {
.refcolumn {
margin-left: 0;
margin-right: 0;
}
}
@media all and (min-width:1260px) {
.refcolumn {
position: absolute;
left: 66rem; right: 3em;
margin: 0;
float: right;
max-width: 18rem;
}
}
.refcontent {
font-family: 'Fira';
font-size: 1rem;
line-height: 1.6;
margin: 0 0 0 0;
}
.refparaleft, .refelemleft {
position: relative;
float: left;
right: 2em;
height: 0em;
width: 13em;
margin: 0em 0em 0em -13em;
}
.refcolumnleft {
background-color: hsl(60, 29%, 94%);
display: block;
position: relative;
width: 13em;
font-size: 85%;
border: 0.5em solid hsl(60, 29%, 94%);
margin: 0 0 0 0;
}
/* ---------------------------------------- */
/* Table of contents, left margin */
.tocset {
position: absolute;
float: none;
left: 0;
top: 0rem;
width: 14rem;
padding: 7rem 0.5rem 0.5rem 0.5rem;
background-color: hsl(216, 15%, 70%);
margin: 0;
}
.tocset td {
vertical-align: text-top;
padding-bottom: 0.4rem;
padding-left: 0.2rem;
line-height: 1.1;
font-family: 'Fira';
-moz-font-feature-settings: 'tnum=1';
-moz-font-feature-settings: 'tnum' 1;
-webkit-font-feature-settings: 'tnum' 1;
-o-font-feature-settings: 'tnum' 1;
-ms-font-feature-settings: 'tnum' 1;
font-feature-settings: 'tnum' 1;
}
.tocset td a {
color: black;
font-weight: 400;
}
.tocview {
text-align: left;
background-color: inherit;
}
.tocview td, .tocsub td {
line-height: 1.3;
}
.tocview table, .tocsub table {
width: 90%;
}
.tocset td a.tocviewselflink {
font-weight: lighter;
font-size: 110%; /* monospaced styles below don't need to enlarge */
color: white;
}
.tocviewselflink {
text-decoration: none;
}
.tocsub {
text-align: left;
margin-top: 0.5em;
background-color: inherit;
}
.tocviewlist, .tocsublist {
margin-left: 0.2em;
margin-right: 0.2em;
padding-top: 0.2em;
padding-bottom: 0.2em;
}
.tocviewlist table {
font-size: 82%;
}
.tocviewlisttopspace {
margin-bottom: 1em;
}
.tocviewsublist, .tocviewsublistonly, .tocviewsublisttop, .tocviewsublistbottom {
margin-left: 0.4em;
border-left: 1px solid #99a;
padding-left: 0.8em;
}
.tocviewsublist {
margin-bottom: 1em;
}
.tocviewsublist table,
.tocviewsublistonly table,
.tocviewsublisttop table,
.tocviewsublistbottom table,
table.tocsublist {
font-size: 1rem;
}
.tocviewsublist td, .tocviewsublistbottom td, .tocviewsublisttop td, .tocsub td,
.tocviewsublistonly td {
font-size: 90%;
}
.tocviewtoggle {
font-size: 75%; /* looks better, and avoids bounce when toggling sub-sections due to font alignments */
}
.tocsublist td {
padding-left: 0.5rem;
padding-top: 0.25rem;
text-indent: 0;
}
.tocsublinknumber {
font-size: 100%;
}
.tocsublink {
font-size: 82%;
text-decoration: none;
}
.tocsubseclink {
font-size: 100%;
text-decoration: none;
}
.tocsubnonseclink {
font-size: 82%;
text-decoration: none;
margin-left: 1rem;
padding-left: 0;
display: inline-block;
}
/* the label "on this page" */
.tocsubtitle {
display: block;
font-size: 62%;
font-family: 'Fira';
font-weight: bolder;
font-style: normal;
letter-spacing: 2px;
text-transform: uppercase;
margin: 0.5em;
}
.toptoclink {
font-weight: bold;
font-size: 110%;
margin-bottom: 0.5rem;
margin-top: 1.5rem;
display: inline-block;
}
.toclink {
font-size: inherit;
}
/* ---------------------------------------- */
/* Some inline styles */
.indexlink {
text-decoration: none;
}
pre {
margin-left: 2em;
}
blockquote {
margin-left: 2em;
margin-right: 2em;
margin-bottom: 1em;
}
.SCodeFlow {
border-left: 1px dotted black;
padding-left: 1em;
padding-right: 1em;
margin-top: 1em;
margin-bottom: 1em;
margin-left: 0em;
margin-right: 2em;
white-space: nowrap;
line-height: 1.5;
}
.SCodeFlow img {
margin-top: 0.5em;
margin-bottom: 0.5em;
}
.boxed {
margin: 0;
margin-top: 2em;
padding: 0.25em;
padding-bottom: 0.5em;
background: #f3f3f3;
box-sizing:border-box;
border-top: 1px solid #99b;
background: hsl(216, 78%, 95%);
background: -moz-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: -webkit-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: -o-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: -ms-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
}
blockquote > blockquote.SVInsetFlow {
/* resolves issue in e.g. /reference/notation.html */
margin-top: 0em;
}
.leftindent .SVInsetFlow { /* see e.g. section 4.5 of Racket Guide */
margin-top: 1em;
margin-bottom: 1em;
}
.SVInsetFlow a, .SCodeFlow a {
color: #07A;
font-weight: 500;
}
.SubFlow {
display: block;
margin: 0em;
}
.boxed {
width: 100%;
background-color: inherit;
}
.techoutside { text-decoration: none; }
.SAuthorListBox {
position: static;
float: none;
font-family: 'Fira';
font-weight: 300;
font-size: 110%;
margin-top: 1rem;
margin-bottom: 3rem;
width: 30rem;
height: auto;
}
.author > a { /* email links within author block */
font-weight: inherit;
color: inherit;
}
.SAuthorList {
font-size: 82%;
}
.SAuthorList:before {
content: "by ";
}
.author {
display: inline;
white-space: nowrap;
}
/* phone + tablet styles */
@media all and (max-width:720px){
@media all and (max-width:720px){
@media all {html {font-size: 15px;}}
@media all and (max-width:700px){html {font-size: 14px;}}
@media all and (max-width:630px){html {font-size: 13px;}}
@media all and (max-width:610px){html {font-size: 12px;}}
@media all and (max-width:550px){html {font-size: 11px;}}
@media all and (max-width:520px){html {font-size: 10px;}}
.navsettop, .navsetbottom {
display: block;
position: absolute;
width: 100%;
height: 4rem;
border: 0;
background-color: hsl(216, 15%, 70%);
}
.searchform {
display: inline;
border: 0;
}
.navright {
position: absolute;
right: 1.5rem;
margin-top: 1rem;
border: 0px solid red;
}
.navsetbottom {
display: block;
margin-top: 8rem;
}
.tocset {
display: none;
}
.tocset table, .tocset tbody, .tocset tr, .tocset td {
display: inline;
}
.tocview {
display: none;
}
.tocsub .tocsubtitle {
display: none;
}
.versionbox {
top: 4.5rem;
left: 1rem; /* same distance as main-column */
z-index: 11000;
height: 2em;
font-size: 70%;
font-weight: lighter;
}
.maincolumn {
margin-left: 1em;
margin-top: 7rem;
margin-bottom: 0rem;
}
}
}
/* print styles : hide the navigation elements */
@media print {
.tocset,
.navsettop,
.navsetbottom { display: none; }
.maincolumn {
width: auto;
margin-right: 13em;
margin-left: 0;
}
}

@ -0,0 +1,249 @@
/* See the beginning of "scribble.css". */
/* Monospace: */
.RktIn, .RktRdr, .RktPn, .RktMeta,
.RktMod, .RktKw, .RktVar, .RktSym,
.RktRes, .RktOut, .RktCmt, .RktVal,
.RktBlk {
font-family: monospace;
white-space: inherit;
}
/* Serif: */
.inheritedlbl {
font-family: serif;
}
/* Sans-serif: */
.RBackgroundLabelInner {
font-family: sans-serif;
}
/* ---------------------------------------- */
/* Inherited methods, left margin */
.inherited {
width: 100%;
margin-top: 0.5em;
text-align: left;
background-color: #ECF5F5;
}
.inherited td {
font-size: 82%;
padding-left: 1em;
text-indent: -0.8em;
padding-right: 0.2em;
}
.inheritedlbl {
font-style: italic;
}
/* ---------------------------------------- */
/* Racket text styles */
.RktIn {
color: #cc6633;
background-color: #eeeeee;
}
.RktInBG {
background-color: #eeeeee;
}
.RktRdr {
}
.RktPn {
color: #843c24;
}
.RktMeta {
color: black;
}
.RktMod {
color: black;
}
.RktOpt {
color: black;
}
.RktKw {
color: black;
}
.RktErr {
color: red;
font-style: italic;
}
.RktVar {
color: #262680;
font-style: italic;
}
.RktSym {
color: #262680;
}
.RktSymDef { /* used with RktSym at def site */
}
.RktValLink {
text-decoration: none;
color: blue;
}
.RktValDef { /* used with RktValLink at def site */
}
.RktModLink {
text-decoration: none;
color: blue;
}
.RktStxLink {
text-decoration: none;
color: black;
}
.RktStxDef { /* used with RktStxLink at def site */
}
.RktRes {
color: #0000af;
}
.RktOut {
color: #960096;
}
.RktCmt {
color: #c2741f;
}
.RktVal {
color: #228b22;
}
/* ---------------------------------------- */
/* Some inline styles */
.together {
width: 100%;
}
.prototype, .argcontract, .RBoxed {
white-space: nowrap;
}
.prototype td {
vertical-align: text-top;
}
.RktBlk {
white-space: inherit;
text-align: left;
}
.RktBlk tr {
white-space: inherit;
}
.RktBlk td {
vertical-align: baseline;
white-space: inherit;
}
.argcontract td {
vertical-align: text-top;
}
.highlighted {
background-color: #ddddff;
}
.defmodule {
width: 100%;
background-color: #F5F5DC;
}
.specgrammar {
float: right;
}
.RBibliography td {
vertical-align: text-top;
}
.leftindent {
margin-left: 1em;
margin-right: 0em;
}
.insetpara {
margin-left: 1em;
margin-right: 1em;
}
.Rfilebox {
}
.Rfiletitle {
text-align: right;
margin: 0em 0em 0em 0em;
}
.Rfilename {
border-top: 1px solid #6C8585;
border-right: 1px solid #6C8585;
padding-left: 0.5em;
padding-right: 0.5em;
background-color: #ECF5F5;
}
.Rfilecontent {
margin: 0em 0em 0em 0em;
}
.RpackageSpec {
padding-right: 0.5em;
}
/* ---------------------------------------- */
/* For background labels */
.RBackgroundLabel {
float: right;
width: 0px;
height: 0px;
}
.RBackgroundLabelInner {
position: relative;
width: 25em;
left: -25.5em;
top: 0px;
text-align: right;
color: white;
z-index: 0;
font-weight: bold;
}
.RForeground {
position: relative;
left: 0px;
top: 0px;
z-index: 1;
}
/* ---------------------------------------- */
/* History */
.SHistory {
font-size: 82%;
}

@ -0,0 +1,170 @@
// Common functionality for PLT documentation pages
// Page Parameters ------------------------------------------------------------
var page_query_string = location.search.substring(1);
var page_args =
((function(){
if (!page_query_string) return [];
var args = page_query_string.split(/[&;]/);
for (var i=0; i<args.length; i++) {
var a = args[i];
var p = a.indexOf('=');
if (p >= 0) args[i] = [a.substring(0,p), a.substring(p+1)];
else args[i] = [a, false];
}
return args;
})());
function GetPageArg(key, def) {
for (var i=0; i<page_args.length; i++)
if (page_args[i][0] == key) return decodeURIComponent(page_args[i][1]);
return def;
}
function MergePageArgsIntoLink(a) {
if (page_args.length == 0 ||
(!a.attributes["data-pltdoc"]) || (a.attributes["data-pltdoc"].value == ""))
return;
a.href = MergePageArgsIntoUrl(a.href);
}
function MergePageArgsIntoUrl(href) {
var mtch = href.match(/^([^?#]*)(?:\?([^#]*))?(#.*)?$/);
if (mtch == undefined) { // I think this never happens
return "?" + page_query_string;
}
if (!mtch[2]) {
return mtch[1] + "?" + page_query_string + (mtch[3] || "");
}
// need to merge here, precedence to arguments that exist in `a'
var i, j;
var prefix = mtch[1], str = mtch[2] || "", suffix = mtch[3] || "";
var args = str.split(/[&;]/);
for (i=0; i<args.length; i++) {
j = args[i].indexOf('=');
if (j) args[i] = args[i].substring(0,j);
}
var additions = "";
for (i=0; i<page_args.length; i++) {
var exists = false;
for (j=0; j<args.length; j++)
if (args[j] == page_args[i][0]) { exists = true; break; }
if (!exists) str += "&" + page_args[i][0] + "=" + page_args[i][1];
}
return prefix + "?" + str + suffix;
}
// Cookies --------------------------------------------------------------------
// Actually, try localStorage (a la HTML 5), first.
function GetCookie(key, def) {
try {
var v = localStorage[key];
if (!v) v = def;
return v;
} catch (e) {
var i, cookiestrs;
try {
if (document.cookie.length <= 0) return def;
cookiestrs = document.cookie.split(/; */);
} catch (e) { return def; }
for (i = 0; i < cookiestrs.length; i++) {
var cur = cookiestrs[i];
var eql = cur.indexOf('=');
if (eql >= 0 && cur.substring(0,eql) == key)
return unescape(cur.substring(eql+1));
}
return def;
}
}
function SetCookie(key, val) {
try {
localStorage[key] = val;
} catch(e) {
var d = new Date();
d.setTime(d.getTime()+(365*24*60*60*1000));
try {
document.cookie =
key + "=" + escape(val) + "; expires="+ d.toGMTString() + "; path=/";
} catch (e) {}
}
}
// note that this always stores a directory name, ending with a "/"
function SetPLTRoot(ver, relative) {
var root = location.protocol + "//" + location.host
+ NormalizePath(location.pathname.replace(/[^\/]*$/, relative));
SetCookie("PLT_Root."+ver, root);
}
// adding index.html works because of the above
function GotoPLTRoot(ver, relative) {
var u = GetCookie("PLT_Root."+ver, null);
if (u == null) return true; // no cookie: use plain up link
// the relative path is optional, default goes to the toplevel start page
if (!relative) relative = "index.html";
location = u + relative;
return false;
}
// Utilities ------------------------------------------------------------------
var normalize_rxs = [/\/\/+/g, /\/\.(\/|$)/, /\/[^\/]*\/\.\.(\/|$)/];
function NormalizePath(path) {
var tmp, i;
for (i = 0; i < normalize_rxs.length; i++)
while ((tmp = path.replace(normalize_rxs[i], "/")) != path) path = tmp;
return path;
}
// `noscript' is problematic in some browsers (always renders as a
// block), use this hack instead (does not always work!)
// document.write("<style>mynoscript { display:none; }</style>");
// Interactions ---------------------------------------------------------------
function DoSearchKey(event, field, ver, top_path) {
var val = field.value;
if (event && event.keyCode == 13) {
var u = GetCookie("PLT_Root."+ver, null);
if (u == null) u = top_path; // default: go to the top path
u += "search/index.html?q=" + encodeURIComponent(val);
u = MergePageArgsIntoUrl(u);
location = u;
return false;
}
return true;
}
function TocviewToggle(glyph, id) {
var s = document.getElementById(id).style;
var expand = s.display == "none";
s.display = expand ? "block" : "none";
glyph.innerHTML = expand ? "&#9660;" : "&#9658;";
}
// Page Init ------------------------------------------------------------------
// Note: could make a function that inspects and uses window.onload to chain to
// a previous one, but this file needs to be required first anyway, since it
// contains utilities for all other files.
var on_load_funcs = [];
function AddOnLoad(fun) { on_load_funcs.push(fun); }
window.onload = function() {
for (var i=0; i<on_load_funcs.length; i++) on_load_funcs[i]();
};
AddOnLoad(function(){
var links = document.getElementsByTagName("a");
for (var i=0; i<links.length; i++) MergePageArgsIntoLink(links[i]);
var label = GetPageArg("ctxtname",false);
if (!label) return;
var indicator = document.getElementById("contextindicator");
if (!indicator) return;
indicator.innerHTML = label;
indicator.style.display = "block";
});

@ -0,0 +1,484 @@
/* This file is used by default by all Scribble documents.
See also "manual.css", which is added by default by the
`scribble/manual` language. */
/* CSS seems backward: List all the classes for which we want a
particular font, so that the font can be changed in one place. (It
would be nicer to reference a font definition from all the places
that we want it.)
As you read the rest of the file, remember to double-check here to
see if any font is set. */
/* Monospace: */
.maincolumn, .refpara, .refelem, .tocset, .stt, .hspace, .refparaleft, .refelemleft {
font-family: monospace;
}
/* Serif: */
.main, .refcontent, .tocview, .tocsub, .sroman, i {
font-family: serif;
}
/* Sans-serif: */
.version, .versionNoNav, .ssansserif {
font-family: sans-serif;
}
.ssansserif {
font-size: 80%;
font-weight: bold;
}
/* ---------------------------------------- */
p, .SIntrapara {
display: block;
margin: 1em 0;
}
h2 { /* per-page main title */
margin-top: 0;
}
h3, h4, h5, h6, h7, h8 {
margin-top: 1.75em;
margin-bottom: 0.5em;
}
.SSubSubSubSection {
font-weight: bold;
font-size: 0.83em; /* should match h5; from HTML 4 reference */
}
/* Needed for browsers like Opera, and eventually for HTML 4 conformance.
This means that multiple paragraphs in a table element do not have a space
between them. */
table p {
margin-top: 0;
margin-bottom: 0;
}
/* ---------------------------------------- */
/* Main */
body {
color: black;
background-color: #ffffff;
}
table td {
padding-left: 0;
padding-right: 0;
}
.maincolumn {
width: 43em;
margin-right: -40em;
margin-left: 15em;
}
.main {
text-align: left;
}
/* ---------------------------------------- */
/* Navigation */
.navsettop, .navsetbottom {
background-color: #f0f0e0;
padding: 0.25em 0 0.25em 0;
}
.navsettop {
margin-bottom: 1.5em;
border-bottom: 2px solid #e0e0c0;
}
.navsetbottom {
margin-top: 2em;
border-top: 2px solid #e0e0c0;
}
.navleft {
margin-left: 1ex;
position: relative;
float: left;
white-space: nowrap;
}
.navright {
margin-right: 1ex;
position: relative;
float: right;
white-space: nowrap;
}
.nonavigation {
color: #e0e0e0;
}
.searchform {
display: inline;
margin: 0;
padding: 0;
}
.nosearchform {
display: none;
}
.searchbox {
width: 16em;
margin: 0px;
padding: 0px;
background-color: #eee;
border: 1px solid #ddd;
text-align: center;
vertical-align: middle;
}
#contextindicator {
position: fixed;
background-color: #c6f;
color: #000;
font-family: monospace;
font-weight: bold;
padding: 2px 10px;
display: none;
right: 0;
bottom: 0;
}
/* ---------------------------------------- */
/* Version */
.versionbox {
position: relative;
float: right;
left: 2em;
height: 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.version {
font-size: small;
}
.versionNoNav {
font-size: xx-small; /* avoid overlap with author */
}
.version:before, .versionNoNav:before {
content: "Version ";
}
/* ---------------------------------------- */
/* Margin notes */
.refpara, .refelem {
position: relative;
float: right;
left: 2em;
height: 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.refpara, .refparaleft {
top: -1em;
}
.refcolumn {
background-color: #F5F5DC;
display: block;
position: relative;
width: 13em;
font-size: 85%;
border: 0.5em solid #F5F5DC;
margin: 0 0 0 0;
}
.refcontent {
margin: 0 0 0 0;
}
.refcontent p {
margin-top: 0;
margin-bottom: 0;
}
.refparaleft, .refelemleft {
position: relative;
float: left;
right: 2em;
height: 0em;
width: 13em;
margin: 0em 0em 0em -13em;
}
.refcolumnleft {
background-color: #F5F5DC;
display: block;
position: relative;
width: 13em;
font-size: 85%;
border: 0.5em solid #F5F5DC;
margin: 0 0 0 0;
}
/* ---------------------------------------- */
/* Table of contents, inline */
.toclink {
text-decoration: none;
color: blue;
font-size: 85%;
}
.toptoclink {
text-decoration: none;
color: blue;
font-weight: bold;
}
/* ---------------------------------------- */
/* Table of contents, left margin */
.tocset {
position: relative;
float: left;
width: 12.5em;
margin-right: 2em;
}
.tocset td {
vertical-align: text-top;
}
.tocview {
text-align: left;
background-color: #f0f0e0;
}
.tocsub {
text-align: left;
margin-top: 0.5em;
background-color: #f0f0e0;
}
.tocviewlist, .tocsublist {
margin-left: 0.2em;
margin-right: 0.2em;
padding-top: 0.2em;
padding-bottom: 0.2em;
}
.tocviewlist table {
font-size: 82%;
}
.tocviewlisttopspace {
margin-bottom: 1em;
}
.tocviewsublist, .tocviewsublistonly, .tocviewsublisttop, .tocviewsublistbottom {
margin-left: 0.4em;
border-left: 1px solid #bbf;
padding-left: 0.8em;
}
.tocviewsublist {
margin-bottom: 1em;
}
.tocviewsublist table,
.tocviewsublistonly table,
.tocviewsublisttop table,
.tocviewsublistbottom table {
font-size: 75%;
}
.tocviewtitle * {
font-weight: bold;
}
.tocviewlink {
text-decoration: none;
color: blue;
}
.tocviewselflink {
text-decoration: underline;
color: blue;
}
.tocviewtoggle {
text-decoration: none;
color: blue;
font-size: 75%; /* looks better, and avoids bounce when toggling sub-sections due to font alignments */
}
.tocsublist td {
padding-left: 1em;
text-indent: -1em;
}
.tocsublinknumber {
font-size: 82%;
}
.tocsublink {
font-size: 82%;
text-decoration: none;
}
.tocsubseclink {
font-size: 82%;
text-decoration: none;
}
.tocsubnonseclink {
font-size: 82%;
text-decoration: none;
padding-left: 0.5em;
}
.tocsubtitle {
font-size: 82%;
font-style: italic;
margin: 0.2em;
}
/* ---------------------------------------- */
/* Some inline styles */
.indexlink {
text-decoration: none;
}
.nobreak {
white-space: nowrap;
}
pre { margin-left: 2em; }
blockquote { margin-left: 2em; }
ol { list-style-type: decimal; }
ol ol { list-style-type: lower-alpha; }
ol ol ol { list-style-type: lower-roman; }
ol ol ol ol { list-style-type: upper-alpha; }
.SCodeFlow {
display: block;
margin-left: 1em;
margin-bottom: 0em;
margin-right: 1em;
margin-top: 0em;
white-space: nowrap;
}
.SVInsetFlow {
display: block;
margin-left: 0em;
margin-bottom: 0em;
margin-right: 0em;
margin-top: 0em;
}
.SubFlow {
display: block;
margin: 0em;
}
.boxed {
width: 100%;
background-color: #E8E8FF;
}
.hspace {
}
.slant {
font-style: oblique;
}
.badlink {
text-decoration: underline;
color: red;
}
.plainlink {
text-decoration: none;
color: blue;
}
.techoutside { text-decoration: underline; color: #b0b0b0; }
.techoutside:hover { text-decoration: underline; color: blue; }
/* .techinside:hover doesn't work with FF, .techinside:hover>
.techinside doesn't work with IE, so use both (and IE doesn't
work with inherit in the second one, so use blue directly) */
.techinside { color: black; }
.techinside:hover { color: blue; }
.techoutside:hover>.techinside { color: inherit; }
.SCentered {
text-align: center;
}
.imageleft {
float: left;
margin-right: 0.3em;
}
.Smaller {
font-size: 82%;
}
.Larger {
font-size: 122%;
}
/* A hack, inserted to break some Scheme ids: */
.mywbr {
display: inline-block;
height: 0;
width: 0;
font-size: 1px;
}
.compact li p {
margin: 0em;
padding: 0em;
}
.noborder img {
border: 0;
}
.SAuthorListBox {
position: relative;
float: right;
left: 2em;
top: -2.5em;
height: 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.SAuthorList {
font-size: 82%;
}
.SAuthorList:before {
content: "by ";
}
.author {
display: inline;
white-space: nowrap;
}
/* print styles : hide the navigation elements */
@media print {
.tocset,
.navsettop,
.navsetbottom { display: none; }
.maincolumn {
width: auto;
margin-right: 13em;
margin-left: 0;
}
}

@ -0,0 +1,79 @@
#lang racket/base
(require (submod hyphenate safe) txexpr rackunit)
(define omit-em-tag (λ(x) (member (car x) '(em))))
(define omit-p-tag (λ(x) (member (car x) '(p))))
(define omit-foo-zam-tag (λ(x) (member (car x) '(foo zam))))
(define ends-with-s (λ(x) (regexp-match #rx"s$" x)))
(define omit-script-tag (λ(x) (member (car x) '(script))))
(define tx-with-attr (λ(x) (with-handlers ([exn:fail? (λ(exn) #f)])
(equal? (attr-ref x 'hyphens) "no-thanks"))))
(check-equal? (hyphenate "edges") "edges") ;; word without matching patterns
(check-equal? (hyphenate "polymorphism") "poly\u00ADmor\u00ADphism")
(check-equal? (hyphenate "POLYmorPHISM") "POLY\u00ADmor\u00ADPHISM")
(check-equal? (hyphenate "polymorphism" #:min-length 100) "polymorphism")
(check-equal? (hyphenate "ugly" #:min-length 1) "ug\u00ADly")
(check-equal? (unhyphenate "poly\u00ADmor\u00ADphism") "polymorphism")
(check-equal? (hyphenate "polymorphism" #\-) "poly-mor-phism")
(check-equal? (hyphenate "polymorphism" "foo") "polyfoomorfoophism")
(check-equal? (unhyphenate "polyfoomorfoophism" "foo") "polymorphism")
(check-equal? (hyphenate "circular polymorphism squandering") "cir\u00ADcu\u00ADlar poly\u00ADmor\u00ADphism squan\u00ADder\u00ADing")
(check-equal? (hyphenate '(p "circular polymorphism" amp (em "squandering"))) '(p "cir\u00ADcu\u00ADlar poly\u00ADmor\u00ADphism" amp (em "squan\u00ADder\u00ADing")))
(check-equal? (hyphenate "present project") "present project") ; exception words
;; test these last so exceptions have been set up already
;(check-equal? (word->hyphenation-points "polymorphism") '("poly" "mor" "phism"))
;(check-equal? (word->hyphenation-points "present") '("present")) ; exception word
;(check-true (exception-word? "Foobar"))
;(check-true (exception-word? "foobar"))
;(check-false (exception-word? "foobar!"))
;(check-true (exception-word? "foo-bar"))
;(check-false (exception-word? "foo bar"))
;; omit certain tags
(check-equal? (hyphenate '(p "circular polymorphism" amp (em "squandering")) #:omit-txexpr omit-em-tag)
'(p "cir\u00ADcu\u00ADlar poly\u00ADmor\u00ADphism" amp (em "squandering")))
(check-equal? (hyphenate '(p "circular polymorphism" amp (em "squandering")) #:omit-txexpr omit-p-tag)
'(p "circular polymorphism" amp (em "squandering")))
(check-equal? (hyphenate '(p (foo "circular") (bar "circular") (zam "circular")) #:omit-txexpr omit-foo-zam-tag)
'(p (foo "circular") (bar "cir\u00ADcu\u00ADlar") (zam "circular")))
; omit txexprs with an attribute
(check-equal? (hyphenate '(p (foo ((hyphens "no-thanks")) "circular") (foo "circular"))
#:omit-txexpr tx-with-attr)
'(p (foo ((hyphens "no-thanks")) "circular") (foo "cir\u00ADcu\u00ADlar")))
;; omit strings that end with "s"
(check-equal? (hyphenate '(p (foo "curses tailfeathers") (foo "curses tailfeather")) #:omit-string ends-with-s)
'(p (foo "curses tailfeathers") (foo "curs\u00ADes tail\u00ADfeath\u00ADer")))
;; omit words that end with "s"
(check-equal? (hyphenate '(p (foo "curses tailfeathers") (foo "curses tailfeather")) #:omit-word ends-with-s)
'(p (foo "curses tailfeathers") (foo "curses tail\u00ADfeath\u00ADer")))
(check-equal? (unhyphenate '(p (script "tail-feathers") (em "tail-feathers")) #\- #:omit-txexpr omit-script-tag)
'(p (script "tail-feathers") (em "tailfeathers")))
(check-equal? (unhyphenate '(p "cir-cu-lar poly-mor-phism" "cir-cu-lar poly-mor-phisms") #\- #:omit-string ends-with-s)
'(p "circular polymorphism" "cir-cu-lar poly-mor-phisms"))
(check-equal? (hyphenate "polymorphism" #\- #:min-left-length 5 #:min-right-length 5) "polymor-phism")
(check-equal? (hyphenate "polymorphism" #\- #:min-left-length 3 #:min-right-length 7) "poly-morphism")
(check-equal? (hyphenate "polymorphism" #\- #:min-left-length 7 #:min-right-length 7) "polymorphism")
(check-equal? (hyphenate "polymorphism" #\* #:exceptions '("polymo-rphism")) "polymo*rphism")
(check-equal? (hyphenate "formidable" #\-) "for-mi-da-ble")
(module french racket/base
(require (submod hyphenate/fr safe) rackunit)
(check-equal? (hyphenate "formidable" #\-) "for-mi-dable")) ; hyphenates differently in French
(require 'french)

@ -1,3 +0,0 @@
#lang typed/racket/base
(require "hyphenate/main.rkt")
(provide hyphenate unhyphenate)

@ -1,10 +0,0 @@
#lang typed/racket/base
(provide (all-defined-out))
(define-type Pattern String)
(define-type Patterns (Listof String))
(define-type Pattern-Hash-Key Pattern)
(define-type Pattern-Hash-Value (Listof Natural))
(define-type Pattern-Hash (HashTable Pattern-Hash-Key Pattern-Hash-Value))
(define-type Pattern-Hash-Pair (Pairof Pattern-Hash-Key Pattern-Hash-Value))
(define-type Exception-Word String)

@ -1,14 +0,0 @@
#lang typed/racket/base
(require "core-predicates.rkt")
(provide default-exceptions)
; Knuth and Liang's original exception patterns from classic TeX.
; In the public domain.
(define: kl-exceptions : Patterns
(map symbol->string '(as-so-ciate as-so-ciates dec-li-na-tion oblig-a-tory phil-an-thropic present presents project projects reci-procity re-cog-ni-zance ref-or-ma-tion ret-ri-bu-tion ta-ble)))
(define: mb-exceptions : Patterns
(map symbol->string '(real-ly law-yer law-yers law-yered law-yer-ing law-yer-ly oki-na oki-nas)))
(define: default-exceptions : Patterns
(append kl-exceptions mb-exceptions))

@ -1,3 +0,0 @@
#lang typed/racket/base
(require (for-syntax typed/racket/base typed/sugar/string typed/sugar/coerce racket/syntax))
(require typed/sugar/define typed/sugar/list typed/txexpr)

@ -1,267 +0,0 @@
#lang typed/racket/base
(require sugar/include)
(include-without-lang-line "main-helper.rkt")
(require typed/sugar/define racket/string racket/list racket/bool)
(require "patterns-hashed.rkt" "exceptions.rkt" "core-predicates.rkt")
(provide hyphenate unhyphenate reset-patterns word->hyphenation-points exception-word? exception-words?)
;; module data, define now but set! them later (because they're potentially big & slow)
(define: patterns : Pattern-Hash (make-hash))
(define: pattern-cache : Pattern-Hash (make-hash))
;; module default values
(define: default-min-length : Natural 5)
(define: default-min-left-length : Natural 2)
(define: default-min-right-length : Natural 2)
(define: default-joiner : Char #\u00AD)
(define/typed (add-pattern-to-cache pat)
(Pattern-Hash-Pair -> Void)
(hash-set! pattern-cache (car pat) (cdr pat)))
;; Convert the hyphenated pattern into a point array for use later.
(define/typed (add-exception exception)
(Pattern -> Void)
(define/typed (make-key x)
(Pattern -> Pattern-Hash-Key)
(format ".~a." (string-replace x "-" "")))
(define/typed (make-value x)
(Pattern -> Pattern-Hash-Value)
`(0 ,@(map (λ(x) (if (equal? x "-") 1 0)) (regexp-split #px"[a-z]" x)) 0))
(add-pattern-to-cache (cons (make-key exception) (make-value exception)))
(void))
(define-syntax-rule (hash-empty? h) (zero? (hash-count h)))
(define/typed (initialize-patterns)
(-> Void)
(when (hash-empty? pattern-cache)
(for-each add-exception default-exceptions))
(when (hash-empty? patterns)
(set! patterns hashed-patterns)))
(define/typed (reset-patterns)
(-> Void)
(define: blank : Pattern-Hash (make-hash))
(set! pattern-cache (hash-copy blank))
(set! patterns (hash-copy blank))
(initialize-patterns))
;; An exception-word is a string of word characters or hyphens.
(define/typed (exception-word? x)
(Any -> Boolean)
(and (string? x) (regexp-match #px"^[\\w-]+$" x) #t))
(define/typed (exception-words? xs)
(Any -> Boolean)
(and (list? xs) (andmap exception-word? xs)))
(define/typed (string->natural i)
(String -> (Option Natural))
(let* ([result (string->number i)]
[result (and (number? result) (inexact->exact result))]
[result (and (exact-nonnegative-integer? result) result)])
result))
(define/typed (string->hashpair pat)
(String -> Pattern-Hash-Pair)
(define boundary-name ".")
;; first convert the pattern to a list of alternating letters and numbers.
;; insert zeroes where there isn't a number in the pattern.
(define new-pat
(let*: ([pat : (Listof String) (regexp-match* #rx"." pat)] ; convert to list
[pat : (Listof (U String Natural)) ((inst map (U String Natural) String) (λ(i) (or (string->natural i) i)) pat)] ; convert numbers
[pat : (Listof (U String Natural)) (if (string? (car pat)) (cons 0 pat) pat)] ; add zeroes to front where needed
[pat : (Listof (U String Natural)) (if (string? (car (reverse pat))) (reverse (cons 0 (reverse pat))) pat)]) ; and back
(apply append
(reverse (for/fold: ([acc : (Listof (Listof (U String Natural))) null])
([current (in-list pat)][i (in-naturals)])
(if (= i (sub1 (length pat)))
(cons (reverse (list current)) acc)
(let ([next (list-ref pat (add1 i))])
;; insert zeroes where there isn't a number
(cons (reverse (if (and (or (equal? current boundary-name) (string? current)) (string? next))
(list current 0)
(list current))) acc))))))))
;; then slice out the string & numerical parts to be a key / value pair.
(define value (filter exact-nonnegative-integer? new-pat))
(define key (filter string? new-pat))
(cons (apply string-append key) value))
(define/typed (make-points word)
(String -> Pattern-Hash-Value)
;; walk through all the substrings and see if there's a matching pattern.
;; if so, pad it out to full length (so we can (apply map max ...) later on)
(define: word-with-dots : String (format ".~a." (string-downcase word)))
(define: matching-patterns : (Listof Pattern-Hash-Value)
(cond
[(hash-has-key? pattern-cache word-with-dots) (list (hash-ref pattern-cache word-with-dots))]
[else
(let ([word-as-list (string->list word-with-dots)])
;; ensures there's at least one (null) element in return value
(define starting-value (make-list (add1 (length word-as-list)) 0))
(reverse (for*/fold: ([acc : (Listof Pattern-Hash-Value) (cons starting-value null)])
([len (in-range (length word-as-list))]
[index (in-range (- (length word-as-list) len))])
(define substring (list->string (take (drop word-as-list index) (add1 len))))
(cond
[(hash-has-key? patterns substring)
(define value (hash-ref patterns substring))
;; put together head padding + value + tail padding
(define pattern-to-add (append (make-list index 0) value (make-list (- (add1 (length word-as-list)) (length value) index) 0)))
(cons pattern-to-add acc)]
[else acc]))))]))
(define/typed (apply-map-max xss)
((Listof Pattern-Hash-Value) -> Pattern-Hash-Value)
(if (ormap empty? (list xss (car xss)))
empty
(cons (apply max ((inst map Natural Pattern-Hash-Value) car xss))
(apply-map-max ((inst map Pattern-Hash-Value Pattern-Hash-Value) cdr xss)))))
(define: max-value-pattern : Pattern-Hash-Value (apply-map-max matching-patterns))
(add-pattern-to-cache (cons word-with-dots max-value-pattern))
;; for point list,
;; drop first two elements because they represent hyphenation weight
;; before the starting "." and between "." and the first letter.
;; drop last element because it represents hyphen after last "."
;; after you drop these two, then each number corresponds to
;; whether a hyphen goes after that letter.
(drop-right (drop max-value-pattern 2) 1))
;; Find hyphenation points in a word. This is not quite synonymous with syllables.
(define/typed (word->hyphenation-points word
[min-length default-min-length]
[min-left-length default-min-left-length]
[min-right-length default-min-right-length])
(case-> (String -> (Listof String))
(String (Option Natural) -> (Listof String))
(String (Option Natural)(Option Natural) -> (Listof String))
(String (Option Natural)(Option Natural)(Option Natural) -> (Listof String)))
(define/typed (add-no-hyphen-zone points)
((Listof Natural) -> (Listof Natural))
;; points is a list corresponding to the letters of the word.
;; to create a no-hyphenation zone of length n, zero out the first n-1 points
;; and the last n points (because the last value in points is always superfluous)
(let* ([min-left-length (min (or min-left-length default-min-left-length) (length points))]
[min-right-length (min (or min-right-length default-min-right-length) (length points))])
(define points-with-zeroes-on-left
(append (make-list (sub1 min-left-length) 0) (drop points (sub1 min-left-length))))
(define points-with-zeroes-on-left-and-right
(append (drop-right points-with-zeroes-on-left min-right-length) (make-list min-right-length 0)))
points-with-zeroes-on-left-and-right))
(define/typed (make-pieces word)
(String -> (Listof String))
(define-values (word-pieces last-piece)
(for/fold: ([word-pieces : (Listof String) empty]
[current-piece : (Listof String) empty])
([str (in-list (regexp-match* #rx"." word))] ; explodes word into list of one-character strings (char list is slower)
[point (in-list (add-no-hyphen-zone (make-points word)))])
(define updated-current-piece (cons str current-piece))
(if (even? point)
(values word-pieces updated-current-piece) ; even point denotes character
(values (cons (string-join (reverse updated-current-piece) "") word-pieces) empty)))) ; odd point denotes char + syllable
(reverse (cons (string-join (reverse last-piece) "") word-pieces)))
(if (and min-length (< (string-length word) min-length))
(list word)
(make-pieces word)))
;; joiner contract allows char or string; this coerces to string.
(define/typed (joiner->string joiner)
((U Char String) -> String)
(format "~a" joiner))
(define/typed (apply-proc proc x [omit-string (λ(x) #f)] [omit-txexpr (λ(x) #f)])
(case->
((String -> String) Xexpr -> Xexpr)
((String -> String) Xexpr (String -> Any) -> Xexpr)
((String -> String) Xexpr (String -> Any) (Txexpr -> Any) -> Xexpr))
(let loop ([x x])
(cond
[(and (string? x) (not (omit-string x))) (proc x)]
[(and (txexpr? x) (not (omit-txexpr x)))
(make-txexpr (get-tag x) (get-attrs x) ((inst map Txexpr-Element Txexpr-Element) loop (get-elements x)))]
[else x])))
(define/typed (hyphenate x [joiner default-joiner]
#:exceptions [extra-exceptions empty]
#:min-length [min-length default-min-length]
#:min-left-length [min-left-length default-min-left-length]
#:min-right-length [min-right-length default-min-right-length]
#:omit-word [omit-word? (λ(x) #f)]
#:omit-string [omit-string? (λ(x) #f)]
#:omit-txexpr [omit-txexpr? (λ(x) #f)])
(case->
(Xexpr
[#:exceptions (Listof String)]
[#:min-length (Option Natural)]
[#:min-left-length (Option Natural)]
[#:min-right-length (Option Natural)]
[#:omit-word (String -> Any)]
[#:omit-string (String -> Any)]
[#:omit-txexpr (Txexpr -> Any)] -> Xexpr)
(Xexpr (U Char String)
[#:exceptions (Listof String)]
[#:min-length (Option Natural)]
[#:min-left-length (Option Natural)]
[#:min-right-length (Option Natural)]
[#:omit-word (String -> Any)]
[#:omit-string (String -> Any)]
[#:omit-txexpr (Txexpr -> Any)] -> Xexpr))
(initialize-patterns) ; reset everything each time hyphenate is called
(for-each add-exception extra-exceptions)
;; todo?: connect this regexp pattern to the one used in word? predicate
(define word-pattern #px"\\w+") ;; more restrictive than exception-word
(define/typed (replacer word . words)
(String String * -> String)
(if (not (omit-word? word))
(string-join (word->hyphenation-points word min-length min-left-length min-right-length) (joiner->string joiner))
word))
(define/typed (insert-hyphens text)
(String -> String)
(regexp-replace* word-pattern text replacer))
(apply-proc insert-hyphens x omit-string? omit-txexpr?))
(define/typed (unhyphenate x [joiner default-joiner]
#:omit-word [omit-word? (λ(x) #f)]
#:omit-string [omit-string? (λ(x) #f)]
#:omit-txexpr [omit-txexpr? (λ(x) #f)])
(case->
(Xexpr
[#:omit-word (String -> Any)]
[#:omit-string (String -> Any)]
[#:omit-txexpr (Txexpr -> Any)] -> Xexpr)
(Xexpr (U Char String)
[#:omit-word (String -> Any)]
[#:omit-string (String -> Any)]
[#:omit-txexpr (Txexpr -> Any)] -> Xexpr))
(define word-pattern (pregexp (format "[\\w~a]+" joiner)))
(define/typed (replacer word . words)
(String String * -> String)
(if (not (omit-word? word))
(string-replace word (joiner->string joiner) "")
word))
(define/typed (remove-hyphens text)
(String -> String)
(regexp-replace* word-pattern text replacer))
(apply-proc remove-hyphens x omit-string? omit-txexpr?))
(module+ main
(initialize-patterns)
(hyphenate "supercalifragilisticexpialidocious" "-")
#;(define t "supercalifragilisticexpialidocious")
#;(hyphenate t "-"))

File diff suppressed because it is too large Load Diff

File diff suppressed because one or more lines are too long

@ -0,0 +1,3 @@
#lang racket/base
(require hyphenate/bootstrap)
(build-main us)

@ -0,0 +1,23 @@
#lang hyphenate/exception-prep
as-so-ciate
as-so-ciates
dec-li-na-tion
oblig-a-tory
phil-an-thropic
present
presents
project
projects
re-ci-pro-ci-ty
re-cog-ni-zance
ref-or-ma-tion
ret-ri-bu-tion
ta-ble
real-ly
law-yer
law-yers
law-yered
law-yer-ing
law-yer-ly
oki-na
oki-nas

File diff suppressed because one or more lines are too long
Loading…
Cancel
Save