bkyk8rc3zvpnsf5inmcqq4n3k98cv6hj-my-site-hyper-literate-git.test.suzanne.soy-0.0.1

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

manual-history.rkt (1923B)

      1 #lang racket/base
      2 (require (for-syntax racket/base
      3                      syntax/parse)
      4          version/utils
      5          scribble/base
      6          scribble/core
      7          "manual-sprop.rkt"
      8          "manual-ex.rkt"
      9          "manual-style.rkt")
     10 
     11 (provide history)
     12 
     13 (struct history-entry (what vers vers-stx expl))
     14 
     15 (begin-for-syntax
     16  (define-splicing-syntax-class clause
     17    #:attributes (e)
     18    [pattern (~seq #:added vers)
     19             #:attr e #'(history-entry "Added" vers (quote-syntax vers) '("."))]
     20    [pattern (~seq #:changed vers content)
     21             #:attr e #'(history-entry "Changed" vers (quote-syntax vers)
     22                                       (list ": " content))]))
     23 
     24 (define-syntax (history stx)
     25   (syntax-parse stx
     26     [(_ c:clause ...)
     27      #'(make-history (list c.e ...))]))
     28 
     29 (define (make-history es)
     30   (for ([e (in-list es)])
     31     (define vers (history-entry-vers e))
     32     (unless (valid-version? vers)
     33       (raise-syntax-error 'history
     34                           (format "not a valid version: ~e"
     35                                   vers)
     36                           (history-entry-vers-stx e))))
     37   (delayed-block
     38    (lambda (renderer p ri)
     39      (define pkg
     40        (let ([from (resolve-get/tentative p ri '(exporting-packages #f))])
     41          (and from
     42               (pair? from)
     43               (car from))))
     44      (para
     45       #:style (style "SHistory" (list scheme-properties))
     46       (for/list ([e (in-list (sort es (lambda (a b) (version<? a b))
     47                                    #:key history-entry-vers))]
     48                  [i (in-naturals)])
     49         (define vers (history-entry-vers e))
     50         (list (if (zero? i)
     51                   null
     52                   (list (linebreak)))
     53               (history-entry-what e)
     54               " in version "
     55               vers
     56               (if (and pkg (zero? i))
     57                   (list " of package " (tt pkg))
     58                   null)
     59               (history-entry-expl e)))))))