contrib/httpd/browser-responder.factor

   1 ! Copyright (C) 2004 Chris Double.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: browser-responder
   4 USING: definitions hashtables help html httpd io kernel memory
   5 namespaces prettyprint sequences words xml ;
   6
   7 : option ( current text -- )
   8     #! Output the HTML option tag for the given text. If
   9     #! it is equal to the current string, make the option selected.
  10     <option tuck = [ "yes" =selected ] when option>
  11         chars>entities write
  12     </option> ;
  13
  14 : options ( current seq -- ) [ option ] each-with ;
  15
  16 : list ( current seq name -- )
  17     <select =name "width: 200px;" =style "20" =size "document.forms.main.submit()" =onchange select>
  18         options
  19     </select> ;
  20
  21 : current-vocab ( -- string )
  22     "vocab" query-param [ "kernel" ] unless* ;
  23
  24 : current-word ( -- word )
  25     "word" query-param "vocab" query-param lookup ;
  26
  27 : vocab-list ( -- )
  28     current-vocab vocabs "vocab" list ;
  29
  30 : word-list ( -- )
  31     current-word [ word-name ] [ f ] if*
  32     current-vocab vocab hash-keys natural-sort "word" list ;
  33
  34 : word-source ( -- )
  35     #! Write the source for the given word from the vocab as HTML.
  36     current-word [ [ see-help ] with-html-stream ] when* ;
  37
  38 : browser-body ( -- )
  39     #! Write out the HTML for the body of the main browser page.
  40     <table "100%" =width table>
  41         <tr>
  42             <th> "Vocabularies" write </th>
  43             <th> "Words" write </th>
  44             <th> "Documentation" write </th>
  45         </tr>
  46         <tr>
  47             <td "top" =valign "width: 200px;" =style td>
  48                 vocab-list
  49             </td>
  50             <td "top" =valign "width: 200px;" =style td>
  51                 word-list
  52             </td>
  53             <td "top" =valign td> word-source </td>
  54         </tr>
  55     </table> ;
  56
  57 : browser-title ( -- str )
  58     current-word
  59     [ summary ] [ "IN: " current-vocab append ] if* ;
  60
  61 : browser-responder ( -- )
  62     #! Display a Smalltalk like browser for exploring words.
  63     serving-html browser-title [
  64         <form "main" =name "" =action "get" =method form>
  65             browser-body
  66         </form>
  67     ] html-document ;