home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / TCL / BLT / BLT1.7L1 / BLT1 / blt-1.7 / applications / extloader / demos / blt / htext < prev   
Encoding:
Text File  |  1994-04-22  |  2.8 KB  |  111 lines
  1. #!../../wish -f
  2.  
  3. set env(TCL_EXTMAP) "./extensions.tcl"
  4. extension add blt
  5.  
  6. option add *Blt_htext.foreground navyblue
  7.  
  8. proc Blt_HtFindPattern { htext } {
  9.     toplevel .search
  10.     wm title .search "Text search"
  11.     label .search.label1 -text "Enter text string"
  12.     entry .search.entry -relief sunken
  13.     label .search.label2 -text "Direction:"
  14.     set varName direction$htext
  15.     radiobutton .search.forward -text "forward" -value "forward" \
  16.     -variable $varName -relief flat
  17.     radiobutton .search.backward -text "backward" -value "backward" \
  18.     -variable $varName -relief flat
  19.     global $varName 
  20.     set $varName "forward"
  21.     button .search.cancel -text "dismiss" \
  22.     -command "destroy .search; focus $htext"
  23.     button .search.search -text "search" -command "Blt_HtSearch&Move $htext"
  24.     bind .search.entry <Return> "Blt_HtSearch&Move $htext"
  25.     blt_table .search \
  26.     .search.label1     0,0 -cspan 3 -padx 4 \
  27.     .search.entry     1,0 -cspan 3 -pady 4 -padx 4 -reqwidth 3i \
  28.     .search.label2  2,0  \
  29.     .search.forward 2,1 -reqwidth 1i -anchor w \
  30.     .search.backward 2,2 -reqwidth 1i -anchor w \
  31.     .search.search  3,0 -reqwidth .75i -anchor w -padx 10 -pady 5  \
  32.     .search.cancel    3,2 -reqwidth .75i -anchor e -padx 10 -pady 5 
  33.     focus .search.entry
  34.     bind .search <Visibility> { raise .search }
  35. }
  36.        
  37.  
  38. proc Blt_HtSearch&Move { htext } {
  39.     set pattern [.search.entry get]
  40.     if { $pattern == "" } {
  41.     return
  42.     }
  43.     set pattern "*$pattern*"
  44.     
  45.     set varName direction$htext
  46.     global $varName
  47.     set curPos [$htext gotoline]
  48.     if { [set $varName] == "forward" } {
  49.     set last end ; set first [expr $curPos+1]
  50.     } else {
  51.     set last 1   ; set first [expr $curPos-1]
  52.     }
  53.     set newPos [$htext search $pattern $first $last]
  54.     if { ($newPos == -1) || ($newPos == $curPos) } {
  55.     blt_bell
  56.     } else {
  57.     $htext gotoline $newPos
  58.     }
  59. }
  60.  
  61. # Create horizonatal and vertical scrollbars
  62. scrollbar .vscroll -command { .htext yview } -orient vertical 
  63. scrollbar .hscroll -command { .htext xview } -orient horizontal
  64.  
  65. # Create the hypertext widget 
  66. blt_htext .htext -file ./htext.txt \
  67.     -yscrollcommand { .vscroll set } \
  68.     -xscrollcommand { .hscroll set } \
  69.     -height 6i \
  70.     -yscrollunits 10m \
  71.     -xscrollunits .25i 
  72.  
  73. blt_table . \
  74.     .htext 0,0 -fill both \
  75.     .vscroll 0,1 -fill y \
  76.     .hscroll 1,0 -fill x 
  77.  
  78. blt_table row . configure 1 -resize none
  79. blt_table column . configure 1 -resize none
  80.  
  81. bind .htext <B2-Motion> {
  82.     %W scan dragto %x %y
  83. }
  84. bind .htext <2> {
  85.     %W scan mark %x %y
  86. }
  87.  
  88. bind .htext <Control-p> { 
  89.     %W gotoline [expr [%W gotoline]-1] 
  90. }
  91. bind .htext <Control-n> { 
  92.     %W gotoline [expr [%W gotoline]+1] 
  93. }
  94.  
  95. bind .htext <Control-v> { 
  96.     %W yview [expr [%W yview]+10]
  97. }
  98. bind .htext <Meta-v> { 
  99.     %W yview [expr [%W yview]-10]
  100. }
  101. bind .htext <Any-q> {
  102.     exit 0
  103. }
  104. bind .htext <Control-s> {
  105.     Blt_HtFindPattern %W
  106. }
  107.  
  108. focus .htext
  109. wm min . 0 0
  110.  
  111.