searchable index pages

svn: r8477

original commit: b012e7dbe7cc0291ba2af8d22dd05e88f626c274

collects/scribble/basic.ss

@@ -208,64 +208,60 @@
                  (string<? (car a) (car b)))]
             [else (string-ci<? (car a) (car b))])))
   (define alpha (string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
+  (define (rows . rows)
+    (make-table 'index (map (lambda (row)
+                              (list (make-flow (list (make-paragraph row)))))
+                            rows)))
+  (define line-break (make-element 'newline '("/n")))
   (define contents
-    (make-delayed-flow-element
+    (lambda (renderer sec ri)
-     (lambda (renderer sec ri)
+      (define l null)
-       (define l null)
+      (define alpha-starts (make-hash-table))
-       (define alpha-starts (make-hash-table))
+      (hash-table-for-each
-       (define (rows . rows)
+       (let ([parent (collected-info-parent (part-collected-info sec ri))])
-         (make-table 'index
+         (if parent
-                     (map (lambda (row)
+           (collected-info-info (part-collected-info parent ri))
-                            (list (make-flow (list (make-paragraph row)))))
+           (collect-info-ext-ht (resolve-info-ci ri))))
-                          rows)))
+       (lambda (k v)
-       (hash-table-for-each
+         (when (and (pair? k) (eq? 'index-entry (car k)))
-        (let ([parent (collected-info-parent (part-collected-info sec ri))])
+           (set! l (cons (cons (cadr k) v) l)))))
-          (if parent
+      (set! l (sort l cadr-string-lists<?))
-            (collected-info-info (part-collected-info parent ri))
+      (rows
-            (collect-info-ext-ht (resolve-info-ci ri))))
+       (let loop ([i l] [alpha alpha])
-        (lambda (k v)
+         (define (add-letter let l)
-          (when (and (pair? k) (eq? 'index-entry (car k)))
+           (list* (make-element "nonavigation" (list (string let))) " " l))
-            (set! l (cons (cons (cadr k) v) l)))))
+         (cond [(null? alpha) null]
-       (set! l (sort l cadr-string-lists<?))
+               [(null? i) (add-letter (car alpha) (loop i (cdr alpha)))]
-       (rows
+               [else
-        (let loop ([i l] [alpha alpha])
+                (let* ([strs (cadr (car i))]
-          (define (add-letter let l)
+                       [letter (if (or (null? strs) (string=? "" (car strs)))
-            (list* (make-element "nonavigation" (list (string let))) " " l))
+                                 #f
-          (cond [(null? alpha) null]
+                                 (char-upcase (string-ref (car strs) 0)))])
-                [(null? i) (add-letter (car alpha) (loop i (cdr alpha)))]
+                  (cond [(not letter) (loop (cdr i) alpha)]
-                [else
+                        [(char-ci>? letter (car alpha))
-                 (let* ([strs (cadr (car i))]
+                         (add-letter (car alpha) (loop i (cdr alpha)))]
-                        [letter (if (or (null? strs) (string=? "" (car strs)))
+                        [(char-ci=? letter (car alpha))
-                                  #f
+                         (hash-table-put! alpha-starts (car i) letter)
-                                  (char-upcase (string-ref (car strs) 0)))])
+                         (list* (make-element
-                   (cond [(not letter) (loop (cdr i) alpha)]
+                                 (make-target-url (format "#alpha:~a" letter) #f)
-                         [(char-ci>? letter (car alpha))
+                                 (list (string (car alpha))))
-                          (add-letter (car alpha) (loop i (cdr alpha)))]
+                                " "
-                         [(char-ci=? letter (car alpha))
+                                (loop (cdr i) (cdr alpha)))]
-                          (hash-table-put! alpha-starts (car i) letter)
+                        [else (loop (cdr i) alpha)]))]))
-                          (list* (make-element
+       (list 'nbsp)
-                                  (make-target-url (format "#alpha:~a" letter)
+       (map (lambda (i)
-                                                   #f)
+              (define e
-                                  (list (string (car alpha))))
+                (make-link-element "indexlink"
-                                 " "
+                                   `(,@(commas (caddr i)) ,line-break)
-                                 (loop (cdr i) (cdr alpha)))]
+                                   (car i)))
-                         [else (loop (cdr i) alpha)]))]))
+              (cond [(hash-table-get alpha-starts i #f)
-        (list 'nbsp)
+                     => (lambda (let)
-        ((if (null? l) values cdr) ; drop one 'newline
+                          (make-element (make-url-anchor
-         (apply append
+                                         (format "alpha:~a" (char-upcase let)))
-                (map (lambda (i)
+                                        (list e)))]
-                       (define e (make-link-element
+                    [else e]))
-                                  "indexlink" (commas (caddr i)) (car i)))
+            l))))
-                       (list (make-element 'newline '("/n"))
+  (list (make-delayed-flow-element contents)))
-                             (cond [(hash-table-get alpha-starts i #f)
-                                    => (lambda (let)
-                                         (make-element
-                                          (make-url-anchor
-                                           (format "alpha:~a" (char-upcase let)))
-                                          (list e)))]
-                                   [else e])))
-                     l)))))))
-  (list contents))
 
 ;; ----------------------------------------
 

collects/scribble/html-render.ss

@@ -66,6 +66,89 @@
               (loop (substring s (cdar m)))))]
        [else s])))
 
+  (define literal
+    (let ([loc (xml:make-location 0 0 0)])
+      (lambda strings (xml:make-cdata loc loc (apply string-append strings)))))
+  (define (script . body)
+    `(script ((type "text/javascript"))
+       ,(apply literal
+               `("\n"
+                 ,@(map (lambda (x) (if (string? x) x (format "~a" x))) body)
+                 "\n"))))
+
+  #reader scribble/reader
+  (define search-script
+    @script{
+      var search_nodes = null;
+      var last_search_terms = null;
+      function node_to_text(node) {
+        if (node.nodeType == 3) return node.nodeValue;
+        var r = "";
+        var children = node.childNodes;
+        for (var i=0@";" i<children.length@";" i++) {
+          r = r + node_to_text(children[i]);
+        }
+        return r;
+      }
+      function initialize_search() {
+        var all_links = document.getElementsByTagName("a");
+        search_nodes = new Array();
+        for (var i=0@";" i<all_links.length@";" i++)
+          if (all_links[i].className == "indexlink") {
+            all_links[i].flat_text = node_to_text(all_links[i]).toLowerCase();
+            search_nodes.push(all_links[i]);
+          }
+        var search_box = document.getElementById("search_box");
+        if (location.search.indexOf('?q=') == 0) {
+          var search = location.search.substring(3)
+          search_box.value = search;
+        }
+        if (search_box.value != "") do_search(search_box.value);
+        search_box.focus();
+        search_box.select();
+      }
+      window.onload = initialize_search;
+      function do_search(terms) {
+        terms = terms.toLowerCase();
+        if (terms == last_search_terms) return;
+        last_search_terms = terms;
+        terms = terms.split(/ +/);
+        var none = true;
+        for (var i=0@";" i<search_nodes.length@";" i++) {
+          var show = true, curtext = search_nodes[i].flat_text;
+          for (var j=0@";" j<terms.length@";" j++) {
+            if (terms[j] != "" && curtext.indexOf(terms[j]) < 0) {
+              show = false;
+              break;
+            }
+          }
+          if (show) none = false;
+          var style = search_nodes[i].style;
+          var newdisp = show ? "block" : "none";
+          if (newdisp != style.display) style.display = newdisp;
+        }
+        search_box.style.backgroundColor = none ? "#ffe0e0" : "white";
+      }
+      var search_timer = null;
+      function delayed_search(str, event) {
+        if (event && event.keyCode == 13) {
+          do_search(str);
+        } else {
+          if (search_timer != null) {
+            var t = search_timer;
+            search_timer = null;
+            clearTimeout(t);
+          }
+          search_timer = setTimeout(function(){do_search(str)@";"}, 1000);
+        }
+      }})
+
+  #reader scribble/reader
+  (define search-field
+    @`p{Search: @(input ((type "text") (id "search_box")
+                         (onChange "delayed_search(this.value,event);")
+                         (onKeyUp "delayed_search(this.value,event);")))})
+
   ;; ----------------------------------------
   ;;  main mixin
 
@@ -632,7 +715,9 @@
            [else (super render-element e part ri)])))
 
       (define/override (render-table t part ri)
-        `((table ((cellspacing "0")
+        (define index? (eq? 'index (table-style t)))
+        `(,@(if index? `(,search-script ,search-field) '())
+          (table ((cellspacing "0")
                   ,@(case (table-style t)
                       [(boxed)    '((class "boxed"))]
                       [(centered) '((align "center"))]