From 3653883b025b3f9165e5f53a0a9e68c50525bd76 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Fri, 23 Apr 2010 12:22:12 -0600
Subject: [PATCH] Fixing prop usage, using rkt suffix, and better commit urls

---
 collects/meta/drdr/metadata.ss |  8 +++++---
 collects/meta/drdr/render.ss   | 12 ++++++++----
 collects/meta/drdr/scm.ss      |  3 +++
 3 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/collects/meta/drdr/metadata.ss b/collects/meta/drdr/metadata.ss
index 51d29fb333..ed01c30702 100644
--- a/collects/meta/drdr/metadata.ss
+++ b/collects/meta/drdr/metadata.ss
@@ -7,7 +7,7 @@
   (define suffix (filename-extension pth))
   (and suffix
        (ormap (lambda (bs) (bytes=? suffix bs))
-              (list #"ss" #"scm" #"scrbl"))))
+              (list #"ss" #"scm" #"scrbl" #"rkt"))))
 
 (define PROP:command-line "drdr:command-line")
 (define PROP:timeout "drdr:timeout")
@@ -65,5 +65,7 @@
                     (delete-file tmp-file))))))
   (unless props:get-prop
     (error 'get-prop "Could not load props file for ~e" (current-rev)))
-  (props:get-prop a-path prop def
-                  #:as-string? as-string?))
+  ; XXX get-prop is stupid and errors when a-path is invalid rather than returning def
+  (with-handlers ([exn? (lambda (x) def)])
+    (props:get-prop a-path prop def
+                    #:as-string? as-string?)))
diff --git a/collects/meta/drdr/render.ss b/collects/meta/drdr/render.ss
index 033a9f229a..591ee20696 100644
--- a/collects/meta/drdr/render.ss
+++ b/collects/meta/drdr/render.ss
@@ -101,7 +101,13 @@
   (regexp-replace "^(....-..-..)T(..:..:..).*Z$" date "\\1 \\2"))
 (define (git-date->nice-date date)
   (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 pth (revision-commit-msg (current-rev)))
   (define (timestamp pth)
@@ -608,9 +614,7 @@
                             (define log (read-cache (future-record-path rev)))
                             (define-values (committer title)
                               (log->committer+title log))
-                            (define url
-                              (format "http://github.com/plt/racket/commit/~a"
-                                      (git-push-end-commit log)))
+                            (define url (log->url log))
                             `(tr ([class "dir"]
                                   [title ,title])
                                  (td (a ([href ,url]) ,name))
diff --git a/collects/meta/drdr/scm.ss b/collects/meta/drdr/scm.ss
index ec47204cb3..3c62dda6a6 100644
--- a/collects/meta/drdr/scm.ss
+++ b/collects/meta/drdr/scm.ss
@@ -135,9 +135,12 @@
           [to string?])]
  [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)
   (git-commit-hash (first (git-push-commits gp))))
 (provide/contract
+ [git-push-start-commit (git-push? . -> . string?)]
  [git-push-end-commit (git-push? . -> . string?)])
 
 (define scm-commit-author