HP/util/HP/lib/blt2.4/bltHiertable.tcl

   1 # bltHiertable.tcl
   2 # ----------------------------------------------------------------------
   3 # Bindings for the BLT hiertable widget
   4 # ----------------------------------------------------------------------
   5 #   AUTHOR:  George Howlett
   6 #            Bell Labs Innovations for Lucent Technologies
   7 #            gah@lucent.com
   8 #            http://www.tcltk.com/blt
   9 #
  10 #      RCS:  $Id: bltHiertable.tcl,v 1.18 2000/06/23 00:40:05 gah Exp $
  11 #
  12 # ----------------------------------------------------------------------
  13 # Copyright (c) 1998  Lucent Technologies, Inc.
  14 # ======================================================================
  15 #
  16 # Permission to use, copy, modify, and distribute this software and its
  17 # documentation for any purpose and without fee is hereby granted,
  18 # provided that the above copyright notice appear in all copies and that
  19 # both that the copyright notice and warranty disclaimer appear in
  20 # supporting documentation, and that the names of Lucent Technologies
  21 # any of their entities not be used in advertising or publicity
  22 # pertaining to distribution of the software without specific, written
  23 # prior permission.
  24 #
  25 # Lucent Technologies disclaims all warranties with regard to this
  26 # software, including all implied warranties of merchantability and
  27 # fitness.  In no event shall Lucent be liable for any special, indirect
  28 # or consequential damages or any damages whatsoever resulting from loss
  29 # of use, data or profits, whether in an action of contract, negligence
  30 # or other tortuous action, arising out of or in connection with the use
  31 # or performance of this software.
  32 #
  33 # ======================================================================
  34
  35 namespace eval blt::Hiertable {
  36     set afterId ""
  37     set scroll 0
  38     set column ""
  39     set space   off
  40     set x 0
  41     set y 0
  42 }
  43
  44 #
  45 # ButtonPress assignments
  46 #
  47 #       B1-Enter        start auto-scrolling
  48 #       B1-Leave        stop auto-scrolling
  49 #       ButtonPress-2   start scan
  50 #       B2-Motion       adjust scan
  51 #       ButtonRelease-2 stop scan
  52 #
  53
  54 bind Hiertable <ButtonPress-2> {
  55     set blt::Hiertable::cursor [%W cget -cursor]
  56     %W configure -cursor hand1
  57     %W scan mark %x %y
  58 }
  59
  60 bind Hiertable <B2-Motion> {
  61     %W scan dragto %x %y
  62 }
  63
  64 bind Hiertable <ButtonRelease-2> {
  65     %W configure -cursor $blt::Hiertable::cursor
  66 }
  67
  68 bind Hiertable <B1-Leave> {
  69     if { $blt::Hiertable::scroll } {
  70         blt::Hiertable::AutoScroll %W
  71     }
  72 }
  73
  74 bind Hiertable <B1-Enter> {
  75     after cancel $blt::Hiertable::afterId
  76 }
  77
  78 #
  79 # KeyPress assignments
  80 #
  81 #       Up
  82 #       Down
  83 #       Shift-Up
  84 #       Shift-Down
  85 #       Prior (PageUp)
  86 #       Next  (PageDn)
  87 #       Left
  88 #       Right
  89 #       space           Start selection toggle of entry currently with focus.
  90 #       Return          Start selection toggle of entry currently with focus.
  91 #       Home
  92 #       End
  93 #       F1
  94 #       F2
  95 #       ASCII char      Go to next open entry starting with character.
  96 #
  97 # KeyRelease
  98 #
  99 #       space           Stop selection toggle of entry currently with focus.
 100 #       Return          Stop selection toggle of entry currently with focus.
 101
 102
 103 bind Hiertable <KeyPress-Up> {
 104     blt::Hiertable::MoveFocus %W up
 105     if { $blt::Hiertable::space } {
 106         %W selection toggle focus
 107     }
 108 }
 109
 110 bind Hiertable <KeyPress-Down> {
 111     blt::Hiertable::MoveFocus %W down
 112     if { $blt::Hiertable::space } {
 113         %W selection toggle focus
 114     }
 115 }
 116
 117 bind Hiertable <Shift-KeyPress-Up> {
 118     blt::Hiertable::MoveFocus %W prevsibling
 119 }
 120
 121 bind Hiertable <Shift-KeyPress-Down> {
 122     blt::Hiertable::MoveFocus %W nextsibling
 123 }
 124
 125 bind Hiertable <KeyPress-Prior> {
 126     blt::Hiertable::MovePage %W top
 127 }
 128
 129 bind Hiertable <KeyPress-Next> {
 130     blt::Hiertable::MovePage %W bottom
 131 }
 132
 133 bind Hiertable <KeyPress-Left> {
 134     %W close focus
 135 }
 136 bind Hiertable <KeyPress-Right> {
 137     %W open focus
 138     %W see focus -anchor w
 139 }
 140
 141 bind Hiertable <KeyPress-space> {
 142     if { [%W cget -selectmode] == "single" } {
 143         if { [%W selection includes focus] } {
 144             %W selection clearall
 145         } else {
 146             %W selection clearall
 147             %W selection set focus
 148         }
 149     } else {
 150         %W selection toggle focus
 151     }
 152     set blt::Hiertable::space on
 153 }
 154
 155 bind Hiertable <KeyRelease-space> {
 156     set blt::Hiertable::space off
 157 }
 158
 159 bind Hiertable <KeyPress-Return> {
 160     blt::Hiertable::MoveFocus %W focus
 161     set blt::Hiertable::space on
 162 }
 163
 164 bind Hiertable <KeyRelease-Return> {
 165     set blt::Hiertable::space off
 166 }
 167
 168 bind Hiertable <KeyPress> {
 169     blt::Hiertable::NextMatchingEntry %W %A
 170 }
 171
 172 bind Hiertable <KeyPress-Home> {
 173     blt::Hiertable::MoveFocus %W top
 174 }
 175
 176 bind Hiertable <KeyPress-End> {
 177     blt::Hiertable::MoveFocus %W bottom
 178 }
 179
 180 bind Hiertable <KeyPress-F1> {
 181     %W open -r root
 182 }
 183
 184 bind Hiertable <KeyPress-F2> {
 185     eval %W close -r [%W entry children root]
 186 }
 187
 188 #
 189 # Differences between "current" and nearest.
 190 #
 191 #       set index [$widget index current]
 192 #       set index [$widget nearest $x $y]
 193 #
 194 #       o Nearest gives you the closest entry.
 195 #       o current is "" if
 196 #          1) the pointer isn't over an entry.
 197 #          2) the pointer is over a open/close button.
 198 #          3)
 199 #
 200 #
 201 # ----------------------------------------------------------------------
 202 #
 203 # USAGE: blt::Hiertable::Init <hiertable>
 204 #
 205 # Invoked by internally by Hiertable_Init routine.  Initializes the
 206 # default bindings for the hiertable widget entries.  These are local
 207 # to the widget, so they can't be set through the widget's class
 208 # bind tags.
 209 #
 210 # Arguments:    hiertable               hierarchy widget
 211 #
 212 # ----------------------------------------------------------------------
 213 proc blt::Hiertable::Init { widget } {
 214     #
 215     # Active entry bindings
 216     #
 217     $widget bind Entry <Enter> {
 218         %W entry highlight current
 219     }
 220     $widget bind Entry <Leave> {
 221         %W entry highlight ""
 222     }
 223
 224     #
 225     # Button bindings
 226     #
 227     $widget button bind all <ButtonRelease-1> {
 228         %W see -anchor nw current
 229         %W toggle current
 230     }
 231     $widget button bind all <Enter> {
 232         %W button highlight current
 233     }
 234     $widget button bind all <Leave> {
 235         %W button highlight ""
 236     }
 237
 238     #
 239     # ButtonPress-1
 240     #
 241     #   Performs the following operations:
 242     #
 243     #   1. Clears the previous selection.
 244     #   2. Selects the current entry.
 245     #   3. Sets the focus to this entry.
 246     #   4. Scrolls the entry into view.
 247     #   5. Sets the selection anchor to this entry, just in case
 248     #      this is "multiple" mode.
 249     #
 250
 251     $widget bind Entry <ButtonPress-1> {
 252         blt::Hiertable::SetSelectionAnchor %W current
 253         set blt::Hiertable::scroll 1
 254     }
 255
 256     $widget bin Entry <Double-ButtonPress-1> {
 257         %W toggle current
 258     }
 259
 260     #
 261     # B1-Motion
 262     #
 263     #   For "multiple" mode only.  Saves the current location of the
 264     #   pointer for auto-scrolling.  Resets the selection mark.
 265     #
 266     $widget bind Entry <B1-Motion> {
 267         set blt::Hiertable::x %x
 268         set blt::Hiertable::y %y
 269         set index [%W nearest %x %y]
 270         if { [%W cget -selectmode] == "multiple" } {
 271             %W selection mark $index
 272         } else {
 273             blt::Hiertable::SetSelectionAnchor %W $index
 274         }
 275     }
 276
 277     #
 278     # ButtonRelease-1
 279     #
 280     #   For "multiple" mode only.
 281     #
 282     $widget bind Entry <ButtonRelease-1> {
 283         if { [%W cget -selectmode] == "multiple" } {
 284             %W selection anchor current
 285         }
 286         after cancel $blt::Hiertable::afterId
 287         set blt::Hiertable::scroll 0
 288     }
 289
 290     #
 291     # Shift-ButtonPress-1
 292     #
 293     #   For "multiple" mode only.
 294     #
 295
 296     $widget bind Entry <Shift-ButtonPress-1> {
 297         if { [%W cget -selectmode] == "multiple" && [%W selection present] } {
 298             if { [%W index anchor] == "" } {
 299                 %W selection anchor current
 300             }
 301             set index [%W index anchor]
 302             %W selection clearall
 303             %W selection set $index current
 304         } else {
 305             blt::Hiertable::SetSelectionAnchor %W current
 306         }
 307     }
 308     $widget bin Entry <Shift-Double-ButtonPress-1> {
 309         puts <Shift-Double-ButtonPress-1>
 310         # do nothing
 311     }
 312     $widget bind Entry <Shift-B1-Motion> {
 313         # do nothing
 314     }
 315     $widget bind Entry <Shift-ButtonRelease-1> {
 316         after cancel $blt::Hiertable::afterId
 317         set blt::Hiertable::scroll 0
 318     }
 319
 320     #
 321     # Control-ButtonPress-1
 322     #
 323     #   For "multiple" mode only.
 324     #
 325     $widget bind Entry <Control-ButtonPress-1> {
 326         if { [%W cget -selectmode] == "multiple" } {
 327             set index [%W index current]
 328             %W selection toggle $index
 329             %W selection anchor $index
 330         } else {
 331             blt::Hiertable::SetSelectionAnchor %W current
 332         }
 333     }
 334     $widget bin Entry <Control-Double-ButtonPress-1> {
 335         puts <Control-Double-ButtonPress-1>
 336         # do nothing
 337     }
 338     $widget bind Entry <Control-B1-Motion> {
 339         # do nothing
 340     }
 341     $widget bind Entry <Control-ButtonRelease-1> {
 342         after cancel $blt::Hiertable::afterId
 343         set blt::Hiertable::scroll 0
 344     }
 345
 346     $widget bind Entry <Control-Shift-ButtonPress-1> {
 347         if { [%W cget -selectmode] == "multiple" && [%W selection present] } {
 348             if { [%W index anchor] == "" } {
 349                 %W selection anchor current
 350             }
 351             if { [%W selection includes anchor] } {
 352                 %W selection set anchor current
 353             } else {
 354                 %W selection clear anchor current
 355                 %W selection set current
 356             }
 357         } else {
 358             blt::Hiertable::SetSelectionAnchor %W current
 359         }
 360     }
 361     $widget bin Entry <Control-Shift-Double-ButtonPress-1> {
 362         puts <Control-Shift-Double-ButtonPress-1>
 363         # do nothing
 364     }
 365     $widget bind Entry <Control-Shift-B1-Motion> {
 366         # do nothing
 367     }
 368     $widget column bind all <Enter> {
 369         %W column highlight [%W column current]
 370     }
 371     $widget column bind all <Leave> {
 372         %W column highlight ""
 373     }
 374     $widget column bind Rule <Enter> {
 375         %W column highlight [%W column current]
 376         %W column resize activate [%W column current]
 377     }
 378     $widget column bind Rule <Leave> {
 379         %W column highlight ""
 380         %W column resize activate ""
 381     }
 382     $widget column bind Rule <ButtonPress-1> {
 383         %W column resize anchor %x
 384     }
 385     $widget column bind Rule <B1-Motion> {
 386         %W column resize mark %x
 387     }
 388     $widget column bind Rule <ButtonRelease-1> {
 389         %W column configure [%W column current] -width [%W column resize set]
 390     }
 391     $widget column bind all <ButtonRelease-1> {
 392         set column [%W column nearest %x %y]
 393         if { $column != "" } {
 394             %W column invoke $column
 395         }
 396     }
 397 }
 398
 399 # ----------------------------------------------------------------------
 400 # USAGE: blt::Hiertable::AutoScroll <hiertable>
 401 #
 402 # Invoked when the user is selecting elements in a hiertable widget
 403 # and drags the mouse pointer outside of the widget.  Scrolls the
 404 # view in the direction of the pointer.
 405 #
 406 # Arguments:    hiertable               hierarchy widget
 407 #
 408 # ----------------------------------------------------------------------
 409 proc blt::Hiertable::AutoScroll { widget } {
 410     if { ![winfo exists $widget] } {
 411         return
 412     }
 413     set x $blt::Hiertable::x
 414     set y $blt::Hiertable::y
 415
 416     set index [$widget nearest $x $y]
 417     if { $y >= [winfo height $widget] } {
 418         $widget yview scroll 1 units
 419         set neighbor down
 420     } elseif { $y < 0 } {
 421         $widget yview scroll -1 units
 422         set neighbor up
 423     } else {
 424         set neighbor $index
 425     }
 426     if { [$widget cget -selectmode] == "single" } {
 427         blt::Hiertable::SetSelectionAnchor $widget $neighbor
 428     } else {
 429         $widget selection mark $index
 430     }
 431     set ::blt::Hiertable::afterId [after 10 blt::Hiertable::AutoScroll $widget]
 432 }
 433
 434 proc blt::Hiertable::SetSelectionAnchor { widget index } {
 435     set index [$widget index $index]
 436     $widget selection clearall
 437     $widget see $index
 438     $widget focus $index
 439     $widget selection set $index
 440     $widget selection anchor $index
 441 }
 442
 443 # ----------------------------------------------------------------------
 444 # USAGE: blt::Hiertable::MoveFocus <hiertable> <where>
 445 #
 446 # Invoked by KeyPress bindings.  Moves the active selection to the
 447 # entry <where>, which is an index such as "up", "down", "prevsibling",
 448 # "nextsibling", etc.
 449 # ----------------------------------------------------------------------
 450 proc blt::Hiertable::MoveFocus { widget where } {
 451     catch {$widget focus $where}
 452     if { [$widget cget -selectmode] == "single" } {
 453         $widget selection clearall
 454         $widget selection set focus
 455     }
 456     $widget see focus
 457 }
 458
 459 # ----------------------------------------------------------------------
 460 # USAGE: blt::Hiertable::MovePage <hiertable> <where>
 461 # Arguments:    hiertable               hierarchy widget
 462 #
 463 # Invoked by KeyPress bindings.  Pages the current view up or down.
 464 # The <where> argument should be either "top" or "bottom".
 465 # ----------------------------------------------------------------------
 466
 467 proc blt::Hiertable::MovePage { widget where } {
 468
 469     # If the focus is already at the top/bottom of the window, we want
 470     # to scroll a page. It's really one page minus an entry because we
 471     # want to see the last entry on the next/last page.
 472     if { [$widget index focus] == [$widget index view.$where] } {
 473         if {$where == "top"} {
 474             $widget yview scroll -1 pages
 475             $widget yview scroll 1 units
 476         } else {
 477             $widget yview scroll 1 pages
 478             $widget yview scroll -1 units
 479         }
 480     }
 481     update
 482
 483     # Adjust the entry focus and the view.  Also activate the entry.
 484     # just in case the mouse point is not in the widget.
 485     $widget entry highlight view.$where
 486     $widget focus view.$where
 487     $widget see view.$where
 488     if { [$widget cget -selectmode] == "single" } {
 489         $widget selection clearall
 490         $widget selection set focus
 491     }
 492 }
 493
 494 # ----------------------------------------------------------------------
 495 # USAGE: blt::Hiertable::NextMatchingEntry <hiertable> <char>
 496 # Arguments:    hiertable               hierarchy widget
 497 #
 498 # Invoked by KeyPress bindings.  Searches for an entry that starts
 499 # with the letter <char> and makes that entry active.
 500 # ----------------------------------------------------------------------
 501
 502 proc blt::Hiertable::NextMatchingEntry { widget key } {
 503     if {[string match {[ -~]} $key]} {
 504         set last [$widget index focus]
 505         set next [$widget index next]
 506         while { $next != $last } {
 507             set label [$widget entry cget $next -label]
 508             if { [string index $label 0] == $key } {
 509                 break
 510             }
 511             set next [$widget index -at $next next]
 512         }
 513         $widget focus $next
 514         if {[$widget cget -selectmode] == "single"} {
 515             $widget selection clearall
 516             $widget selection set focus
 517         }
 518         $widget see focus
 519     }
 520 }
 521
 522 #
 523 #  Edit mode assignments
 524 #
 525 #       ButtonPress-3   Enables/disables edit mode on entry.  Sets focus to
 526 #                       entry.
 527 #
 528 #  KeyPress
 529 #
 530 #       Left            Move insertion position to previous.
 531 #       Right           Move insertion position to next.
 532 #       Up              Move insertion position up one line.
 533 #       Down            Move insertion position down one line.
 534 #       Return          End edit mode.
 535 #       Shift-Return    Line feed.
 536 #       Home            Move to first position.
 537 #       End             Move to last position.
 538 #       ASCII char      Insert character left of insertion point.
 539 #       Del             Delete character right of insertion point.
 540 #       Delete          Delete character left of insertion point.
 541 #       Ctrl-X          Cut
 542 #       Ctrl-V          Copy
 543 #       Ctrl-P          Paste
 544 #
 545 #  KeyRelease
 546 #
 547 #  ButtonPress-1        Start selection if in entry, otherwise clear selection.
 548 #  B1-Motion            Extend/reduce selection.
 549 #  ButtonRelease-1      End selection if in entry, otherwise use last selection.
 550 #  B1-Enter             Disabled.
 551 #  B1-Leave             Disabled.
 552 #  ButtonPress-2        Same as above.
 553 #  B2-Motion            Same as above.
 554 #  ButtonRelease-2      Same as above.
 555 #
 556 # All bindings in editting mode will "break" to override other bindings.
 557 #
 558 #
 559
 560 bind xEditor <ButtonPress-3> {
 561     set node [%W nearest %x %y]
 562     %W entry insert $node @%x,%y ""
 563 #    %W entry insert $node 2 ""
 564 }
 565
 566 if 0 {
 567 image create photo blt::Hiertable::CloseNormalFolder -format gif -data {
 568 R0lGODlhEAANAPIAAAAAAH9/f7+/v///////AAAAAAAAAAAAACH+JEZpbGUgd3JpdHRlbiBi
 569 eSBBZG9iZSBQaG90b3Nob3CoIDUuMAAsAAAAABAADQAAAzk4Gsz6cIQ44xqCZCGbk4MmclAA
 570 gNs4ml7rEaxVAkKc3gTAnBO+sbyQT6M7gVQpk9HlAhgHzqhUmgAAOw==
 571 }
 572 image create photo blt::Hiertable::OpenNormalFolder -format gif -data {
 573 R0lGODlhEAANAPIAAAAAAH9/f7+/v///AP///wAAAAAAAAAAACH+JEZpbGUgd3JpdHRlbiBi
 574 eSBBZG9iZSBQaG90b3Nob3CoIDUuMAAsAAAAABAADQAAAzNIGsz6kAQxqAjxzcpvc1KWBUDY
 575 nRQZWmilYi37EmztlrAt43R8mzrO60P8lAiApHK5TAAAOw==
 576 }
 577 image create photo blt::Hiertable::CloseActiveFolder -format gif -data {
 578 R0lGODlhEAANAPIAAAAAAH9/f7+/v/////+/AAAAAAAAAAAAACH+JEZpbGUgd3JpdHRlbiBi
 579 eSBBZG9iZSBQaG90b3Nob3CoIDUuMAAsAAAAABAADQAAAzk4Gsz6cIQ44xqCZCGbk4MmclAA
 580 gNs4ml7rEaxVAkKc3gTAnBO+sbyQT6M7gVQpk9HlAhgHzqhUmgAAOw==
 581 }
 582 image create photo blt::Hiertable::OpenActiveFolder -format gif -data {
 583 R0lGODlhEAANAPIAAAAAAH9/f7+/v/+/AP///wAAAAAAAAAAACH+JEZpbGUgd3JpdHRlbiBi
 584 eSBBZG9iZSBQaG90b3Nob3CoIDUuMAAsAAAAABAADQAAAzNIGsz6kAQxqAjxzcpvc1KWBUDY
 585 nRQZWmilYi37EmztlrAt43R8mzrO60P8lAiApHK5TAAAOw==
 586 }
 587 }
 588
 589 image create photo blt::Hiertable::CloseNormalFolder -format gif -data {
 590 R0lGODlhEAANAMIAAAAAAH9/f///////AL+/vwAA/wAAAAAAACH5BAEAAAUALAAAAAAQAA0A
 591 AAM8WBrM+rAEQWmIb5KxiWjNInCkV32AJHRlGQBgDA7vdN4vUa8tC78qlrCWmvRKsJTquHkp
 592 ZTKAsiCtWq0JADs=
 593 }
 594 image create photo blt::Hiertable::OpenNormalFolder -format gif -data {
 595 R0lGODlhEAANAMIAAAAAAH9/f///////AL+/vwAA/wAAAAAAACH5BAEAAAUALAAAAAAQAA0A
 596 AAM1WBrM+rAEMigJ8c3Kb3OSII6kGABhp1JnaK1VGwjwKwtvHqNzzd263M3H4n2OH1QBwGw6
 597 nQkAOw==
 598 }
 599 image create photo blt::Hiertable::CloseActiveFolder -format gif -data {
 600 R0lGODlhEAANAMIAAAAAAH9/f/////+/AL+/vwAA/wAAAAAAACH5BAEAAAUALAAAAAAQAA0A
 601 AAM8WBrM+rAEQWmIb5KxiWjNInCkV32AJHRlGQBgDA7vdN4vUa8tC78qlrCWmvRKsJTquHkp
 602 ZTKAsiCtWq0JADs=
 603 }
 604 image create photo blt::Hiertable::OpenActiveFolder -format gif -data {
 605 R0lGODlhEAANAMIAAAAAAH9/f/////+/AL+/vwAA/wAAAAAAACH5BAEAAAUALAAAAAAQAA0A
 606 AAM1WBrM+rAEMigJ8c3Kb3OSII6kGABhp1JnaK1VGwjwKwtvHqNzzd263M3H4n2OH1QBwGw6
 607 nQkAOw==
 608 }
 609
 610
 611 if { $tcl_platform(platform) == "windows" } {
 612     if { $tk_version >= 8.3 } {
 613         set cursor "@[file join $blt_library htresize.cur]"
 614     } else {
 615         set cursor "size_we"
 616     }
 617     option add *Hiertable.ResizeCursor $cursor
 618 } else {
 619     option add *Hiertable.ResizeCursor \
 620         "@$blt_library/htresize.xbm $blt_library/htresize_m.xbm black white"
 621 }
 622
 623 # Standard Motif bindings:
 624
 625 bind HiertableEditor <ButtonPress-1> {
 626     [winfo parent %W] text icursor @%x,%y
 627 }
 628
 629 bind HiertableEditor <Left> {
 630     [winfo parent %W] text icursor last
 631 }
 632 bind HiertableEditor <Right> {
 633     [winfo parent %W] text icursor next
 634 }
 635 bind HiertableEditor <Shift-Left> {
 636     tkEntryKeySelect %W [expr {[%W index insert] - 1}]
 637     tkEntrySeeInsert %W
 638 }
 639 bind HiertableEditor <Shift-Right> {
 640     tkEntryKeySelect %W [expr {[%W index insert] + 1}]
 641     tkEntrySeeInsert %W
 642 }
 643
 644 bind HiertableEditor <Home> {
 645     [winfo parent %W] text icursor 0
 646 }
 647 bind HiertableEditor <Shift-Home> {
 648     tkEntryKeySelect %W 0
 649     tkEntrySeeInsert %W
 650 }
 651 bind HiertableEditor <End> {
 652     [winfo parent %W] text icursor end
 653 }
 654 bind HiertableEditor <Shift-End> {
 655     tkEntryKeySelect %W end
 656     tkEntrySeeInsert %W
 657 }
 658
 659 bind HiertableEditor <Delete> {
 660     if {[[winfo parent %W] text selection present]} {
 661         [winfo parent %W] delete sel.first sel.last
 662     } else {
 663         [winfo parent %W] delete insert
 664     }
 665 }
 666 bind HiertableEditor <BackSpace> {
 667     blt::Hiertable::EditorBackspace [winfo parent %W]
 668 }
 669
 670 bind HiertableEditor <Control-space> {
 671     [winfo parent %W] text selection from insert
 672 }
 673 bind HiertableEditor <Select> {
 674     [winfo parent %W] text selection from insert
 675 }
 676 bind HiertableEditor <Control-Shift-space> {
 677     [winfo parent %W] text selection adjust insert
 678 }
 679 bind HiertableEditor <Shift-Select> {
 680     [winfo parent %W] text selection adjust insert
 681 }
 682 bind HiertableEditor <Control-slash> {
 683     [winfo parent %W] text selection range 0 end
 684 }
 685 bind HiertableEditor <Control-backslash> {
 686     [winfo parent %W] text selection clear
 687 }
 688 bind HiertableEditor <KeyPress> {
 689     blt::Hiertable::Insert [winfo parent %W] %A
 690 }
 691
 692 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
 693 # Otherwise, if a widget binding for one of these is defined, the
 694 # <KeyPress> class binding will also fire and insert the character,
 695 # which is wrong.  Ditto for Escape, Return, and Tab.
 696
 697 bind HiertableEditor <Alt-KeyPress> {
 698     # nothing
 699 }
 700 bind HiertableEditor <Meta-KeyPress> {
 701     # nothing
 702 }
 703 bind HiertableEditor <Control-KeyPress> {
 704     # nothing
 705 }
 706 bind HiertableEditor <Escape> {
 707     [winfo parent %W] text cancel
 708 }
 709 bind HiertableEditor <Return> {
 710     [winfo parent %W] text apply
 711 }
 712 bind HiertableEditor <Shift-Return> {
 713     blt::Hiertable::Insert [winfo parent %W] "\n"
 714 }
 715 bind HiertableEditor <KP_Enter> {# nothing}
 716 bind HiertableEditor <Tab> {# nothing}
 717 if {![string compare $tcl_platform(platform) "macintosh"]} {
 718         bind HiertableEditor <Command-KeyPress> {# nothing}
 719 }
 720
 721 # On Windows, paste is done using Shift-Insert.  Shift-Insert already
 722 # generates the <<Paste>> event, so we don't need to do anything here.
 723 if {[string compare $tcl_platform(platform) "windows"]} {
 724     bind HiertableEditor <Insert> {
 725         catch {tkEntryInsert %W [selection get -displayof %W]}
 726     }
 727 }
 728
 729 # Additional emacs-like bindings:
 730
 731 bind HiertableEditor <Control-a> {
 732     tkEntrySetCursor %W 0
 733 }
 734 bind HiertableEditor <Control-b> {
 735     tkEntrySetCursor %W [expr {[%W index insert] - 1}]
 736 }
 737
 738 bind HiertableEditor <Control-d> {
 739     %W text delete insert
 740 }
 741 bind HiertableEditor <Control-e> {
 742     tkEntrySetCursor %W end
 743 }
 744 bind HiertableEditor <Control-f> {
 745     tkEntrySetCursor %W [expr {[%W index insert] + 1}]
 746 }
 747 bind HiertableEditor <Control-h> {
 748     blt::Hiertable::EditorBackspace [winfo parent %W]
 749 }
 750 bind HiertableEditor <Control-k> {
 751     %W text delete insert end
 752 }
 753 bind HiertableEditor <Control-t> {
 754     tkEntryTranspose %W
 755 }
 756 bind HiertableEditor <Meta-b> {
 757     tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
 758 }
 759 bind HiertableEditor <Meta-d> {
 760     %W delete insert [tkEntryNextWord %W insert]
 761 }
 762 bind Entry <Meta-f> {
 763     tkEntrySetCursor %W [tkEntryNextWord %W insert]
 764 }
 765 bind Entry <Meta-BackSpace> {
 766     %W delete [tkEntryPreviousWord %W insert] insert
 767 }
 768 bind Entry <Meta-Delete> {
 769     %W delete [tkEntryPreviousWord %W insert] insert
 770 }
 771
 772
 773 proc tkEntryKeySelect {w new} {
 774     if {![$w selection present]} {
 775         $w selection from insert
 776         $w selection to $new
 777     } else {
 778         $w selection adjust $new
 779     }
 780     $w icursor $new
 781 }
 782
 783 # blt::Hiertable::Insert --
 784 # Insert a string into an entry at the point of the insertion cursor.
 785 # If there is a selection in the entry, and it covers the point of the
 786 # insertion cursor, then delete the selection before inserting.
 787 #
 788 # Arguments:
 789 # w -           The entry window in which to insert the string
 790 # s -           The string to insert (usually just a single character)
 791
 792 proc blt::Hiertable::Insert {w s} {
 793     if {![string compare $s ""]} {
 794         return
 795     }
 796     $w text insert insert $s
 797 }
 798
 799 proc blt::xHiertableInsert {w s} {
 800     if {![string compare $s ""]} {
 801         return
 802     }
 803     catch {
 804         set insert [$w text index insert]
 805         if {([$w text index sel.first] <= $insert)
 806                 && ([$w text index sel.last] >= $insert)} {
 807             $w delete sel.first sel.last
 808         }
 809     }
 810     $w insert insert $s
 811     tkEntrySeeInsert $w
 812 }
 813
 814 # tkEntryBackspace --
 815 # Backspace over the character just before the insertion cursor.
 816 # If backspacing would move the cursor off the left edge of the
 817 # window, reposition the cursor at about the middle of the window.
 818 #
 819 # Arguments:
 820 # w -           The entry window in which to backspace.
 821
 822 proc blt::Hiertable::EditorBackspace w {
 823     if {[$w text selection present]} {
 824         $w text delete sel.first sel.last
 825     } else {
 826         set index [expr [$w text index insert] - 1]
 827         if { $index >= 0 } {
 828             $w text delete $index $index
 829         }
 830     }
 831 }
 832
 833 proc tkEntryBackspace w {
 834     if {[$w selection present]} {
 835         $w delete sel.first sel.last
 836     } else {
 837         set x [expr {[$w index insert] - 1}]
 838         if {$x >= 0} {$w delete $x}
 839         if {[$w index @0] >= [$w index insert]} {
 840             set range [$w xview]
 841             set left [lindex $range 0]
 842             set right [lindex $range 1]
 843             $w xview moveto [expr {$left - ($right - $left)/2.0}]
 844         }
 845     }
 846 }
 847
 848 # tkEntrySeeInsert --
 849 # Make sure that the insertion cursor is visible in the entry window.
 850 # If not, adjust the view so that it is.
 851 #
 852 # Arguments:
 853 # w -           The entry window.
 854
 855 proc tkEntrySeeInsert w {
 856     set c [$w index insert]
 857     set left [$w index @0]
 858     if {$left > $c} {
 859         $w xview $c
 860         return
 861     }
 862     set x [winfo width $w]
 863     if {$c > [$w index @[winfo width $w]]} {
 864         $w xview insert
 865     }
 866 }
 867
 868 # tkEntrySetCursor -
 869 # Move the insertion cursor to a given position in an entry.  Also
 870 # clears the selection, if there is one in the entry, and makes sure
 871 # that the insertion cursor is visible.
 872 #
 873 # Arguments:
 874 # w -           The entry window.
 875 # pos -         The desired new position for the cursor in the window.
 876
 877 proc tkEntrySetCursor {w pos} {
 878     $w icursor $pos
 879     $w selection clear
 880     tkEntrySeeInsert $w
 881 }
 882
 883 # tkEntryTranspose -
 884 # This procedure implements the "transpose" function for entry widgets.
 885 # It tranposes the characters on either side of the insertion cursor,
 886 # unless the cursor is at the end of the line.  In this case it
 887 # transposes the two characters to the left of the cursor.  In either
 888 # case, the cursor ends up to the right of the transposed characters.
 889 #
 890 # Arguments:
 891 # w -           The entry window.
 892
 893 proc tkEntryTranspose w {
 894     set i [$w index insert]
 895     if {$i < [$w index end]} {
 896         incr i
 897     }
 898     set first [expr {$i-2}]
 899     if {$first < 0} {
 900         return
 901     }
 902     set new [string index [$w get] [expr {$i-1}]][string index [$w get] $first]
 903     $w delete $first $i
 904     $w insert insert $new
 905     tkEntrySeeInsert $w
 906 }
 907
 908 # tkEntryNextWord --
 909 # Returns the index of the next word position after a given position in the
 910 # entry.  The next word is platform dependent and may be either the next
 911 # end-of-word position or the next start-of-word position after the next
 912 # end-of-word position.
 913 #
 914 # Arguments:
 915 # w -           The entry window in which the cursor is to move.
 916 # start -       Position at which to start search.
 917
 918 if {![string compare $tcl_platform(platform) "windows"]}  {
 919     proc tkEntryNextWord {w start} {
 920         set pos [tcl_endOfWord [$w get] [$w index $start]]
 921         if {$pos >= 0} {
 922             set pos [tcl_startOfNextWord [$w get] $pos]
 923         }
 924         if {$pos < 0} {
 925             return end
 926         }
 927         return $pos
 928     }
 929 } else {
 930     proc tkEntryNextWord {w start} {
 931         set pos [tcl_endOfWord [$w get] [$w index $start]]
 932         if {$pos < 0} {
 933             return end
 934         }
 935         return $pos
 936     }
 937 }
 938
 939 # tkEntryPreviousWord --
 940 #
 941 # Returns the index of the previous word position before a given
 942 # position in the entry.
 943 #
 944 # Arguments:
 945 # w -           The entry window in which the cursor is to move.
 946 # start -       Position at which to start search.
 947
 948 proc tkEntryPreviousWord {w start} {
 949     set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
 950     if {$pos < 0} {
 951         return 0
 952     }
 953     return $pos
 954 }
 955 # tkEntryGetSelection --
 956 #
 957 # Returns the selected text of the entry with respect to the -show option.
 958 #
 959 # Arguments:
 960 # w -         The entry window from which the text to get
 961
 962 proc tkEntryGetSelection {w} {
 963     set entryString [string range [$w get] [$w index sel.first] \
 964                        [expr [$w index sel.last] - 1]]
 965     if {[$w cget -show] != ""} {
 966       regsub -all . $entryString [string index [$w cget -show] 0] entryString
 967     }
 968     return $entryString
 969 }