scripts/vartextbox.itk

   1 # vim: foldmarker=<<<,>>>
   2
   3 # Signals:
   4 #       onchange()                              fired when the data is changed
   5 #       onchange_text(newtext)  fired when the data is changed, passes new data
   6
   7 option add *Vartextbox.labelSticky              wn              widgetDefault
   8 option add *Vartextbox.labelPos                 wn              widgetDefault
   9 option add *Vartextbox.textBackground   white   widgetDefault
  10 option add *Vartextbox.width                    30              widgetDefault
  11 option add *Vartextbox.height                   4               widgetDefault
  12 option add *Vartextbox.wrap                             word    widgetDefault
  13 option add *Vartextbox.textBorderWidth  2               widgetDefault
  14 option add *Vartextbox.textRelief               sunken  widgetDefault
  15
  16 ::itk::usual tlc::Vartextbox {
  17         keep -font -cursor -textbackground -background
  18 }
  19
  20 proc tlc::vartextbox {pathName args} {
  21         uplevel tlc::Vartextbox $pathName $args
  22 }
  23
  24 class tlc::Vartextbox {
  25         inherit tlc::Border tlc::Handlers
  26
  27         constructor {args} {}
  28         destructor {}
  29
  30         itk_option define -textvariable textVariable Variable ""
  31 #       itk_option define -reservespace reserveSpace Bool 0
  32         itk_option define -state state State "normal"
  33         itk_option define -disabledbackground disabledBackground DisabledBackground $::tlc::config(disabledbackground)
  34         itk_option define -highlightargs highlightArgs HighlightArgs {-background yellow}
  35         itk_option define -highlightignorecase highlightIgnoreCase HighlightIgnoreCase 1 need_check_highlight
  36         itk_option define -wrap wrap Wrap word
  37         itk_option define -vscrollmode vScrollMode VScrollMode "fancy"
  38         itk_option define -hscrollmode vScrollMode VScrollMode "dynamic"
  39
  40         public {
  41                 variable highlight_text         ""              need_check_highlight
  42
  43                 method insert {index chars}
  44                 method force_reget {}
  45                 method need_check_highlight {}
  46         }
  47
  48         private {
  49                 variable w
  50                 variable old_textvariable       ""
  51                 variable lock                           0
  52                 variable after_id                       ""
  53                 variable highlightafterid       ""
  54
  55 #               variable xstate                         "shown"
  56 #               variable ystate                         "shown"
  57                 variable olddata                        ""
  58
  59                 method newvalue {args}
  60                 method newtext {}
  61                 method getnewtext {}
  62                 method check_highlight {}
  63
  64 #               method xtap {args}
  65 #               method ytap {args}
  66         }
  67 }
  68
  69
  70 configbody tlc::Vartextbox::wrap { #<<<1
  71         if {$itk_option(-wrap) == "none"} {
  72                 blt::table $w $w.hs             2,1 -fill x
  73         } else {
  74                 catch {blt::table forget $w.hs}
  75         }
  76 }
  77
  78
  79 configbody tlc::Vartextbox::highlightargs { #<<<1
  80         eval [list $itk_component(text) tag configure highlighted] $itk_option(-highlightargs)
  81 }
  82
  83
  84 configbody tlc::Vartextbox::state { #<<<1
  85         switch -- $itk_option(-state) {
  86                 "disabled" {
  87                         set tbg         $itk_option(-disabledbackground)
  88                 }
  89
  90                 default -
  91                 "normal" {
  92                         set tbg         $tlc::config(textbackground)
  93                 }
  94         }
  95
  96         [component text] configure -background $tbg
  97 }
  98
  99
 100 configbody tlc::Vartextbox::disabledbackground { #<<<1
 101         if {$itk_option(-state) == "disabled"} {
 102                 set tbg         $itk_option(-disabledbackground)
 103
 104                 [component text] configure -background $tbg
 105         }
 106 }
 107
 108
 109 #configbody tlc::Vartextbox::reservespace { #<<<1
 110 #       if {$itk_option(-reservespace)} {
 111 #               blt::table configure $w r2 -height $w.hs
 112 #               blt::table configure $w c2 -width $w.vs
 113 #       } else {
 114 #               blt::table configure $w r2 -height {}
 115 #               blt::table configure $w c2 -width {}
 116 #       }
 117 #}
 118
 119
 120 configbody tlc::Vartextbox::textvariable { #<<<1
 121         if {$old_textvariable != ""} {
 122                 trace vdelete $old_textvariable w [code $this newvalue]
 123         }
 124         if {$itk_option(-textvariable) != ""} {
 125                 trace variable $itk_option(-textvariable) wu [code $this newvalue]
 126                 set old_textvariable    $itk_option(-textvariable)
 127         }
 128         newvalue
 129 }
 130
 131
 132 configbody tlc::Vartextbox::hscrollmode { #<<<1
 133         if {[winfo exists $w.hs]} {
 134                 $w.hs configure -mode $itk_option(-hscrollmode)
 135         }
 136 }
 137
 138
 139 configbody tlc::Vartextbox::vscrollmode { #<<<1
 140         if {[winfo exists $w.vs]} {
 141                 $w.vs configure -mode $itk_option(-vscrollmode)
 142         }
 143 }
 144
 145
 146 body tlc::Vartextbox::constructor {args} { #<<<1
 147         set w   $itk_interior
 148
 149         itk_component add text {
 150                 text $w.text \
 151                         -xscrollcommand [list $w.hs set] \
 152                         -yscrollcommand [list $w.vs set]
 153         } {
 154                 usual
 155                 keep -state -font -foreground
 156                 keep -width -height -tabs
 157                 ignore -wrap
 158                 rename -background -textbackground textBackground Background
 159                 rename -highlightbackground -texthighlightbackground textHighlightBackground TextHighlightBackground
 160                 rename -borderwidth -textborderwidth textBorderWidth TextBorderWidth
 161                 rename -relief -textrelief textRelief TextRelief
 162         }
 163
 164         eval itk_initialize $args
 165
 166         myscrollbar_win32 $w.vs -orient v -command [list $w.text yview] \
 167                         -mode $itk_option(-vscrollmode)
 168
 169         myscrollbar_win32 $w.hs -orient h -command [list $w.text xview] \
 170                         -mode $itk_option(-hscrollmode)
 171 #       unless instructed otherwise, this box should have the background chrome
 172 #               color for the highlightbackground, like every other widget
 173         configure -texthighlightbackground [. cget -bg]
 174
 175         blt::table $w \
 176                 $w.text         1,1 -fill both \
 177                 $w.vs           1,2 -fill y
 178         blt::table configure $w r2 c2 -resize none
 179
 180         set anybinds    [bind Text]
 181         foreach binding $anybinds {
 182                 bind $itk_component(text) $binding "+[code $this getnewtext]"
 183         }
 184 }
 185
 186
 187 body tlc::Vartextbox::destructor {} { #<<<1
 188 #       set anybinds    [bind Text]
 189 #       foreach binding $anybinds {
 190 #               bind $itk_component(text) $binding ""
 191 #       }
 192
 193         after cancel $after_id; set after_id    ""
 194         after cancel $highlightafterid; set highlightafterid    ""
 195 }
 196
 197
 198 body tlc::Vartextbox::newvalue {args} { #<<<1
 199         if {[lindex $args 2] == "u"} {
 200                 log error "var unset"
 201                 error "var unset!"
 202         }
 203         if {$lock} return
 204
 205         set st  [$itk_component(text) cget -state]
 206         if {$st == "disabled"} {$itk_component(text) configure -state normal}
 207
 208         $itk_component(text) delete 1.0 end
 209         if {[info exists $itk_option(-textvariable)]} {
 210                 $itk_component(text) insert 1.0 [set $itk_option(-textvariable)]
 211         }
 212
 213         if {$st == "disabled"} {$itk_component(text) configure -state $st}
 214         need_check_highlight
 215 }
 216
 217
 218 body tlc::Vartextbox::newtext {} { #<<<1
 219         set after_id    ""
 220         if {$itk_option(-textvariable) == ""} return
 221         update idletasks
 222         set lock        1
 223         set tmp         [$itk_component(text) get 1.0 "end - 1 chars"]
 224         if {![info exists $itk_option(-textvariable)] || $tmp != [set $itk_option(-textvariable)]} {
 225                 uplevel #0 [list set $itk_option(-textvariable) $tmp]
 226         }
 227         invoke_handlers onchange
 228         invoke_handlers onchange_text $tmp
 229         need_check_highlight
 230         set lock        0
 231 }
 232
 233
 234 body tlc::Vartextbox::insert {index chars} { #<<<1
 235         return [$itk_component(text) insert $index $chars]
 236 }
 237
 238
 239 body tlc::Vartextbox::getnewtext {} { #<<<1
 240         if {$after_id != ""} return
 241         set after_id    [after idle [code $this newtext]]
 242 }
 243
 244
 245 #body tlc::Vartextbox::xtap {args} {
 246 #       foreach {op first last} $args {break}
 247 #       if {$first == 0.0 && $last == 1.0} {
 248 #               if {$xstate != "hidden"} {
 249 #                       blt::table forget $w.hs
 250 #                       set xstate      "hidden"
 251 #               }
 252 #       } else {
 253 #               if {$xstate != "shown"} {
 254 #                       blt::table $w $w.hs     2,1 -fill x
 255 #                       set xstate      "shown"
 256 #               }
 257 #       }
 258 #       uplevel $w.hs $args
 259 #}
 260
 261
 262 #body tlc::Vartextbox::ytap {args} {
 263 #       foreach {op first last} $args {break}
 264 #       if {$first == 0.0 && $last == 1.0} {
 265 #               if {$ystate != "hidden"} {
 266 #                       blt::table forget $w.vs
 267 #                       set ystate      "hidden"
 268 #               }
 269 #       } else {
 270 #               if {$ystate != "shown"} {
 271 #                       blt::table $w $w.vs     1,2 -fill y
 272 #                       set ystate      "shown"
 273 #               }
 274 #       }
 275 #       uplevel $w.vs $args
 276 #}
 277
 278
 279 body tlc::Vartextbox::force_reget {} { #<<<1
 280         getnewtext
 281 }
 282
 283
 284 body tlc::Vartextbox::need_check_highlight {} { #<<<1
 285         if {$highlightafterid != ""} return
 286         set highlightafterid    [after idle [code $this check_highlight]]
 287 }
 288
 289
 290 body tlc::Vartextbox::check_highlight {} { #<<<1
 291         after cancel $highlightafterid; set highlightafterid    ""
 292
 293         set text        [$itk_component(text) get 1.0 "end - 1 chars"]
 294         $itk_component(text) tag remove highlighted 1.0 end
 295
 296         if {$itk_option(-highlightignorecase)} {
 297                 set text                [string tolower $text]
 298                 set match               [string tolower $highlight_text]
 299         } else {
 300                 set match               $highlight_text
 301         }
 302
 303         if {$highlight_text == ""} return
 304
 305         set span        [string length $match]
 306
 307         set idx         0
 308         set done        0
 309         while {1} {
 310                 set idx         [string first $match $text $idx]
 311                 if {$idx == -1} break
 312                 set from        $idx
 313                 incr idx        $span
 314                 set to          $idx
 315                 $itk_component(text) tag add highlighted "1.0 + $from chars" "1.0 + $to chars"
 316                 incr idx
 317         }
 318 }
 319
 320