Use the 'documentation-language-family read-language key to customize

how accessing the docs works

Author: rfindler

drracket-core-lib/drracket/private/app.rkt

@@ -10,10 +10,11 @@
          "../acks.rkt"
          "local-member-names.rkt"
          "frame-icon.rkt"
+         "insulated-read-language.rkt"
          pict/snip pict)
 
 (import [prefix drracket:unit: drracket:unit^]
-        [prefix drracket:frame: drracket:frame^]
+        [prefix drracket:frame: drracket:frame/int^]
         [prefix drracket:language-configuration: drracket:language-configuration/internal^]
         [prefix help-desk: drracket:help-desk^]
         [prefix drracket:tools: drracket:tools^])
@@ -244,7 +245,12 @@
   (let* ([docs-button (new button%
                            [label (string-constant help-desk)]
                            [parent button-panel]
-                           [callback (λ (x y) (help-desk:help-desk))])])
+                           [callback (λ (x y)
+                                       (define-values (query-table sub)
+                                         (drracket:frame:try-to-find-a-query-table-and-sub
+                                          (drracket:frame:try-to-find-an-irl)))
+                                       (help-desk:help-desk #:query-table query-table
+                                                            #:sub sub))])])
     (send docs-button focus))
   (send button-panel stretchable-height #f)
   (send button-panel set-alignment 'center 'center)

drracket-core-lib/drracket/private/frame.rkt

@@ -321,6 +321,8 @@
          mrlib/terminal
          browser/external
          (submod "." install-pkg)
+         "local-member-names.rkt"
+         "insulated-read-language.rkt"
          drracket/get-module-path)
 (provide frame@)
 (define-unit frame@  
@@ -356,8 +358,7 @@
             (super on-subwindow-char receiver event)))
 
       (inherit get-edit-target-window get-edit-target-object get-menu-bar)
-      
-            
+
       (define/private (can-show-keybindings?)
         (define edit-object (get-edit-target-object))
         (and edit-object
@@ -375,7 +376,10 @@
             (bell)))
 
       (define/override (help-menu:before-about help-menu)
-        (make-help-desk-menu-item help-menu))
+        (make-help-desk-menu-item help-menu
+                                  (λ ()
+                                    (and (is-a? this drracket:unit:frame<%>)
+                                         (send (send (send this get-current-tab) get-defs) get-irl)))))
 
       (define/override (help-menu:about-callback item evt) (drracket:app:about-drscheme))
       (define/override (help-menu:about-string) (string-constant about-drscheme))
@@ -757,18 +761,35 @@
               (when (exit:user-oks-exit)
                 (exit:exit))
               #t))))
-    (make-help-desk-menu-item help-menu)
+    (make-help-desk-menu-item help-menu (λ () (try-to-find-an-irl)))
     (drracket-help-menu:after-about help-menu #f))
 
-  (define (make-help-desk-menu-item help-menu)
-    (define (docs-menu-item label)
-      (new menu-item%
-           [label label]
-           [parent help-menu]
-           [callback (λ (item evt) (help:help-desk) #t)]))
-    (docs-menu-item (string-constant racket-documentation))
-    (new separator-menu-item% [parent help-menu])
-    (docs-menu-item (string-constant help-desk)))
+  (define (make-help-desk-menu-item help-menu maybe-get-irl)
+    (define (get-menu-item-label)
+      (define irl (maybe-get-irl))
+      (define default-lang-name "Racket")
+      (define lang-name
+        (cond
+          [irl
+           (define ht
+             (call-read-language irl
+                                 'documentation-language-family
+                                 (hash)))
+           (hash-ref ht "doc-language-name" default-lang-name)]
+          [else default-lang-name]))
+      (format (string-constant x-documentation) lang-name))
+    (new menu-item%
+         [label (get-menu-item-label)]
+         [parent help-menu]
+         [demand-callback
+          (λ (menu-item)
+            (send menu-item set-label (get-menu-item-label)))]
+         [callback (λ (item evt)
+                     (define irl (maybe-get-irl))
+                     (define ht (call-read-language irl 'documentation-language-family (hash)))
+                     (help:help-desk #:sub (hash-ref ht "doc-path" "index.html")
+                                     #:query-table (hash-ref ht "doc-query" (hash)))
+                     #t)]))
 
   (define (drracket-help-menu:after-about menu dlg-parent)
     (drracket:app:add-important-urls-to-help-menu menu '())
@@ -788,7 +809,29 @@
               [(1) (send-url "https://lists.racket-lang.org/")]
               [(2) (send-url "https://github.com/racket/racket/issues/new/choose")]))])
     (add-menu-path-item menu)
-    (drracket:app:add-language-items-to-help-menu menu)))
+    (drracket:app:add-language-items-to-help-menu menu))
+
+  ;; this should be called when we're not in the context of a specific frame, but
+  ;; want an IRL. It'll look for a recently used frame and get that one's IRL (if any)
+  (define (try-to-find-an-irl)
+    (define drr-frame
+      (for/or ([frame (in-list (cons (send (group:get-the-frame-group) get-active-frame)
+                                     (send (group:get-the-frame-group) get-frames)))])
+        (and (is-a? frame drracket:unit:frame%)
+             frame)))
+    (and drr-frame
+         (send (send (send drr-frame get-current-tab) get-defs) get-irl)))
+
+  ;; (or/c #f irl) -> (values hash string)
+  (define (try-to-find-a-query-table-and-sub irl)
+    (define ht
+      (if irl
+          (call-read-language irl
+                              'documentation-language-family
+                              (hash))
+          (hash)))
+    (values (hash-ref ht "doc-query" (hash))
+            (hash-ref ht "doc-path" "index.html"))))
 
 
 (require (submod "." add-racket-to-path)

drracket-core-lib/drracket/private/help-desk.rkt

@@ -148,6 +148,11 @@
      '(default=1)))
   (equal? choice 1))
 
-(define (help-desk [key #f] [context #f] [parent #f])
+(define (help-desk [key #f] [context #f] [parent #f]
+                   #:sub [sub #f]
+                   #:query-table [query-table (hash)])
   (when key (maybe-try-to-materialize-docs parent))
-  (if key (perform-search key context) (send-main-page)))
+  (if key
+      (perform-search key context #:query-table query-table)
+      (send-main-page #:query-table query-table
+                      #:sub (or sub "index.html"))))

drracket-core-lib/drracket/private/in-irl-namespace.rkt

@@ -245,6 +245,16 @@
                                                (-> read-only-text/c exact-integer?
                                                    string?)
                                                string?)))))]
+    [(documentation-language-family)
+     (hash/dc
+      [key string?]
+      [val (key)
+           (case key
+             [("doc-language-name") string?]
+             [("doc-path") path-string?]
+             [("doc-query") (hash/c string? string? #:immutable #t)]
+             [else any/c])]
+      #:immutable #t)]
     [else
      (error 'key->contract "unknown key")]))
 

drracket-core-lib/drracket/private/insulated-read-language.rkt

@@ -46,7 +46,8 @@ Will not work with the definitions text surrogate interposition that
         'drracket:paren-matches
         'drracket:quote-matches
         'drracket:comment-delimiters
-        'drracket:define-popup))
+        'drracket:define-popup
+        'documentation-language-family))
 
 (provide
  (contract-out

drracket-core-lib/drracket/private/rep.rkt

@@ -52,7 +52,7 @@ TODO
           [prefix drracket:language-configuration: drracket:language-configuration/internal^]
           [prefix drracket:language: drracket:language/int^]
           [prefix drracket:app: drracket:app^]
-          [prefix drracket:frame: drracket:frame^]
+          [prefix drracket:frame: drracket:frame/int^]
           [prefix drracket:unit: drracket:unit^]
           [prefix drracket:text: drracket:text^]
           [prefix drracket:help-desk: drracket:help-desk^]
@@ -185,6 +185,14 @@ TODO
      "search-help-desk"
      (λ (frame)
        (define obj (send frame get-focus-object))
+       (define irl
+         (cond
+           [(is-a? frame drracket:unit:frame%)
+            (send (send (send frame get-current-tab) get-defs) get-irl)]
+           [else
+            (drracket:frame:try-to-find-an-irl)]))
+       (define-values (query-table sub)
+         (drracket:frame:try-to-find-a-query-table-and-sub irl))
        (cond
          [(is-a? obj text%)
           (define start (send obj get-start-position))
@@ -194,7 +202,7 @@ TODO
                           (send obj get-text start end)))
           (cond
             [(or (not str) (equal? "" str))
-             (drracket:help-desk:help-desk)]
+             (drracket:help-desk:help-desk #:query-table query-table #:sub sub)]
             [else
              (let* ([l (send obj get-canvas)]
                     [l (and l (send l get-top-level-window))]
@@ -208,9 +216,12 @@ TODO
                                 'drscheme:help-context-term))]
                     [name (and l (send l get-language-name))])
                (drracket:help-desk:help-desk
-                str (and ctxt (list ctxt name)) frame))])]
+                str (and ctxt (list ctxt name)) frame
+                #:query-table query-table
+                #:sub sub))])]
          [else
-          (drracket:help-desk:help-desk)])))
+          (drracket:help-desk:help-desk #:query-table query-table
+                                        #:sub sub)])))
 
     ;; keep this in case people use it in their keymaps
     (add-drs-function "execute"  (λ (frame) (send frame execute-callback)))

drracket-core-lib/drracket/private/unit.rkt

@@ -107,7 +107,7 @@
 (define-unit unit@
   (import [prefix help-desk: drracket:help-desk^]
           [prefix drracket:app: drracket:app^]
-          [prefix drracket:frame: drracket:frame^]
+          [prefix drracket:frame: drracket:frame/int^]
           [prefix drracket:text: drracket:text^]
           [prefix drracket:rep: drracket:rep/int^]
           [prefix drracket:language-configuration: drracket:language-configuration/internal^]
@@ -148,7 +148,6 @@
                     (unless added?
                       (set! added? #t)
                       (new separator-menu-item% [parent menu]))))])
-           
            (add-search-help-desk-menu-item text menu
                                            (let-values ([(x y)
                                                          (send text dc-location-to-editor-location
@@ -197,6 +196,12 @@
            (void))))))
 
   (define (add-search-help-desk-menu-item text menu position [add-sep void])
+    (define irl (cond
+                  [(is-a? text drracket:rep:text%)
+                   (send (send text get-definitions-text) get-irl)]
+                  [(is-a? text (get-definitions-text%))
+                   (send text get-irl)]
+                  [else (drracket:frame:try-to-find-an-irl)]))
     (let* ([end (send text get-end-position)]
            [start (send text get-start-position)])
       (unless (= 0 (send text last-position))
@@ -227,7 +232,12 @@
                      str
                      (string-append short-str "...")))
                 menu
-                (λ x (help-desk:help-desk str (list ctxt name))))
+                (λ x
+                  (define-values (query-table sub)
+                    (drracket:frame:try-to-find-a-query-table-and-sub irl))
+                  (help-desk:help-desk str (list ctxt name)
+                                          #:query-table query-table
+                                          #:sub sub)))
               (void)))))))
 
   (define (filename->kind fn)

drracket-core-lib/drracket/tool-lib.rkt

@@ -43,7 +43,8 @@ all of the names in the tools library, for use defining keybindings
                              mzlib/pconvert
                              syntax/toplevel
                              drracket/tool-lib
-                             string-constants)))
+                             string-constants
+                             help/search)))
 
 ;; these two declarations produce all of the struct names
 ;; but with "drscheme" in front instead of drracket
@@ -931,15 +932,18 @@ all of the names in the tools library, for use defining keybindings
   (->* ()
        ((or/c #f string?)
         (or/c #f string? (list/c string? string?))
-        (or/c (is-a?/c frame%) (is-a?/c dialog%) #f))
+        (or/c (is-a?/c frame%) (is-a?/c dialog%) #f)
+        #:sub string?)
        any)
   (()
    ((search-key #f)
     (search-context #f)
-    (parent #f)))
+    (parent #f)
+    (sub "index.html")))
   @{if @racket[search-key] is a string, performs a search in the docs with
  @racket[search-key] and @racket[search-context].
- Otherwise, calls @racket[send-main-page] with no arguments.
+ Otherwise, calls @racket[send-main-page] with @racket[sub] as the
+@racket[#:sub] keyword argument.
 
  The search may involve asking the user a question, in which case the
  dialog with the question uses @racket[parent] as its parent.

drracket-core-lib/info.rkt

@@ -30,7 +30,7 @@
                ["racket-index" #:version "1.2"]
                "sandbox-lib"
                ["scribble-lib" #:version "1.11"]
-               ["string-constants-lib" #:version "1.53"]
+               ["string-constants-lib" #:version "1.54"]
                ["syntax-color-lib" #:version "1.4"]
                "simple-tree-text-markup-lib"
                "typed-racket-lib"

drracket-core/scribblings/drracket/menus.scrbl

@@ -496,9 +496,11 @@ brings the corresponding window to the front.
 
 @itemize[
 
- @item{@defmenuitem{Help Desk} Opens the Help Desk. This is the clearing 
- house for all documentation about DrRacket and its language.}
- 
+ @item{@defmenuitem{Documentation} Opens the main
+  documentation page. This is the clearing house for all
+  documentation about the language family of the programming
+  language in the definitions window.}
+
  @item{@defmenuitem{About DrRacket...} Shows the credits for DrRacket.}
 
  @item{@defmenuitem{Check for Updates...} Checks to see if a new version