fixed buttons in about box

svn: r1432

collects/help/help-desk.ss

@@ -11,14 +11,12 @@
   
   (provide help-desk-frame<%>)
   
-  (define (goto-hd-location x) (error 'goto-hd-location "no"))
-  
   (provide/contract 
    (set-bug-report-info! any/c)
    (find-doc-names (-> (listof (cons/c path? string?))))
    (goto-manual-link (any/c string? string? . -> . any))
    
-   (goto-hd-location (symbol? . -> . any))
+   (goto-hd-location ((symbols 'hd-tour 'release-notes 'plt-license) . -> . any))
    (new-help-desk (-> (is-a?/c help-desk-frame<%>)))
    (show-help-desk (-> any))
    (add-help-desk-mixin (-> mixin-contract void?))

collects/help/private/gui.ss

@@ -496,7 +496,9 @@
             (goto-url link f)
             f)))
       
-      (define (goto-hd-location sym) (goto-url (get-hd-location sym)))
+      (define (goto-hd-location sym)
+        (let ([loc (get-hd-location sym)])
+          (goto-url loc)))
       
       (define (search-for-docs search-string search-type match-type lucky? docs)
         (let ([fr (or (find-help-desk-frame)

collects/help/private/sig.ss

@@ -8,5 +8,6 @@
      new-help-desk
      find-help-desk-frame
      show-help-desk
+     goto-hd-location
      search-for-docs
      search-for-docs/in-frame)))

collects/help/private/standard-urls.ss

@@ -33,7 +33,7 @@
    (make-missing-manual-url (string? string? string? . -> . string?))
    (get-hd-location ((lambda (sym) (memq sym hd-location-syms))
                      . -> . 
-                     string))
+                     string?))
    [make-docs-plt-url (string? . -> . string?)]
    [make-docs-html-url (string? . -> . string?)])
 
@@ -48,7 +48,7 @@
   (define (make-docs-html-url manual-name)
     (format "~a/html/~a/index.htm" (base-docs-url) manual-name))
 
-  (define (prefix-with-server cookie suffix)
+  (define (prefix-with-server suffix)
     (format "http://~a:~a~a" internal-host internal-port suffix))
   
   (define results-url-prefix (format "http://~a:~a/servlets/results.ss?" internal-host internal-port))