restored word completion for the full languages (not teaching languages yet)

svn: r8018

collects/drscheme/private/language-configuration.ss

@@ -1333,7 +1333,7 @@
       (let ([words #f])
         (λ ()
           (unless words
-            (set! words (text:get-completions/manuals #f)))
+            (set! words (text:get-completions/manuals '(scheme/base scheme/contract))))
           words)))
     
     ;; add-built-in-languages : -> void

collects/framework/framework.ss

@@ -82,11 +82,12 @@
     ""
     "Defaults to 15.")
    (text:get-completions/manuals
-    (-> (listof string?) (listof string?))
+    (-> (or/c false/c (listof symbol?)) (listof string?))
     (manuals)
     "Returns the list of keywords for the manuals from \\var{manuals}"
-    "by reading them from the \\texttt{keywords}"
-    "files in the corresponding manuals' directories")
+    "by extracting all of the documented exports of the manuals."
+    "The symbols are meant to be module paths."
+    "If \\var{manuals} is false, then all of the documented names are used.")
    
    (number-snip:make-repeating-decimal-snip
     (number? boolean? . -> . (is-a?/c snip%))

collects/framework/private/text.ss

@@ -20,6 +20,12 @@ WARNING: printf is rebound in the body of the unit to always
          (lib "dirs.ss" "setup")
          (lib "string.ss")
          (prefix-in srfi1: (lib "1.ss" "srfi")))
+(require setup/scribble-index
+         scribble/struct
+         scribble/manual-struct
+         scribble/decode
+         scribble/basic
+         (prefix-in s/m: scribble/manual))
 
 (import mred^
         [prefix icon: framework:icon^]
@@ -2239,9 +2245,7 @@ designates the character that triggers autocompletion
         [else
          #f]))
     
-      (define/public (get-all-words)
-        (get-completions/manuals
-         '("framework" "foreign" "scribble" "mzlib" "mrlib" "mzscheme" "mred" "r5rs")))
+    (define/public (get-all-words) (get-completions/manuals #f))
     
     (define completions-box #f) ; completions-box% or #f if no completions box is active right now
     (define word-start-pos #f)  ; start pos of that word, or #f if no autocompletion
@@ -2801,32 +2805,35 @@ designates the character that triggers autocompletion
 ;; ============================================================
 ;; read keywords from manuals
 
-  (define (get-completions/manuals manuals)
-    (define (read-keywords dir)
-      (let ([ddir (find-doc-dir)])
-        (if ddir
-            (let ([keywords (build-path ddir dir "keywords")])
-              (if (file-exists? keywords)
-                  (map (λ (x) (string->symbol (car x)))
-                       (call-with-input-file keywords
-                         read))
-                  '()))
-            '())))
+(define xref #f)
 
-    (let ([ht (make-hash-table)])
-      (for-each (λ (x) (hash-table-put! ht x #t))
-                (apply append (map read-keywords manuals)))
-      (sort
-       (hash-table-map ht (λ (x y) (symbol->string x)))
-       string<=?)))  
+(define (get-completions/manuals manuals)
+  (let* ([sym->mpi (λ (mp) (module-path-index-resolve (module-path-index-join mp #f)))]
+         [manual-mpis (and manuals (map sym->mpi manuals))])
+    
+    (unless xref 
+      (set! xref (load-xref)))
+    
+    (let ([ht (make-hash-table 'equal)])
+      (for-each
+       (λ (entry)
+         (let ([desc (entry-desc entry)])
+           (when (exported-index-desc? desc)
+             (let ([name (exported-index-desc-name desc)])
+               (when name
+                 (when (or (not manual-mpis)
+                           (ormap (λ (from-lib) (memq from-lib manual-mpis))
+                                  (map sym->mpi (exported-index-desc-from-libs desc))))
+                   (hash-table-put! ht (symbol->string name) #t)))))))
+       (xref-index xref))
+      (sort (hash-table-map ht (λ (x y) x)) string<=?))))
 
 ;; ============================================================
 ;; auto complete example code
 
 #;
 (begin
-    (define all-words (get-completions/manuals 
-                       '("framework" "foreign" "scribble" "mzlib" "mrlib" "mzscheme" "mred" "r5rs")))
+  (define all-words (get-completions/manuals #f))
   
   (let* ([f (new frame% (label "Test") (height 400) (width 400))]
          [e (new (autocomplete-mixin text%))]

collects/lang/htdp-langs.ss

@@ -578,7 +578,7 @@
             (case key
               [(drscheme:autocomplete-words)
                (unless keywords 
-                 (set! keywords (text:get-completions/manuals (map bytes->string/utf-8 (htdp-manuals)))))
+                 (set! keywords (text:get-completions/manuals #f))) ;; complete with everything, which is wrong ..
                keywords]
               [(drscheme:teachpack-menu-items) htdp-teachpack-callbacks]
               [(drscheme:special:insert-lambda) #f]
@@ -1392,7 +1392,7 @@
          (instantiate htdp-language% ()
            (one-line-summary (string-constant advanced-one-line-summary))
            (module '(lib "lang/htdp-advanced.ss"))
-           (manual #"advanced")
+           ( #"advanced")
            (language-position
             (list (string-constant teaching-languages)
                   (string-constant how-to-design-programs)