From 2a8f772fe20c240e9ec15b91765e38093eaaa044 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 7 Dec 2005 17:47:23 +0000 Subject: [PATCH] made help button in create executable work svn: r1559 --- collects/drscheme/private/language.ss | 1 + collects/help/help-desk.ss | 2 +- collects/help/private/gui.ss | 3 +++ collects/help/private/manuals.ss | 5 ----- collects/help/private/sig.ss | 1 + collects/help/private/standard-urls.ss | 1 + 6 files changed, 7 insertions(+), 6 deletions(-) diff --git a/collects/drscheme/private/language.ss b/collects/drscheme/private/language.ss index b1ebd60161..62cfbad306 100644 --- a/collects/drscheme/private/language.ss +++ b/collects/drscheme/private/language.ss @@ -619,6 +619,7 @@ (string-constant help) type/base/help-panel (λ (x y) + (send dlg show #f) (drscheme:help-desk:goto-help "drscheme" "Executables")))) (define button-panel (instantiate horizontal-panel% () diff --git a/collects/help/help-desk.ss b/collects/help/help-desk.ss index 111cd943e9..16e5547344 100644 --- a/collects/help/help-desk.ss +++ b/collects/help/help-desk.ss @@ -14,7 +14,7 @@ (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-manual-link (string? string? . -> . any)) (goto-hd-location ((symbols 'hd-tour 'release-notes 'plt-license) . -> . any)) (new-help-desk (-> (is-a?/c help-desk-frame<%>))) diff --git a/collects/help/private/gui.ss b/collects/help/private/gui.ss index 6b09118909..2a142aa3d9 100644 --- a/collects/help/private/gui.ss +++ b/collects/help/private/gui.ss @@ -500,6 +500,9 @@ (let ([loc (get-hd-location sym)]) (goto-url loc))) + (define (goto-manual-link manual index-key) + (goto-url (prefix-with-server (finddoc-page-anchor manual index-key)))) + (define (search-for-docs search-string search-type match-type lucky? docs) (let ([fr (or (find-help-desk-frame) (new-help-desk))]) diff --git a/collects/help/private/manuals.ss b/collects/help/private/manuals.ss index 3ee7d9541d..ce61e5c664 100644 --- a/collects/help/private/manuals.ss +++ b/collects/help/private/manuals.ss @@ -25,8 +25,6 @@ [find-doc-directories (-> (listof path?))] [find-doc-directory (path? . -> . (union false/c path?))] [find-doc-names (-> (listof (cons/c path? string?)))] - - [goto-manual-link (any/c string? string? . -> . any)] [get-index-file (path? . -> . (union false/c path?))]) (provide find-manuals) @@ -52,9 +50,6 @@ (make-sec "Writing extensions" #rx"Tools|Inside|Foreign" '()) (make-sec "Other" #rx"" '()))) - (define (goto-manual-link cookie manual index-key) - (error 'goto-manual-link "broken ~s ~s ~s\n" cookie manual index-key)) - ;; Creates a "file:" link into the indicated manual. ;; The link doesn't go to a particular anchor, ;; because "file:" does not support that. diff --git a/collects/help/private/sig.ss b/collects/help/private/sig.ss index 0df7181715..9dd4110207 100644 --- a/collects/help/private/sig.ss +++ b/collects/help/private/sig.ss @@ -9,5 +9,6 @@ find-help-desk-frame show-help-desk goto-hd-location + goto-manual-link search-for-docs search-for-docs/in-frame))) diff --git a/collects/help/private/standard-urls.ss b/collects/help/private/standard-urls.ss index a4cf1079d2..eff250946b 100644 --- a/collects/help/private/standard-urls.ss +++ b/collects/help/private/standard-urls.ss @@ -34,6 +34,7 @@ (get-hd-location ((lambda (sym) (memq sym hd-location-syms)) . -> . string?)) + [prefix-with-server (string? . -> . string?)] [make-docs-plt-url (string? . -> . string?)] [make-docs-html-url (string? . -> . string?)])