home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / mail / metamail / contrib / tk / richtext.tcl next >
Encoding:
Tcl/Tk script  |  1992-12-29  |  5.0 KB  |  226 lines
  1. #!/usr/local/bin/wish -f
  2. # 
  3. # Here is a simple TCL-based richtext interpreter.  It doesn't do a lot yet.
  4. # (It also crashes the OpenWindows server on my Sun, so I don't know if it
  5. # will crash yours.  I'm still looking into the crash thing.)  Once the
  6. # crash thing is fixed, I'll add more to it...
  7. # 
  8. # Anyway, try this:
  9. # 
  10. #     wish -f richtext.tcl < file.rt
  11. # 
  12. # and see what you think!
  13. # 
  14. # /mtr
  15. # 
  16. # 
  17. proc    richtext        {{w .richtext}} {
  18.     catch    {destroy $w}
  19.     toplevel    $w
  20.     wm title    $w        "Richtext"
  21.     wm iconname    $w        "rt"
  22.  
  23.     text    $w.text        -borderwidth 2 \
  24.                 -height 34 \
  25.                 -relief raised \
  26.                 -setgrid true \
  27.                 -width 80 \
  28.                 -wrap word \
  29.                 -yscrollcommand "$w.scroll set"
  30.     scrollbar    $w.scroll    -command "$w.text yview" \
  31.                 -relief flat
  32.     frame    $w.bot        -borderwidth 1
  33.     pack append    $w.bot        [button $w.bot.button \
  34.                     -command "destroy $w;destroy ." \
  35.                     -text Dismiss] \
  36.                     {top padx 5 pady 5 expand}
  37.  
  38.     pack append    $w        $w.bot \
  39.                     {bottom fillx} \
  40.                 $w.scroll \
  41.                     {right filly} \
  42.                 $w.text \
  43.                     {expand fill}
  44.  
  45.     $w.text tag    configure    bold \
  46.                     -font -*-courier-bold-r-normal-*-120-*
  47.     $w.text tag configure    italic \
  48.                     -font -*-courier-medium-o-normal-*-120-*
  49.     $w.text tag configure    bolditalic \
  50.                     -font -*-courier-bold-o-normal-*-120-*
  51.     $w.text tag configure    fixed \
  52.                     -font -*-courier-medium-r-normal-*-120-*
  53.  
  54.     $w.text tag configure    bigbold \
  55.                     -font -*-courier-bold-r-normal-*-140-*
  56.     $w.text tag configure    bigitalic \
  57.                     -font -*-courier-medium-o-normal-*-140-*
  58.     $w.text tag configure    bigbolditalic \
  59.                     -font -*-courier-bold-o-normal-*-140-*
  60.     $w.text tag configure    bigfixed \
  61.                     -font -*-courier-medium-r-normal-*-140-*
  62.  
  63.     $w.text tag configure    smallbold \
  64.                     -font -*-courier-bold-r-normal-*-100-*
  65.     $w.text tag configure    smallitalic \
  66.                     -font -*-courier-medium-o-normal-*-100-*
  67.     $w.text tag configure    smallbolditalic \
  68.                     -font -*-courier-bold-o-normal-*-100-*
  69.     $w.text tag configure    smallfixed \
  70.                     -font -*-courier-medium-r-normal-*-100-*
  71.  
  72.     $w.text tag configure    underline \
  73.                     -underline on
  74.  
  75.  
  76.     set        env(bold)    0
  77.     set        env(italic)    0
  78.     set        env(fixed)    0
  79.     set        env(smaller)    0
  80.     set        env(bigger)    0
  81.     set        env(underline)    0
  82.  
  83.     set        env(center)    0
  84.     set        env(flushleft)    0
  85.     set        env(flushright)    0
  86.     set        env(indent)    0
  87.     set        env(indentright) 0
  88.     set        env(outdent)    0
  89.     set        env(outdentright) 0
  90.     set        env(samepage)    0
  91.     set        env(superscript) 0
  92.     set        env(subscript)    0
  93.     set        env(heading)    0
  94.     set        env(footing)    0
  95.     set        env(excerpt)    0
  96.     set        env(paragraph)    0
  97.     set        env(signature)    0
  98.  
  99.     set        intoken        0
  100.     set        token        ""
  101.  
  102.     set        incomment    0
  103.  
  104.     set        output        ""
  105.     set        lasto        " "
  106.  
  107.  
  108.     while {[gets stdin buffer] > -1} {
  109.     set    len        [string length $buffer]
  110.  
  111.     if {(!$intoken) && ($lasto != " ")} {
  112.         append    output    [set lasto " "]
  113.     }
  114.  
  115.     for {set i 0} {$i < $len} {incr i} {
  116.         set    c        [string index $buffer $i]
  117.         if {$intoken} {
  118.         if {([string length $token] == 0) && ($c == "/")} {
  119.             set    intoken    -1
  120.             continue
  121.         }
  122.         if {$c != ">"} {
  123.             append    token    $c
  124.             continue
  125.         }
  126.  
  127.         set    command    [string tolower $token]
  128.         set    pos    $intoken
  129.  
  130.         set    intoken    0
  131.         set    token    ""
  132.  
  133.         if {$command == "comment"} {
  134.             if {[incr incomment $pos] < 0} {
  135.             set    incomment    0
  136.             }
  137.             if {$incomment > 0} {    continue }
  138.         }
  139.  
  140.         if {$command == "lt"} {
  141.             append    output    [set lasto "<"]
  142.             continue
  143.         }
  144.         if {($command == "nl") || ($command == "np")} {
  145.             append    output    "\n"
  146.             set        lasto    " "
  147.             continue
  148.         }
  149.  
  150.         if {[string length $output]} {
  151.             set    size    [expr $env(bigger)-$env(smaller)]
  152.             if {$size > 0} {
  153.                 set    font    "big"
  154.             } else {
  155.                 if {$size < 0} {
  156.                 set    font    "small"
  157.                 } else {
  158.                 set    font    ""
  159.                 }
  160.             }
  161.             if {$env(fixed) > 0} {
  162.                 append    font    "fixed"
  163.             } else {
  164.                 if {$env(bold) > 0} {
  165.                 append    font    "bold"
  166.                 }
  167.                 if {$env(italic) > 0} {
  168.                 append    font    "italic"
  169.                 }
  170.             }
  171.             set    tags    [list $font]
  172.             if {$env(underline) > 0} {
  173.                 append    tags    underline
  174.             }
  175.  
  176.             insertWithTags    $w.text $output $tags
  177.  
  178.             set    output        ""
  179.             set    lasto        " "
  180.         }
  181.  
  182.         catch    {
  183.             if {[incr env($command) $pos] < 0} {
  184.             set $env($command) 0
  185.             }
  186.         }
  187.         continue
  188.         }
  189.  
  190.         if {$c != "<"} {
  191.         if {!$incomment} {
  192.             append    output    [set lasto $c]
  193.         }
  194.         continue
  195.         }
  196.  
  197.         set    intoken        1
  198.     }
  199.     }
  200.  
  201.     insertWithTags $w.text    $output
  202. }
  203.  
  204. # The procedure below inserts text into a given text widget and
  205. # applies one or more tags to that text.  The arguments are:
  206. #
  207. # w        Window in which to insert
  208. # text        Text to insert (it's inserted at the "insert" mark)
  209. # args        One or more tags to apply to text.  If this is empty
  210. #        then all tags are removed from the text.
  211.  
  212. proc insertWithTags {w text args} {
  213.     set start [$w index insert]
  214.     $w insert insert $text
  215.     foreach tag [$w tag names $start] {
  216.     $w tag remove $tag $start insert
  217.     }
  218.     foreach i $args {
  219.     $w tag add $i $start insert
  220.     }
  221. }
  222.  
  223.  
  224. richtext
  225. wm withdraw .
  226.