|
|
|
@ -1,6 +1,6 @@
|
|
|
|
|
#lang racket/base
|
|
|
|
|
(require (for-syntax racket/base))
|
|
|
|
|
(require racket/string racket/list racket/contract racket/vector)
|
|
|
|
|
(require racket/string racket/list racket/vector)
|
|
|
|
|
(require "patterns.rkt" "exceptions.rkt" txexpr xml)
|
|
|
|
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
@ -13,15 +13,19 @@
|
|
|
|
|
;;; (also in the public domain)
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
|
|
(define-syntax (define+provide/contract stx)
|
|
|
|
|
(module+ safe (require racket/contract))
|
|
|
|
|
|
|
|
|
|
(define-syntax (define+provide+safe stx)
|
|
|
|
|
(syntax-case stx ()
|
|
|
|
|
[(_ (proc arg ... . rest-arg) contract body ...)
|
|
|
|
|
#'(define+provide/contract proc contract
|
|
|
|
|
#'(define+provide+safe proc contract
|
|
|
|
|
(λ(arg ... . rest-arg) body ...))]
|
|
|
|
|
[(_ name contract body ...)
|
|
|
|
|
#'(begin
|
|
|
|
|
(provide (contract-out [name contract]))
|
|
|
|
|
(define name body ...))]))
|
|
|
|
|
(define name body ...)
|
|
|
|
|
(provide name)
|
|
|
|
|
(module+ safe
|
|
|
|
|
(provide (contract-out [name contract]))))]))
|
|
|
|
|
|
|
|
|
|
;; module data, define now but set! them later (because they're potentially big & slow)
|
|
|
|
|
(define exceptions #f)
|
|
|
|
@ -32,14 +36,14 @@
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Convert the hyphenated pattern into a point array for use later.
|
|
|
|
|
(define (list->exceptions exn-strings)
|
|
|
|
|
(define (vector->exceptions exn-strings)
|
|
|
|
|
(define (make-key x)
|
|
|
|
|
(string-replace x "-" ""))
|
|
|
|
|
|
|
|
|
|
(define (make-value x)
|
|
|
|
|
(list->vector (cons 0 (map (λ(x) (if (equal? x "-") 1 0)) (regexp-split #px"[a-z]" x)))))
|
|
|
|
|
|
|
|
|
|
(make-hash (map (λ(x) (cons (make-key x) (make-value x))) exn-strings)))
|
|
|
|
|
(make-hash (vector->list (vector-map (λ(x) (cons (make-key x) (make-value x))) exn-strings))))
|
|
|
|
|
|
|
|
|
|
;; An exception-word is a string of word characters or hyphens.
|
|
|
|
|
(define (exception-word? x)
|
|
|
|
@ -68,7 +72,7 @@
|
|
|
|
|
(hash-set! tree char (make-hash)))
|
|
|
|
|
(set! tree (hash-ref tree char)))
|
|
|
|
|
(hash-set! tree empty points)))
|
|
|
|
|
(map insert-pattern pattern-data)
|
|
|
|
|
(vector-map insert-pattern pattern-data)
|
|
|
|
|
tree)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
@ -78,7 +82,7 @@
|
|
|
|
|
(define (make-zeroes points)
|
|
|
|
|
; controls hyphenation zone from edges of word
|
|
|
|
|
; possible todo: make this user-configurable?
|
|
|
|
|
(map (λ(i) (vector-set! points i 0)) (list 1 2 (- (vector-length points) 2) (- (vector-length points) 3)))
|
|
|
|
|
(vector-map (λ(i) (vector-set! points i 0)) (vector 1 2 (- (vector-length points) 2) (- (vector-length points) 3)))
|
|
|
|
|
points)
|
|
|
|
|
|
|
|
|
|
(let* ([word (string-downcase word)]
|
|
|
|
@ -156,7 +160,7 @@
|
|
|
|
|
[else x]))]))
|
|
|
|
|
|
|
|
|
|
;; Hyphenate using a filter procedure.
|
|
|
|
|
(define+provide/contract (hyphenatef x proc [joiner default-joiner]
|
|
|
|
|
(define+provide+safe (hyphenatef x proc [joiner default-joiner]
|
|
|
|
|
#:exceptions [extra-exceptions '()]
|
|
|
|
|
#:min-length [min-length default-min-length])
|
|
|
|
|
((xexpr? procedure?) ((or/c char? string?)
|
|
|
|
@ -165,7 +169,7 @@
|
|
|
|
|
|
|
|
|
|
;; set up module data
|
|
|
|
|
;; todo?: change set! to parameterize
|
|
|
|
|
(set! exceptions (list->exceptions (append default-exceptions extra-exceptions)))
|
|
|
|
|
(set! exceptions (vector->exceptions (vector-append default-exceptions (list->vector extra-exceptions))))
|
|
|
|
|
(when (not pattern-tree) (set! pattern-tree (make-pattern-tree default-patterns)))
|
|
|
|
|
|
|
|
|
|
(define joiner-string (joiner->string joiner))
|
|
|
|
@ -178,7 +182,7 @@
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Default hyphenate is a special case of hyphenatef.
|
|
|
|
|
(define+provide/contract (hyphenate x [joiner default-joiner]
|
|
|
|
|
(define+provide+safe (hyphenate x [joiner default-joiner]
|
|
|
|
|
#:exceptions [extra-exceptions '()]
|
|
|
|
|
#:min-length [min-length default-min-length])
|
|
|
|
|
((xexpr/c) ((or/c char? string?)
|
|
|
|
@ -188,12 +192,10 @@
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Remove hyphens.
|
|
|
|
|
(define+provide/contract (unhyphenate x [joiner default-joiner])
|
|
|
|
|
(define+provide+safe (unhyphenate x [joiner default-joiner])
|
|
|
|
|
((xexpr/c) ((or/c char? string?)) . ->* . xexpr/c)
|
|
|
|
|
|
|
|
|
|
(define (remove-hyphens text)
|
|
|
|
|
(string-replace text (joiner->string joiner) ""))
|
|
|
|
|
|
|
|
|
|
(apply-xexpr-strings remove-hyphens x))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|