suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixing prop usage, using rkt suffix, and better commit urls

Browse Source
This commit is contained in:
Jay McCarthy 2010-04-23 12:22:12 -06:00
parent 8e37ccb1bc
commit 3653883b02
3 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/meta/drdr/metadata.ss
View File

@ -7,7 +7,7 @@
(define suffix (filename-extension pth)) (define suffix (filename-extension pth))
(and suffix (and suffix
(ormap (lambda (bs) (bytes=? suffix bs)) (ormap (lambda (bs) (bytes=? suffix bs))
(list #"ss" #"scm" #"scrbl")))) (list #"ss" #"scm" #"scrbl" #"rkt"))))
(define PROP:command-line "drdr:command-line") (define PROP:command-line "drdr:command-line")
(define PROP:timeout "drdr:timeout") (define PROP:timeout "drdr:timeout")
@ -65,5 +65,7 @@
(delete-file tmp-file)))))) (delete-file tmp-file))))))
(unless props:get-prop (unless props:get-prop
(error 'get-prop "Could not load props file for ~e" (current-rev))) (error 'get-prop "Could not load props file for ~e" (current-rev)))
(props:get-prop a-path prop def ; XXX get-prop is stupid and errors when a-path is invalid rather than returning def
#:as-string? as-string?)) (with-handlers ([exn? (lambda (x) def)])
(props:get-prop a-path prop def
#:as-string? as-string?)))

12
collects/meta/drdr/render.ss
View File

@ -101,7 +101,13 @@
(regexp-replace "^(....-..-..)T(..:..:..).*Z$" date "\\1 \\2")) (regexp-replace "^(....-..-..)T(..:..:..).*Z$" date "\\1 \\2"))
(define (git-date->nice-date date) (define (git-date->nice-date date)
(regexp-replace "^(....-..-..) (..:..:..).*$" date "\\1 \\2")) (regexp-replace "^(....-..-..) (..:..:..).*$" date "\\1 \\2"))
(define (log->url log)
(define start-commit (git-push-start-commit log))
(define end-commit (git-push-end-commit log))
(if (string=? start-commit end-commit)
(format "http://github.com/plt/racket/commit/~a" end-commit)
(format "http://github.com/plt/racket/compare/~a...~a" start-commit end-commit)))
(define (format-commit-msg) (define (format-commit-msg)
(define pth (revision-commit-msg (current-rev))) (define pth (revision-commit-msg (current-rev)))
(define (timestamp pth) (define (timestamp pth)
@ -608,9 +614,7 @@
(define log (read-cache (future-record-path rev))) (define log (read-cache (future-record-path rev)))
(define-values (committer title) (define-values (committer title)
(log->committer+title log)) (log->committer+title log))
(define url (define url (log->url log))
(format "http://github.com/plt/racket/commit/~a"
(git-push-end-commit log)))
`(tr ([class "dir"] `(tr ([class "dir"]
[title ,title]) [title ,title])
(td (a ([href ,url]) ,name)) (td (a ([href ,url]) ,name))

3
collects/meta/drdr/scm.ss
View File

@ -135,9 +135,12 @@
[to string?])] [to string?])]
[get-scm-commit-msg (exact-nonnegative-integer? path-string? . -> . git-push?)]) [get-scm-commit-msg (exact-nonnegative-integer? path-string? . -> . git-push?)])
(define (git-push-start-commit gp)
(git-commit-hash (last (git-push-commits gp))))
(define (git-push-end-commit gp) (define (git-push-end-commit gp)
(git-commit-hash (first (git-push-commits gp)))) (git-commit-hash (first (git-push-commits gp))))
(provide/contract (provide/contract
[git-push-start-commit (git-push? . -> . string?)]
[git-push-end-commit (git-push? . -> . string?)]) [git-push-end-commit (git-push? . -> . string?)])
(define scm-commit-author (define scm-commit-author