106 lines
4.4 KiB
Scheme
Executable File
106 lines
4.4 KiB
Scheme
Executable File
#!/bin/sh
|
|
#| -*- scheme -*-
|
|
exec racket -um "$0" "$@"
|
|
|#
|
|
|
|
#lang scheme/base
|
|
(require version/utils scheme/file)
|
|
|
|
(define (patches)
|
|
;; no grouping parens in regexps
|
|
(let* ([parts# (length (regexp-split #rx"[.]" the-version))]
|
|
[concat
|
|
(lambda xs
|
|
(apply bytes-append
|
|
(map (lambda (x) (if (string? x) (string->bytes/utf-8 x) x))
|
|
xs)))]
|
|
[commas "<1>, *<2>, *<3>, *<4>"]
|
|
[periods "<1>.<2>.<3>.<4>"]
|
|
[rc-patch (list (concat "\r\n *FILEVERSION "commas" *"
|
|
"\r\n *PRODUCTVERSION "commas" *\r\n")
|
|
(concat "\r\n *VALUE \"FileVersion\", *\""commas
|
|
"(?:\\\\0)?\"")
|
|
(concat "\r\n *VALUE \"ProductVersion\", *\""commas
|
|
"(?:\\\\0)?\""))])
|
|
`([#t ; only verify that it has the right contents
|
|
"src/racket/src/schvers.h"
|
|
,(concat "\n#define MZSCHEME_VERSION \"<1>.<2>"
|
|
(if (parts# . >= . 3) ".<3>" "")
|
|
(if (parts# . >= . 4) ".<4>" "")
|
|
"\"\n")
|
|
,@(for/list ([x+n (in-list '([X 1] [Y 2] [Z 3] [W 4]))])
|
|
(format "\n#define MZSCHEME_VERSION_~a ~a\n"
|
|
(car x+n)
|
|
(if ((cadr x+n) . > . parts#)
|
|
"0" (format "<~a>" (cadr x+n)))))]
|
|
["src/worksp/racket/racket.rc" ,@rc-patch]
|
|
["src/worksp/gracket/gracket.rc" ,@rc-patch]
|
|
["src/worksp/starters/start.rc" ,@rc-patch]
|
|
["src/worksp/gracket/gracket.manifest"
|
|
,(concat "assemblyIdentity *\r\n *version *= *\""periods"\" *\r\n")]
|
|
["src/worksp/mzcom/mzobj.rgs"
|
|
,(concat "MzCOM.MzObj."periods" = s 'MzObj Class'")
|
|
,(concat "CurVer = s 'MzCOM.MzObj."periods"'")
|
|
,(concat "ProgID = s 'MzCOM.MzObj."periods"'")]
|
|
["src/worksp/mzcom/mzcom.rc" ,@rc-patch
|
|
#"\r\n *CTEXT +\"MzCOM v. <1>.<2>\",IDC_STATIC"
|
|
#"\r\n *CTEXT +\"Racket v. <1>.<2>\",IDC_STATIC"])))
|
|
|
|
(define the-version #f)
|
|
|
|
(define getv
|
|
(let ([vlist #f])
|
|
(lambda (i)
|
|
(unless vlist
|
|
(set! vlist (map (compose string->bytes/utf-8 number->string)
|
|
(version->list the-version))))
|
|
(list-ref vlist i))))
|
|
|
|
(define (replace-pattern pattern buf err)
|
|
(let* ([rx (regexp-replace* #rx#"<[1234]>" pattern #"([0-9]+)")]
|
|
[vs (map (lambda (m)
|
|
(let* ([m (regexp-replace #rx#"^<(.+)>$" m #"\\1")]
|
|
[m (string->number (bytes->string/utf-8 m))])
|
|
(sub1 m)))
|
|
(regexp-match* #rx#"<[1234]>" pattern))]
|
|
[m (regexp-match-positions rx buf)])
|
|
(cond
|
|
[(not m) (err "pattern ~s not found" pattern)]
|
|
[(regexp-match? rx buf (cdar m))
|
|
(err "pattern ~s matches more than once" pattern)]
|
|
[else (let loop ([m (cdr m)] [i 0] [vs vs] [r '()])
|
|
(cond [(and (null? m) (null? vs))
|
|
(apply bytes-append (reverse (cons (subbytes buf i) r)))]
|
|
[(or (null? m) (null? vs)) (error "internal error")]
|
|
[else (loop (cdr m) (cdar m) (cdr vs)
|
|
(list* (getv (car vs))
|
|
(subbytes buf i (caar m))
|
|
r))]))])))
|
|
|
|
(define (do-patch file . specs)
|
|
(let* ([only-verify? (eq? file #t)]
|
|
[file (if only-verify? (car specs) file)]
|
|
[specs (if only-verify? (cdr specs) specs)]
|
|
[_ (begin (printf " ~a..." file) (flush-output))]
|
|
[contents (file->bytes file)]
|
|
[buf contents]
|
|
[err (lambda (fmt . args)
|
|
(error 'versionpatch "~a, in ~s"
|
|
(apply format fmt args) file))])
|
|
(for ([spec (in-list specs)]) (set! buf (replace-pattern spec buf err)))
|
|
(if (equal? buf contents)
|
|
(printf (if only-verify? " verified.\n" " no change.\n"))
|
|
(begin (printf " modified.\n")
|
|
(if only-verify?
|
|
(error 'versionpatch
|
|
"this file is expected to have a correct version")
|
|
(with-output-to-file file (lambda () (write-bytes buf))
|
|
#:exists 'truncate))))))
|
|
|
|
(provide main)
|
|
(define (main ver)
|
|
(set! the-version ver)
|
|
;; (printf "Patching files for ~a...\n" ver)
|
|
(for ([p (in-list (patches))]) (apply do-patch p))
|
|
(printf "Done.\n"))
|