Artifact
8ad6eccec733e7cc77d0f1026ab04be6700f3aaf:
0000: 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
0010: 20 73 6e 69 74 0a 0a 70 72 6f 63 20 73 65 74 21 snit..proc set!
0020: 20 7b 20 76 61 72 4e 61 6d 65 20 61 72 67 73 20 { varName args
0030: 7d 20 7b 0a 20 20 20 20 0a 20 20 20 20 75 70 76 } {. . upv
0040: 61 72 20 31 20 24 76 61 72 4e 61 6d 65 20 76 0a ar 1 $varName v.
0050: 20 20 20 20 69 66 20 7b 20 5b 6c 6c 65 6e 67 74 if { [llengt
0060: 68 20 24 61 72 67 73 5d 20 3d 3d 20 30 20 26 26 h $args] == 0 &&
0070: 20 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 76 ![info exists v
0080: 5d 20 7d 20 7b 0a 09 72 65 74 75 72 6e 20 22 22 ] } {..return ""
0090: 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 . }. retur
00a0: 6e 20 5b 75 70 6c 65 76 65 6c 20 31 20 5b 6c 69 n [uplevel 1 [li
00b0: 73 74 20 73 65 74 20 24 76 61 72 4e 61 6d 65 20 st set $varName
00c0: 7b 2a 7d 24 61 72 67 73 5d 5d 0a 7d 0a 0a 70 72 {*}$args]].}..pr
00d0: 6f 63 20 69 6e 66 6f 5f 66 75 6c 6c 61 72 67 73 oc info_fullargs
00e0: 20 7b 20 70 72 6f 63 6e 61 6d 65 20 7d 20 7b 0a { procname } {.
00f0: 20 20 20 20 73 65 74 20 72 65 74 20 22 22 0a 20 set ret "".
0100: 20 20 20 66 6f 72 65 61 63 68 20 61 72 67 20 5b foreach arg [
0110: 75 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 uplevel 1 [list
0120: 69 6e 66 6f 20 61 72 67 73 20 24 70 72 6f 63 6e info args $procn
0130: 61 6d 65 5d 5d 20 7b 0a 09 69 66 20 7b 20 5b 75 ame]] {..if { [u
0140: 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 69 plevel 1 [list i
0150: 6e 66 6f 20 64 65 66 61 75 6c 74 20 24 70 72 6f nfo default $pro
0160: 63 6e 61 6d 65 20 24 61 72 67 20 76 61 6c 75 65 cname $arg value
0170: 5d 5d 20 7d 20 7b 0a 09 20 20 20 20 75 70 76 61 ]] } {.. upva
0180: 72 20 31 20 76 61 6c 75 65 20 76 61 6c 75 65 0a r 1 value value.
0190: 09 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 74 . lappend ret
01a0: 20 5b 6c 69 73 74 20 24 61 72 67 20 24 76 61 6c [list $arg $val
01b0: 75 65 5d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 ue]..} else {..
01c0: 20 20 20 6c 61 70 70 65 6e 64 20 72 65 74 20 24 lappend ret $
01d0: 61 72 67 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 arg..}. }.
01e0: 20 72 65 74 75 72 6e 20 24 72 65 74 0a 7d 0a 0a return $ret.}..
01f0: 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c 20 63 namespace eval c
0200: 75 20 7b 7d 0a 6e 61 6d 65 73 70 61 63 65 20 65 u {}.namespace e
0210: 76 61 6c 20 63 75 3a 3a 66 69 6c 65 20 7b 7d 0a val cu::file {}.
0220: 0a 23 20 66 6f 72 20 74 63 6c 49 6e 64 65 78 20 .# for tclIndex
0230: 74 6f 20 77 6f 72 6b 20 0a 70 72 6f 63 20 63 75 to work .proc cu
0240: 3a 3a 6d 65 6e 75 62 75 74 74 6f 6e 5f 62 75 74 ::menubutton_but
0250: 74 6f 6e 20 7b 20 61 72 67 73 20 7d 20 7b 7d 0a ton { args } {}.
0260: 0a 73 6e 69 74 3a 3a 77 69 64 67 65 74 61 64 61 .snit::widgetada
0270: 70 74 6f 72 20 63 75 3a 3a 6d 65 6e 75 62 75 74 ptor cu::menubut
0280: 74 6f 6e 5f 62 75 74 74 6f 6e 20 7b 0a 20 20 20 ton_button {.
0290: 20 6f 70 74 69 6f 6e 20 2d 63 6f 6d 6d 61 6e 64 option -command
02a0: 20 22 22 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d "". option -
02b0: 69 6d 61 67 65 20 22 22 0a 20 20 20 20 6f 70 74 image "". opt
02c0: 69 6f 6e 20 2d 74 65 78 74 20 22 22 0a 0a 20 20 ion -text ""..
02d0: 20 20 64 65 6c 65 67 61 74 65 20 6d 65 74 68 6f delegate metho
02e0: 64 20 2a 20 74 6f 20 68 75 6c 6c 0a 20 20 20 20 d * to hull.
02f0: 64 65 6c 65 67 61 74 65 20 6f 70 74 69 6f 6e 20 delegate option
0300: 2a 20 74 6f 20 68 75 6c 6c 0a 20 20 20 20 64 65 * to hull. de
0310: 6c 65 67 61 74 65 20 6f 70 74 69 6f 6e 20 2d 5f legate option -_
0320: 69 6d 61 67 65 20 74 6f 20 68 75 6c 6c 20 61 73 image to hull as
0330: 20 2d 69 6d 61 67 65 0a 20 20 20 20 64 65 6c 65 -image. dele
0340: 67 61 74 65 20 6f 70 74 69 6f 6e 20 2d 5f 74 65 gate option -_te
0350: 78 74 20 74 6f 20 68 75 6c 6c 20 61 73 20 2d 74 xt to hull as -t
0360: 65 78 74 0a 0a 20 20 20 20 76 61 72 69 61 62 6c ext.. variabl
0370: 65 20 78 6d 69 6e 0a 20 20 20 20 76 61 72 69 61 e xmin. varia
0380: 62 6c 65 20 69 73 5f 62 75 74 74 6f 6e 5f 61 63 ble is_button_ac
0390: 74 69 76 65 20 31 0a 20 20 20 20 76 61 72 69 61 tive 1. varia
03a0: 62 6c 65 20 70 72 65 73 73 5f 61 66 74 65 72 20 ble press_after
03b0: 22 22 0a 20 20 20 20 0a 20 20 20 20 63 6f 6e 73 "". . cons
03c0: 74 72 75 63 74 6f 72 20 61 72 67 73 20 7b 0a 09 tructor args {..
03d0: 69 6e 73 74 61 6c 6c 68 75 6c 6c 20 75 73 69 6e installhull usin
03e0: 67 20 74 74 6b 3a 3a 6d 65 6e 75 62 75 74 74 6f g ttk::menubutto
03f0: 6e 20 2d 73 74 79 6c 65 20 54 6f 6f 6c 62 75 74 n -style Toolbut
0400: 74 6f 6e 0a 09 62 69 6e 64 20 24 77 69 6e 20 3c ton..bind $win <
0410: 42 75 74 74 6f 6e 50 72 65 73 73 2d 31 3e 20 5b ButtonPress-1> [
0420: 6d 79 6d 65 74 68 6f 64 20 42 50 31 20 25 78 20 mymethod BP1 %x
0430: 25 79 5d 0a 09 62 69 6e 64 20 24 77 69 6e 20 3c %y]..bind $win <
0440: 42 75 74 74 6f 6e 52 65 6c 65 61 73 65 2d 31 3e ButtonRelease-1>
0450: 20 5b 6d 79 6d 65 74 68 6f 64 20 42 52 31 20 25 [mymethod BR1 %
0460: 78 20 25 79 5d 0a 09 62 69 6e 64 20 24 77 69 6e x %y]..bind $win
0470: 20 3c 44 6f 77 6e 3e 20 5b 6c 69 73 74 20 74 74 <Down> [list tt
0480: 6b 3a 3a 6d 65 6e 75 62 75 74 74 6f 6e 3a 3a 50 k::menubutton::P
0490: 6f 70 64 6f 77 6e 20 25 57 5d 0a 09 62 69 6e 64 opdown %W]..bind
04a0: 20 24 77 69 6e 20 3c 4d 6f 74 69 6f 6e 3e 20 5b $win <Motion> [
04b0: 6d 79 6d 65 74 68 6f 64 20 63 68 65 63 6b 5f 63 mymethod check_c
04c0: 75 72 73 6f 72 20 25 78 20 25 79 5d 0a 09 62 69 ursor %x %y]..bi
04d0: 6e 64 20 24 77 69 6e 20 3c 43 6f 6e 66 69 67 75 nd $win <Configu
04e0: 72 65 3e 20 5b 6d 79 6d 65 74 68 6f 64 20 20 5f re> [mymethod _
04f0: 63 61 6c 63 5f 78 6d 69 6e 5d 0a 0a 09 24 73 65 calc_xmin]...$se
0500: 6c 66 20 63 6f 6e 66 69 67 75 72 65 6c 69 73 74 lf configurelist
0510: 20 24 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 $args. }.
0520: 20 6f 6e 63 6f 6e 66 69 67 75 72 65 20 2d 69 6d onconfigure -im
0530: 61 67 65 20 7b 69 6d 67 7d 20 7b 0a 09 73 65 74 age {img} {..set
0540: 20 6f 70 74 69 6f 6e 73 28 2d 69 6d 61 67 65 29 options(-image)
0550: 20 24 69 6d 67 0a 0a 09 69 66 20 7b 20 24 6f 70 $img...if { $op
0560: 74 69 6f 6e 73 28 2d 74 65 78 74 29 20 6e 65 20 tions(-text) ne
0570: 22 22 20 7d 20 7b 0a 09 20 20 20 20 24 73 65 6c "" } {.. $sel
0580: 66 20 63 6f 6e 66 69 67 75 72 65 20 2d 5f 69 6d f configure -_im
0590: 61 67 65 20 24 69 6d 67 0a 09 20 20 20 20 72 65 age $img.. re
05a0: 74 75 72 6e 0a 09 7d 20 0a 09 73 65 74 20 6e 65 turn..} ..set ne
05b0: 77 5f 69 6d 67 20 5b 63 75 3a 3a 61 64 64 5f 64 w_img [cu::add_d
05c0: 6f 77 6e 5f 61 72 72 6f 77 5f 74 6f 5f 69 6d 61 own_arrow_to_ima
05d0: 67 65 20 24 69 6d 67 5d 0a 09 24 73 65 6c 66 20 ge $img]..$self
05e0: 63 6f 6e 66 69 67 75 72 65 20 2d 5f 69 6d 61 67 configure -_imag
05f0: 65 20 24 6e 65 77 5f 69 6d 67 0a 09 62 69 6e 64 e $new_img..bind
0600: 20 24 77 69 6e 20 3c 44 65 73 74 72 6f 79 3e 20 $win <Destroy>
0610: 2b 5b 6c 69 73 74 20 69 6d 61 67 65 20 64 65 6c +[list image del
0620: 65 74 65 20 24 6e 65 77 5f 69 6d 67 5d 0a 20 20 ete $new_img].
0630: 20 20 7d 0a 20 20 20 20 6f 6e 63 6f 6e 66 69 67 }. onconfig
0640: 75 72 65 20 2d 74 65 78 74 20 7b 76 61 6c 75 65 ure -text {value
0650: 7d 20 7b 0a 09 73 65 74 20 6f 70 74 69 6f 6e 73 } {..set options
0660: 28 2d 74 65 78 74 29 20 24 76 61 6c 75 65 0a 0a (-text) $value..
0670: 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d .if { $options(-
0680: 74 65 78 74 29 20 6e 65 20 22 22 20 7d 20 7b 0a text) ne "" } {.
0690: 09 20 20 20 20 24 73 65 6c 66 20 63 6f 6e 66 69 . $self confi
06a0: 67 75 72 65 20 2d 73 74 79 6c 65 20 22 22 0a 09 gure -style ""..
06b0: 20 20 20 20 69 66 20 7b 20 24 6f 70 74 69 6f 6e if { $option
06c0: 73 28 2d 69 6d 61 67 65 29 20 6e 65 20 22 22 20 s(-image) ne ""
06d0: 7d 20 7b 0a 09 09 24 73 65 6c 66 20 63 6f 6e 66 } {...$self conf
06e0: 69 67 75 72 65 20 2d 5f 69 6d 61 67 65 20 24 6f igure -_image $o
06f0: 70 74 69 6f 6e 73 28 2d 69 6d 61 67 65 29 0a 09 ptions(-image)..
0700: 20 20 20 20 7d 0a 09 7d 0a 09 24 73 65 6c 66 20 }..}..$self
0710: 63 6f 6e 66 69 67 75 72 65 20 2d 5f 74 65 78 74 configure -_text
0720: 20 24 76 61 6c 75 65 0a 20 20 20 20 7d 0a 20 20 $value. }.
0730: 20 20 6d 65 74 68 6f 64 20 5f 63 61 6c 63 5f 78 method _calc_x
0740: 6d 69 6e 20 7b 7d 20 7b 0a 09 69 66 20 7b 20 5b min {} {..if { [
0750: 77 69 6e 66 6f 20 77 69 64 74 68 20 24 77 69 6e winfo width $win
0760: 5d 20 3e 20 31 20 7d 20 7b 0a 09 20 20 20 20 73 ] > 1 } {.. s
0770: 65 74 20 78 6d 69 6e 20 20 5b 65 78 70 72 20 7b et xmin [expr {
0780: 5b 77 69 6e 66 6f 20 77 69 64 74 68 20 24 77 69 [winfo width $wi
0790: 6e 5d 2d 31 32 7d 5d 0a 09 7d 20 65 6c 73 65 20 n]-12}]..} else
07a0: 7b 0a 09 20 20 20 20 73 65 74 20 78 6d 69 6e 20 {.. set xmin
07b0: 20 5b 65 78 70 72 20 7b 5b 77 69 6e 66 6f 20 72 [expr {[winfo r
07c0: 65 71 77 69 64 74 68 20 24 77 69 6e 5d 2d 31 32 eqwidth $win]-12
07d0: 7d 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }]..}. }.
07e0: 6d 65 74 68 6f 64 20 67 69 76 65 5f 69 73 5f 62 method give_is_b
07f0: 75 74 74 6f 6e 5f 61 63 74 69 76 65 5f 76 61 72 utton_active_var
0800: 20 7b 7d 20 7b 0a 09 72 65 74 75 72 6e 20 5b 6d {} {..return [m
0810: 79 76 61 72 20 69 73 5f 62 75 74 74 6f 6e 5f 61 yvar is_button_a
0820: 63 74 69 76 65 5d 0a 20 20 20 20 7d 0a 20 20 20 ctive]. }.
0830: 20 6d 65 74 68 6f 64 20 42 50 31 20 7b 20 78 20 method BP1 { x
0840: 79 20 7d 20 7b 0a 09 69 66 20 7b 20 21 24 69 73 y } {..if { !$is
0850: 5f 62 75 74 74 6f 6e 5f 61 63 74 69 76 65 20 7d _button_active }
0860: 20 7b 20 72 65 74 75 72 6e 20 7d 0a 09 0a 09 69 { return }....i
0870: 66 20 7b 20 24 78 20 3c 20 24 78 6d 69 6e 20 26 f { $x < $xmin &
0880: 26 20 24 6f 70 74 69 6f 6e 73 28 2d 63 6f 6d 6d & $options(-comm
0890: 61 6e 64 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 and) ne "" } {..
08a0: 20 20 20 20 24 77 69 6e 20 69 6e 73 74 61 74 65 $win instate
08b0: 20 21 64 69 73 61 62 6c 65 64 20 7b 0a 09 09 63 !disabled {...c
08c0: 61 74 63 68 20 7b 20 74 69 6c 65 3a 3a 63 6c 69 atch { tile::cli
08d0: 63 6b 54 6f 46 6f 63 75 73 20 24 77 69 6e 20 7d ckToFocus $win }
08e0: 0a 09 09 63 61 74 63 68 20 7b 20 74 74 6b 3a 3a ...catch { ttk::
08f0: 63 6c 69 63 6b 54 6f 46 6f 63 75 73 20 24 77 69 clickToFocus $wi
0900: 6e 20 7d 0a 09 09 24 77 69 6e 20 73 74 61 74 65 n }...$win state
0910: 20 70 72 65 73 73 65 64 0a 09 20 20 20 20 7d 0a pressed.. }.
0920: 09 20 20 20 20 73 65 74 20 70 72 65 73 73 5f 61 . set press_a
0930: 66 74 65 72 20 5b 61 66 74 65 72 20 37 30 30 20 fter [after 700
0940: 5b 6d 79 6d 65 74 68 6f 64 20 42 50 31 5f 61 66 [mymethod BP1_af
0950: 74 65 72 5d 5d 0a 09 20 20 20 20 72 65 74 75 72 ter]].. retur
0960: 6e 20 2d 63 6f 64 65 20 62 72 65 61 6b 0a 09 7d n -code break..}
0970: 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f . }. metho
0980: 64 20 42 50 31 5f 61 66 74 65 72 20 7b 7d 20 7b d BP1_after {} {
0990: 0a 09 73 65 74 20 70 72 65 73 73 5f 61 66 74 65 ..set press_afte
09a0: 72 20 22 22 0a 09 24 77 69 6e 20 69 6e 73 74 61 r ""..$win insta
09b0: 74 65 20 7b 70 72 65 73 73 65 64 20 21 64 69 73 te {pressed !dis
09c0: 61 62 6c 65 64 7d 20 7b 0a 09 20 20 20 20 74 74 abled} {.. tt
09d0: 6b 3a 3a 6d 65 6e 75 62 75 74 74 6f 6e 3a 3a 50 k::menubutton::P
09e0: 75 6c 6c 64 6f 77 6e 20 24 73 65 6c 66 0a 09 7d ulldown $self..}
09f0: 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f . }. metho
0a00: 64 20 42 52 31 20 7b 20 78 20 79 20 7d 20 7b 0a d BR1 { x y } {.
0a10: 09 69 66 20 7b 20 21 24 69 73 5f 62 75 74 74 6f .if { !$is_butto
0a20: 6e 5f 61 63 74 69 76 65 20 7d 20 7b 20 72 65 74 n_active } { ret
0a30: 75 72 6e 20 7d 0a 09 0a 09 69 66 20 7b 20 24 70 urn }....if { $p
0a40: 72 65 73 73 5f 61 66 74 65 72 20 6e 65 20 22 22 ress_after ne ""
0a50: 20 7d 20 7b 0a 09 20 20 20 20 61 66 74 65 72 20 } {.. after
0a60: 63 61 6e 63 65 6c 20 24 70 72 65 73 73 5f 61 66 cancel $press_af
0a70: 74 65 72 0a 09 7d 0a 09 69 66 20 7b 20 24 70 72 ter..}..if { $pr
0a80: 65 73 73 5f 61 66 74 65 72 20 6e 65 20 22 22 20 ess_after ne ""
0a90: 26 26 20 24 78 20 3c 20 24 78 6d 69 6e 20 26 26 && $x < $xmin &&
0aa0: 20 24 6f 70 74 69 6f 6e 73 28 2d 63 6f 6d 6d 61 $options(-comma
0ab0: 6e 64 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 20 nd) ne "" } {..
0ac0: 20 20 20 24 77 69 6e 20 69 6e 73 74 61 74 65 20 $win instate
0ad0: 7b 70 72 65 73 73 65 64 20 21 64 69 73 61 62 6c {pressed !disabl
0ae0: 65 64 7d 20 7b 0a 09 09 24 77 69 6e 20 73 74 61 ed} {...$win sta
0af0: 74 65 20 21 70 72 65 73 73 65 64 0a 09 09 75 70 te !pressed...up
0b00: 6c 65 76 65 6c 20 23 30 20 24 6f 70 74 69 6f 6e level #0 $option
0b10: 73 28 2d 63 6f 6d 6d 61 6e 64 29 0a 09 20 20 20 s(-command)..
0b20: 20 7d 0a 09 20 20 20 20 73 65 74 20 70 72 65 73 }.. set pres
0b30: 73 5f 61 66 74 65 72 20 22 22 0a 09 20 20 20 20 s_after ""..
0b40: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 62 72 65 return -code bre
0b50: 61 6b 0a 09 7d 0a 09 73 65 74 20 70 72 65 73 73 ak..}..set press
0b60: 5f 61 66 74 65 72 20 22 22 0a 20 20 20 20 7d 0a _after "". }.
0b70: 20 20 20 20 6d 65 74 68 6f 64 20 63 68 65 63 6b method check
0b80: 5f 63 75 72 73 6f 72 20 7b 20 78 20 79 20 7d 20 _cursor { x y }
0b90: 7b 0a 09 69 66 20 7b 20 24 78 20 3c 20 24 78 6d {..if { $x < $xm
0ba0: 69 6e 20 7d 20 7b 0a 09 20 20 20 20 24 77 69 6e in } {.. $win
0bb0: 20 63 6f 6e 66 69 67 75 72 65 20 2d 63 75 72 73 configure -curs
0bc0: 6f 72 20 22 22 0a 09 7d 20 65 6c 73 65 20 7b 0a or ""..} else {.
0bd0: 09 20 20 20 20 24 77 69 6e 20 63 6f 6e 66 69 67 . $win config
0be0: 75 72 65 20 2d 63 75 72 73 6f 72 20 62 6f 74 74 ure -cursor bott
0bf0: 6f 6d 5f 73 69 64 65 0a 09 7d 0a 20 20 20 20 7d om_side..}. }
0c00: 0a 7d 0a 0a 73 6e 69 74 3a 3a 77 69 64 67 65 74 .}..snit::widget
0c10: 61 64 61 70 74 6f 72 20 63 75 3a 3a 63 6f 6d 62 adaptor cu::comb
0c20: 6f 62 6f 78 20 7b 0a 20 20 20 20 6f 70 74 69 6f obox {. optio
0c30: 6e 20 2d 76 61 6c 75 65 73 76 61 72 69 61 62 6c n -valuesvariabl
0c40: 65 20 22 22 0a 20 20 20 20 6f 70 74 69 6f 6e 20 e "". option
0c50: 2d 74 65 78 74 76 61 72 69 61 62 6c 65 20 22 22 -textvariable ""
0c60: 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d 73 74 61 . option -sta
0c70: 74 65 76 61 72 69 61 62 6c 65 20 22 22 0a 20 20 tevariable "".
0c80: 20 20 6f 70 74 69 6f 6e 20 2d 76 61 6c 75 65 73 option -values
0c90: 20 22 22 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d "". option -
0ca0: 64 69 63 74 20 22 22 0a 20 20 20 20 6f 70 74 69 dict "". opti
0cb0: 6f 6e 20 2d 64 69 63 74 76 61 72 69 61 62 6c 65 on -dictvariable
0cc0: 20 22 22 0a 0a 20 20 20 20 76 61 72 69 61 62 6c "".. variabl
0cd0: 65 20 5f 74 72 61 6e 73 6c 61 74 65 64 5f 74 65 e _translated_te
0ce0: 78 74 76 61 72 69 61 62 6c 65 20 22 22 0a 0a 20 xtvariable ""..
0cf0: 20 20 20 64 65 6c 65 67 61 74 65 20 6d 65 74 68 delegate meth
0d00: 6f 64 20 2a 20 74 6f 20 68 75 6c 6c 0a 20 20 20 od * to hull.
0d10: 20 64 65 6c 65 67 61 74 65 20 6f 70 74 69 6f 6e delegate option
0d20: 20 2a 20 74 6f 20 68 75 6c 6c 0a 20 20 20 20 64 * to hull. d
0d30: 65 6c 65 67 61 74 65 20 6f 70 74 69 6f 6e 20 2d elegate option -
0d40: 5f 76 61 6c 75 65 73 20 74 6f 20 68 75 6c 6c 20 _values to hull
0d50: 61 73 20 2d 76 61 6c 75 65 73 0a 20 20 20 20 64 as -values. d
0d60: 65 6c 65 67 61 74 65 20 6f 70 74 69 6f 6e 20 2d elegate option -
0d70: 5f 74 65 78 74 76 61 72 69 61 62 6c 65 20 74 6f _textvariable to
0d80: 20 68 75 6c 6c 20 61 73 20 2d 74 65 78 74 76 61 hull as -textva
0d90: 72 69 61 62 6c 65 0a 0a 20 20 20 20 63 6f 6e 73 riable.. cons
0da0: 74 72 75 63 74 6f 72 20 61 72 67 73 20 7b 0a 09 tructor args {..
0db0: 69 6e 73 74 61 6c 6c 68 75 6c 6c 20 75 73 69 6e installhull usin
0dc0: 67 20 74 74 6b 3a 3a 63 6f 6d 62 6f 62 6f 78 0a g ttk::combobox.
0dd0: 0a 09 63 75 3a 3a 61 64 64 5f 63 6f 6e 74 65 78 ..cu::add_contex
0de0: 74 75 61 6c 5f 6d 65 6e 75 5f 74 6f 5f 65 6e 74 tual_menu_to_ent
0df0: 72 79 20 24 77 69 6e 20 69 6e 69 74 0a 09 62 69 ry $win init..bi
0e00: 6e 64 20 24 77 69 6e 20 3c 3c 43 6f 6d 62 6f 62 nd $win <<Combob
0e10: 6f 78 53 65 6c 65 63 74 65 64 3e 3e 20 5b 6d 79 oxSelected>> [my
0e20: 6d 65 74 68 6f 64 20 63 6f 6d 62 6f 62 6f 78 5f method combobox_
0e30: 73 65 6c 65 63 74 65 64 5d 0a 09 24 73 65 6c 66 selected]..$self
0e40: 20 63 6f 6e 66 69 67 75 72 65 6c 69 73 74 20 24 configurelist $
0e50: 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 64 args. }. d
0e60: 65 73 74 72 75 63 74 6f 72 20 7b 0a 09 63 61 74 estructor {..cat
0e70: 63 68 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 24 ch {.. if { $
0e80: 6f 70 74 69 6f 6e 73 28 2d 76 61 6c 75 65 73 76 options(-valuesv
0e90: 61 72 69 61 62 6c 65 29 20 6e 65 20 22 22 20 7d ariable) ne "" }
0ea0: 20 7b 0a 09 09 75 70 76 61 72 20 23 30 20 24 6f {...upvar #0 $o
0eb0: 70 74 69 6f 6e 73 28 2d 76 61 6c 75 65 73 76 61 ptions(-valuesva
0ec0: 72 69 61 62 6c 65 29 20 76 0a 09 09 74 72 61 63 riable) v...trac
0ed0: 65 20 72 65 6d 6f 76 65 20 76 61 72 69 61 62 6c e remove variabl
0ee0: 65 20 76 20 77 72 69 74 65 20 22 5b 6d 79 6d 65 e v write "[myme
0ef0: 74 68 6f 64 20 5f 63 68 61 6e 67 65 64 5f 76 61 thod _changed_va
0f00: 6c 75 65 73 5f 76 61 72 5d 3b 23 22 0a 09 20 20 lues_var];#"..
0f10: 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 20 24 6f }.. if { $o
0f20: 70 74 69 6f 6e 73 28 2d 64 69 63 74 76 61 72 69 ptions(-dictvari
0f30: 61 62 6c 65 29 20 6e 65 20 22 22 20 7d 20 7b 0a able) ne "" } {.
0f40: 09 09 75 70 76 61 72 20 23 30 20 24 6f 70 74 69 ..upvar #0 $opti
0f50: 6f 6e 73 28 2d 64 69 63 74 76 61 72 69 61 62 6c ons(-dictvariabl
0f60: 65 29 20 76 0a 09 09 74 72 61 63 65 20 72 65 6d e) v...trace rem
0f70: 6f 76 65 20 76 61 72 69 61 62 6c 65 20 76 20 77 ove variable v w
0f80: 72 69 74 65 20 22 5b 6d 79 6d 65 74 68 6f 64 20 rite "[mymethod
0f90: 5f 63 68 61 6e 67 65 64 5f 76 61 6c 75 65 73 5f _changed_values_
0fa0: 76 61 72 5d 3b 23 22 0a 09 20 20 20 20 7d 0a 09 var];#".. }..
0fb0: 20 20 20 20 69 66 20 7b 20 24 6f 70 74 69 6f 6e if { $option
0fc0: 73 28 2d 74 65 78 74 76 61 72 69 61 62 6c 65 29 s(-textvariable)
0fd0: 20 6e 65 20 22 22 20 7d 20 7b 0a 09 09 75 70 76 ne "" } {...upv
0fe0: 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d ar #0 $options(-
0ff0: 74 65 78 74 76 61 72 69 61 62 6c 65 29 20 76 0a textvariable) v.
1000: 09 09 74 72 61 63 65 20 72 65 6d 6f 76 65 20 76 ..trace remove v
1010: 61 72 69 61 62 6c 65 20 76 20 77 72 69 74 65 20 ariable v write
1020: 22 5b 6d 79 6d 65 74 68 6f 64 20 5f 77 72 69 74 "[mymethod _writ
1030: 74 65 6e 5f 74 65 78 74 76 61 72 69 61 62 6c 65 ten_textvariable
1040: 5d 3b 23 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 ];#".. }..
1050: 20 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d if { $options(-
1060: 73 74 61 74 65 76 61 72 69 61 62 6c 65 29 20 6e statevariable) n
1070: 65 20 22 22 20 7d 20 7b 0a 09 09 75 70 76 61 72 e "" } {...upvar
1080: 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d 73 74 #0 $options(-st
1090: 61 74 65 76 61 72 69 61 62 6c 65 29 20 76 0a 09 atevariable) v..
10a0: 09 74 72 61 63 65 20 72 65 6d 6f 76 65 20 76 61 .trace remove va
10b0: 72 69 61 62 6c 65 20 76 20 77 72 69 74 65 20 22 riable v write "
10c0: 5b 6d 79 6d 65 74 68 6f 64 20 5f 77 72 69 74 74 [mymethod _writt
10d0: 65 6e 5f 73 74 61 74 65 76 61 72 69 61 62 6c 65 en_statevariable
10e0: 5d 3b 23 22 0a 09 09 74 72 61 63 65 20 72 65 6d ];#"...trace rem
10f0: 6f 76 65 20 76 61 72 69 61 62 6c 65 20 76 20 72 ove variable v r
1100: 65 61 64 20 22 5b 6d 79 6d 65 74 68 6f 64 20 5f ead "[mymethod _
1110: 72 65 61 64 5f 73 74 61 74 65 76 61 72 69 61 62 read_statevariab
1120: 6c 65 5d 3b 23 22 0a 09 20 20 20 20 7d 0a 09 7d le];#".. }..}
1130: 0a 20 20 20 20 7d 0a 20 20 20 20 6f 6e 63 6f 6e . }. oncon
1140: 66 69 67 75 72 65 20 2d 74 65 78 74 76 61 72 69 figure -textvari
1150: 61 62 6c 65 20 7b 76 61 6c 75 65 7d 20 7b 0a 09 able {value} {..
1160: 73 65 74 20 6f 70 74 69 6f 6e 73 28 2d 74 65 78 set options(-tex
1170: 74 76 61 72 69 61 62 6c 65 29 20 24 76 61 6c 75 tvariable) $valu
1180: 65 0a 09 24 73 65 6c 66 20 63 6f 6e 66 69 67 75 e..$self configu
1190: 72 65 20 2d 5f 74 65 78 74 76 61 72 69 61 62 6c re -_textvariabl
11a0: 65 20 5b 6d 79 76 61 72 20 5f 74 72 61 6e 73 6c e [myvar _transl
11b0: 61 74 65 64 5f 74 65 78 74 76 61 72 69 61 62 6c ated_textvariabl
11c0: 65 5d 0a 0a 09 75 70 76 61 72 20 23 30 20 24 6f e]...upvar #0 $o
11d0: 70 74 69 6f 6e 73 28 2d 74 65 78 74 76 61 72 69 ptions(-textvari
11e0: 61 62 6c 65 29 20 76 0a 09 74 72 61 63 65 20 61 able) v..trace a
11f0: 64 64 20 76 61 72 69 61 62 6c 65 20 76 20 77 72 dd variable v wr
1200: 69 74 65 20 22 5b 6d 79 6d 65 74 68 6f 64 20 5f ite "[mymethod _
1210: 77 72 69 74 74 65 6e 5f 74 65 78 74 76 61 72 69 written_textvari
1220: 61 62 6c 65 5d 3b 23 22 0a 09 74 72 61 63 65 20 able];#"..trace
1230: 61 64 64 20 76 61 72 69 61 62 6c 65 20 5b 6d 79 add variable [my
1240: 76 61 72 20 5f 74 72 61 6e 73 6c 61 74 65 64 5f var _translated_
1250: 74 65 78 74 76 61 72 69 61 62 6c 65 5d 20 77 72 textvariable] wr
1260: 69 74 65 20 5c 0a 09 20 20 20 20 22 5b 6d 79 6d ite \.. "[mym
1270: 65 74 68 6f 64 20 5f 72 65 61 64 5f 74 65 78 74 ethod _read_text
1280: 76 61 72 69 61 62 6c 65 5d 3b 23 22 0a 09 69 66 variable];#"..if
1290: 20 7b 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 { [info exists
12a0: 76 5d 20 7d 20 7b 0a 09 20 20 20 20 24 73 65 6c v] } {.. $sel
12b0: 66 20 5f 77 72 69 74 74 65 6e 5f 74 65 78 74 76 f _written_textv
12c0: 61 72 69 61 62 6c 65 0a 09 7d 0a 20 20 20 20 7d ariable..}. }
12d0: 0a 20 20 20 20 6f 6e 63 6f 6e 66 69 67 75 72 65 . onconfigure
12e0: 20 2d 64 69 63 74 76 61 72 69 61 62 6c 65 20 7b -dictvariable {
12f0: 76 61 6c 75 65 7d 20 7b 0a 09 73 65 74 20 6f 70 value} {..set op
1300: 74 69 6f 6e 73 28 2d 64 69 63 74 76 61 72 69 61 tions(-dictvaria
1310: 62 6c 65 29 20 24 76 61 6c 75 65 0a 09 24 73 65 ble) $value..$se
1320: 6c 66 20 5f 63 68 61 6e 67 65 64 5f 76 61 6c 75 lf _changed_valu
1330: 65 73 5f 76 61 72 0a 09 75 70 76 61 72 20 23 30 es_var..upvar #0
1340: 20 24 6f 70 74 69 6f 6e 73 28 2d 64 69 63 74 76 $options(-dictv
1350: 61 72 69 61 62 6c 65 29 20 76 0a 09 74 72 61 63 ariable) v..trac
1360: 65 20 61 64 64 20 76 61 72 69 61 62 6c 65 20 76 e add variable v
1370: 20 77 72 69 74 65 20 22 5b 6d 79 6d 65 74 68 6f write "[mymetho
1380: 64 20 5f 63 68 61 6e 67 65 64 5f 76 61 6c 75 65 d _changed_value
1390: 73 5f 76 61 72 5d 3b 23 22 0a 20 20 20 20 7d 0a s_var];#". }.
13a0: 20 20 20 20 6f 6e 63 6f 6e 66 69 67 75 72 65 20 onconfigure
13b0: 2d 73 74 61 74 65 76 61 72 69 61 62 6c 65 20 7b -statevariable {
13c0: 76 61 6c 75 65 7d 20 7b 0a 09 73 65 74 20 6f 70 value} {..set op
13d0: 74 69 6f 6e 73 28 2d 73 74 61 74 65 76 61 72 69 tions(-statevari
13e0: 61 62 6c 65 29 20 24 76 61 6c 75 65 0a 0a 09 75 able) $value...u
13f0: 70 76 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 pvar #0 $options
1400: 28 2d 73 74 61 74 65 76 61 72 69 61 62 6c 65 29 (-statevariable)
1410: 20 76 0a 09 74 72 61 63 65 20 61 64 64 20 76 61 v..trace add va
1420: 72 69 61 62 6c 65 20 76 20 77 72 69 74 65 20 22 riable v write "
1430: 5b 6d 79 6d 65 74 68 6f 64 20 5f 77 72 69 74 74 [mymethod _writt
1440: 65 6e 5f 73 74 61 74 65 76 61 72 69 61 62 6c 65 en_statevariable
1450: 5d 3b 23 22 0a 09 74 72 61 63 65 20 61 64 64 20 ];#"..trace add
1460: 76 61 72 69 61 62 6c 65 20 76 20 72 65 61 64 20 variable v read
1470: 22 5b 6d 79 6d 65 74 68 6f 64 20 5f 72 65 61 64 "[mymethod _read
1480: 5f 73 74 61 74 65 76 61 72 69 61 62 6c 65 5d 3b _statevariable];
1490: 23 22 0a 09 69 66 20 7b 20 5b 69 6e 66 6f 20 65 #"..if { [info e
14a0: 78 69 73 74 73 20 76 5d 20 7d 20 7b 0a 09 20 20 xists v] } {..
14b0: 20 20 73 65 74 20 76 20 24 76 0a 09 7d 0a 20 20 set v $v..}.
14c0: 20 20 7d 0a 20 20 20 20 6f 6e 63 6f 6e 66 69 67 }. onconfig
14d0: 75 72 65 20 2d 76 61 6c 75 65 73 76 61 72 69 61 ure -valuesvaria
14e0: 62 6c 65 20 7b 76 61 6c 75 65 7d 20 7b 0a 09 73 ble {value} {..s
14f0: 65 74 20 6f 70 74 69 6f 6e 73 28 2d 76 61 6c 75 et options(-valu
1500: 65 73 76 61 72 69 61 62 6c 65 29 20 24 76 61 6c esvariable) $val
1510: 75 65 0a 0a 09 75 70 76 61 72 20 23 30 20 24 6f ue...upvar #0 $o
1520: 70 74 69 6f 6e 73 28 2d 76 61 6c 75 65 73 76 61 ptions(-valuesva
1530: 72 69 61 62 6c 65 29 20 76 0a 0a 09 69 66 20 7b riable) v...if {
1540: 20 24 6f 70 74 69 6f 6e 73 28 2d 64 69 63 74 76 $options(-dictv
1550: 61 72 69 61 62 6c 65 29 20 6e 65 20 22 22 20 7d ariable) ne "" }
1560: 20 7b 0a 09 20 20 20 20 75 70 76 61 72 20 23 30 {.. upvar #0
1570: 20 24 6f 70 74 69 6f 6e 73 28 2d 64 69 63 74 76 $options(-dictv
1580: 61 72 69 61 62 6c 65 29 20 76 64 0a 09 20 20 20 ariable) vd..
1590: 20 69 66 20 7b 20 5b 69 6e 66 6f 20 65 78 69 73 if { [info exis
15a0: 74 73 20 76 64 5d 20 7d 20 7b 0a 09 09 73 65 74 ts vd] } {...set
15b0: 20 64 69 63 74 20 24 76 64 0a 09 20 20 20 20 7d dict $vd.. }
15c0: 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 64 69 else {...set di
15d0: 63 74 20 22 22 0a 09 20 20 20 20 7d 0a 09 7d 20 ct "".. }..}
15e0: 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 else {.. set
15f0: 64 69 63 74 20 24 6f 70 74 69 6f 6e 73 28 2d 64 dict $options(-d
1600: 69 63 74 29 0a 09 7d 0a 09 69 66 20 7b 20 21 5b ict)..}..if { ![
1610: 69 6e 66 6f 20 65 78 69 73 74 73 20 76 5d 20 7d info exists v] }
1620: 20 7b 0a 09 20 20 20 20 73 65 74 20 76 20 22 22 {.. set v ""
1630: 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 76 61 .. foreach va
1640: 6c 75 65 20 5b 24 73 65 6c 66 20 63 67 65 74 20 lue [$self cget
1650: 2d 5f 76 61 6c 75 65 73 5d 20 7b 0a 09 09 63 61 -_values] {...ca
1660: 74 63 68 20 7b 20 0a 09 09 20 20 20 20 73 65 74 tch { ... set
1670: 20 76 61 6c 75 65 20 5b 64 69 63 74 20 67 65 74 value [dict get
1680: 20 5b 64 69 63 74 5f 69 6e 76 65 72 73 65 20 24 [dict_inverse $
1690: 64 69 63 74 5d 20 24 76 61 6c 75 65 5d 0a 09 09 dict] $value]...
16a0: 7d 0a 09 09 6c 61 70 70 65 6e 64 20 76 20 24 76 }...lappend v $v
16b0: 61 6c 75 65 0a 09 20 20 20 20 7d 0a 09 7d 20 65 alue.. }..} e
16c0: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 76 lse {.. set v
16d0: 74 72 61 6e 73 20 22 22 0a 09 20 20 20 20 66 6f trans "".. fo
16e0: 72 65 61 63 68 20 76 61 6c 75 65 20 24 76 20 7b reach value $v {
16f0: 0a 09 09 63 61 74 63 68 20 7b 20 73 65 74 20 76 ...catch { set v
1700: 61 6c 75 65 20 5b 64 69 63 74 20 67 65 74 20 24 alue [dict get $
1710: 64 69 63 74 20 24 76 61 6c 75 65 5d 20 7d 0a 09 dict $value] }..
1720: 09 6c 61 70 70 65 6e 64 20 76 74 72 61 6e 73 20 .lappend vtrans
1730: 24 76 61 6c 75 65 0a 09 20 20 20 20 7d 0a 09 20 $value.. }..
1740: 20 20 20 24 73 65 6c 66 20 63 6f 6e 66 69 67 75 $self configu
1750: 72 65 20 2d 5f 76 61 6c 75 65 73 20 24 76 74 72 re -_values $vtr
1760: 61 6e 73 0a 09 7d 0a 09 74 72 61 63 65 20 61 64 ans..}..trace ad
1770: 64 20 76 61 72 69 61 62 6c 65 20 76 20 77 72 69 d variable v wri
1780: 74 65 20 22 5b 6d 79 6d 65 74 68 6f 64 20 5f 63 te "[mymethod _c
1790: 68 61 6e 67 65 64 5f 76 61 6c 75 65 73 5f 76 61 hanged_values_va
17a0: 72 5d 3b 23 22 0a 20 20 20 20 7d 0a 20 20 20 20 r];#". }.
17b0: 6f 6e 63 6f 6e 66 69 67 75 72 65 20 2d 64 69 63 onconfigure -dic
17c0: 74 20 7b 76 61 6c 75 65 7d 20 7b 0a 09 73 65 74 t {value} {..set
17d0: 20 6f 70 74 69 6f 6e 73 28 2d 64 69 63 74 29 20 options(-dict)
17e0: 24 76 61 6c 75 65 0a 09 24 73 65 6c 66 20 5f 63 $value..$self _c
17f0: 68 61 6e 67 65 64 5f 76 61 6c 75 65 73 5f 76 61 hanged_values_va
1800: 72 0a 20 20 20 20 7d 0a 20 20 20 20 6f 6e 63 6f r. }. onco
1810: 6e 66 69 67 75 72 65 20 2d 76 61 6c 75 65 73 20 nfigure -values
1820: 7b 76 61 6c 75 65 73 7d 20 7b 0a 09 69 66 20 7b {values} {..if {
1830: 20 24 6f 70 74 69 6f 6e 73 28 2d 76 61 6c 75 65 $options(-value
1840: 73 76 61 72 69 61 62 6c 65 29 20 6e 65 20 22 22 svariable) ne ""
1850: 20 7d 20 7b 0a 09 20 20 20 20 75 70 76 61 72 20 } {.. upvar
1860: 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d 76 61 6c #0 $options(-val
1870: 75 65 73 76 61 72 69 61 62 6c 65 29 20 76 0a 09 uesvariable) v..
1880: 20 20 20 20 73 65 74 20 76 20 24 76 61 6c 75 65 set v $value
1890: 73 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 s..} else {..
18a0: 20 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d if { $options(-
18b0: 64 69 63 74 76 61 72 69 61 62 6c 65 29 20 6e 65 dictvariable) ne
18c0: 20 22 22 20 7d 20 7b 0a 09 09 75 70 76 61 72 20 "" } {...upvar
18d0: 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d 64 69 63 #0 $options(-dic
18e0: 74 76 61 72 69 61 62 6c 65 29 20 76 64 0a 09 09 tvariable) vd...
18f0: 69 66 20 7b 20 5b 69 6e 66 6f 20 65 78 69 73 74 if { [info exist
1900: 73 20 76 64 5d 20 7d 20 7b 0a 09 09 20 20 20 20 s vd] } {...
1910: 73 65 74 20 64 69 63 74 20 24 76 64 0a 09 09 7d set dict $vd...}
1920: 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 73 65 else {... se
1930: 74 20 64 69 63 74 20 22 22 0a 09 09 7d 0a 09 20 t dict ""...}..
1940: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 } else {...se
1950: 74 20 64 69 63 74 20 24 6f 70 74 69 6f 6e 73 28 t dict $options(
1960: 2d 64 69 63 74 29 0a 09 20 20 20 20 7d 0a 09 20 -dict).. }..
1970: 20 20 20 73 65 74 20 76 74 72 61 6e 73 20 22 22 set vtrans ""
1980: 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 76 61 .. foreach va
1990: 6c 75 65 20 24 76 61 6c 75 65 73 20 7b 0a 09 09 lue $values {...
19a0: 63 61 74 63 68 20 7b 20 73 65 74 20 76 61 6c 75 catch { set valu
19b0: 65 20 5b 64 69 63 74 20 67 65 74 20 24 64 69 63 e [dict get $dic
19c0: 74 20 24 76 61 6c 75 65 5d 20 7d 0a 09 09 6c 61 t $value] }...la
19d0: 70 70 65 6e 64 20 76 74 72 61 6e 73 20 24 76 61 ppend vtrans $va
19e0: 6c 75 65 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 lue.. }..
19f0: 24 73 65 6c 66 20 63 6f 6e 66 69 67 75 72 65 20 $self configure
1a00: 2d 5f 76 61 6c 75 65 73 20 24 76 74 72 61 6e 73 -_values $vtrans
1a10: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6f 6e ..}. }. on
1a20: 63 67 65 74 20 2d 76 61 6c 75 65 73 20 7b 0a 09 cget -values {..
1a30: 73 65 74 20 76 20 22 22 0a 09 66 6f 72 65 61 63 set v ""..foreac
1a40: 68 20 76 61 6c 75 65 20 5b 24 73 65 6c 66 20 63 h value [$self c
1a50: 67 65 74 20 2d 5f 76 61 6c 75 65 73 5d 20 7b 0a get -_values] {.
1a60: 23 20 20 20 20 20 20 20 20 20 20 20 20 20 63 61 # ca
1a70: 74 63 68 20 7b 0a 23 20 20 20 20 20 20 20 20 20 tch {.#
1a80: 20 20 20 20 20 20 20 20 73 65 74 20 76 61 6c 75 set valu
1a90: 65 20 5b 64 69 63 74 20 67 65 74 20 5b 64 69 63 e [dict get [dic
1aa0: 74 5f 69 6e 76 65 72 73 65 20 24 6f 70 74 69 6f t_inverse $optio
1ab0: 6e 73 28 2d 64 69 63 74 29 5d 20 24 76 61 6c 75 ns(-dict)] $valu
1ac0: 65 5d 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 e].#
1ad0: 20 7d 0a 09 20 20 20 20 6c 61 70 70 65 6e 64 20 }.. lappend
1ae0: 76 20 24 76 61 6c 75 65 0a 09 7d 0a 09 72 65 74 v $value..}..ret
1af0: 75 72 6e 20 24 76 0a 20 20 20 20 7d 0a 20 20 20 urn $v. }.
1b00: 20 6d 65 74 68 6f 64 20 5f 63 68 61 6e 67 65 64 method _changed
1b10: 5f 76 61 6c 75 65 73 5f 76 61 72 20 7b 7d 20 7b _values_var {} {
1b20: 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 ..if { $options(
1b30: 2d 76 61 6c 75 65 73 76 61 72 69 61 62 6c 65 29 -valuesvariable)
1b40: 20 6e 65 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 ne "" } {..
1b50: 75 70 76 61 72 20 23 30 20 24 6f 70 74 69 6f 6e upvar #0 $option
1b60: 73 28 2d 76 61 6c 75 65 73 76 61 72 69 61 62 6c s(-valuesvariabl
1b70: 65 29 20 76 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 e) v..} else {..
1b80: 20 20 20 20 73 65 74 20 76 20 5b 24 73 65 6c 66 set v [$self
1b90: 20 63 67 65 74 20 2d 76 61 6c 75 65 73 5d 0a 09 cget -values]..
1ba0: 7d 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 }..if { $options
1bb0: 28 2d 64 69 63 74 76 61 72 69 61 62 6c 65 29 20 (-dictvariable)
1bc0: 6e 65 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 75 ne "" } {.. u
1bd0: 70 76 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 pvar #0 $options
1be0: 28 2d 64 69 63 74 76 61 72 69 61 62 6c 65 29 20 (-dictvariable)
1bf0: 76 64 0a 09 20 20 20 20 69 66 20 7b 20 5b 69 6e vd.. if { [in
1c00: 66 6f 20 65 78 69 73 74 73 20 76 64 5d 20 7d 20 fo exists vd] }
1c10: 7b 0a 09 09 73 65 74 20 64 69 63 74 20 24 76 64 {...set dict $vd
1c20: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
1c30: 09 73 65 74 20 64 69 63 74 20 22 22 0a 09 20 20 .set dict ""..
1c40: 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 }..} else {..
1c50: 20 20 20 73 65 74 20 64 69 63 74 20 24 6f 70 74 set dict $opt
1c60: 69 6f 6e 73 28 2d 64 69 63 74 29 0a 09 7d 0a 09 ions(-dict)..}..
1c70: 73 65 74 20 76 74 72 61 6e 73 20 22 22 0a 09 66 set vtrans ""..f
1c80: 6f 72 65 61 63 68 20 76 61 6c 75 65 20 24 76 20 oreach value $v
1c90: 7b 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 73 {.. catch { s
1ca0: 65 74 20 76 61 6c 75 65 20 5b 64 69 63 74 20 67 et value [dict g
1cb0: 65 74 20 24 64 69 63 74 20 24 76 61 6c 75 65 5d et $dict $value]
1cc0: 20 7d 0a 09 20 20 20 20 6c 61 70 70 65 6e 64 20 }.. lappend
1cd0: 76 74 72 61 6e 73 20 24 76 61 6c 75 65 0a 09 7d vtrans $value..}
1ce0: 0a 09 24 73 65 6c 66 20 63 6f 6e 66 69 67 75 72 ..$self configur
1cf0: 65 20 2d 5f 76 61 6c 75 65 73 20 24 76 74 72 61 e -_values $vtra
1d00: 6e 73 0a 09 24 73 65 6c 66 20 5f 77 72 69 74 74 ns..$self _writt
1d10: 65 6e 5f 74 65 78 74 76 61 72 69 61 62 6c 65 0a en_textvariable.
1d20: 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 }. method
1d30: 20 5f 77 72 69 74 74 65 6e 5f 74 65 78 74 76 61 _written_textva
1d40: 72 69 61 62 6c 65 20 7b 20 61 72 67 73 20 7d 20 riable { args }
1d50: 7b 0a 0a 09 73 65 74 20 6f 70 74 69 6f 6e 61 6c {...set optional
1d60: 20 7b 0a 09 20 20 20 20 7b 20 2d 66 6f 72 63 65 {.. { -force
1d70: 5f 64 69 63 74 20 22 22 20 30 20 7d 0a 09 7d 0a _dict "" 0 }..}.
1d80: 09 73 65 74 20 63 6f 6d 70 75 6c 73 6f 72 79 20 .set compulsory
1d90: 22 22 0a 09 70 61 72 73 65 5f 61 72 67 73 20 24 ""..parse_args $
1da0: 6f 70 74 69 6f 6e 61 6c 20 24 63 6f 6d 70 75 6c optional $compul
1db0: 73 6f 72 79 20 24 61 72 67 73 0a 0a 09 75 70 76 sory $args...upv
1dc0: 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d ar #0 $options(-
1dd0: 74 65 78 74 76 61 72 69 61 62 6c 65 29 20 76 0a textvariable) v.
1de0: 09 69 66 20 7b 20 21 5b 69 6e 66 6f 20 65 78 69 .if { ![info exi
1df0: 73 74 73 20 76 5d 20 7d 20 7b 20 72 65 74 75 72 sts v] } { retur
1e00: 6e 20 7d 0a 09 73 65 74 20 76 61 6c 75 65 20 24 n }..set value $
1e10: 76 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 v..if { $options
1e20: 28 2d 64 69 63 74 76 61 72 69 61 62 6c 65 29 20 (-dictvariable)
1e30: 6e 65 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 75 ne "" } {.. u
1e40: 70 76 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 pvar #0 $options
1e50: 28 2d 64 69 63 74 76 61 72 69 61 62 6c 65 29 20 (-dictvariable)
1e60: 76 64 0a 09 20 20 20 20 69 66 20 7b 20 5b 69 6e vd.. if { [in
1e70: 66 6f 20 65 78 69 73 74 73 20 76 64 5d 20 7d 20 fo exists vd] }
1e80: 7b 0a 09 09 73 65 74 20 64 69 63 74 20 24 76 64 {...set dict $vd
1e90: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
1ea0: 09 73 65 74 20 64 69 63 74 20 22 22 0a 09 20 20 .set dict ""..
1eb0: 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 }..} else {..
1ec0: 20 20 20 73 65 74 20 64 69 63 74 20 24 6f 70 74 set dict $opt
1ed0: 69 6f 6e 73 28 2d 64 69 63 74 29 0a 09 7d 0a 09 ions(-dict)..}..
1ee0: 69 66 20 7b 20 24 66 6f 72 63 65 5f 64 69 63 74 if { $force_dict
1ef0: 20 7c 7c 20 5b 24 73 65 6c 66 20 69 6e 73 74 61 || [$self insta
1f00: 74 65 20 72 65 61 64 6f 6e 6c 79 5d 20 7d 20 7b te readonly] } {
1f10: 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 73 65 .. catch { se
1f20: 74 20 76 61 6c 75 65 20 5b 64 69 63 74 20 67 65 t value [dict ge
1f30: 74 20 24 64 69 63 74 20 24 76 61 6c 75 65 5d 20 t $dict $value]
1f40: 7d 0a 09 7d 0a 09 69 66 20 7b 20 24 5f 74 72 61 }..}..if { $_tra
1f50: 6e 73 6c 61 74 65 64 5f 74 65 78 74 76 61 72 69 nslated_textvari
1f60: 61 62 6c 65 20 6e 65 20 24 76 61 6c 75 65 20 7d able ne $value }
1f70: 20 7b 0a 09 20 20 20 20 73 65 74 20 5f 74 72 61 {.. set _tra
1f80: 6e 73 6c 61 74 65 64 5f 74 65 78 74 76 61 72 69 nslated_textvari
1f90: 61 62 6c 65 20 24 76 61 6c 75 65 0a 09 7d 0a 20 able $value..}.
1fa0: 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 }. method
1fb0: 5f 72 65 61 64 5f 74 65 78 74 76 61 72 69 61 62 _read_textvariab
1fc0: 6c 65 20 7b 7d 20 7b 0a 09 75 70 76 61 72 20 23 le {} {..upvar #
1fd0: 30 20 24 6f 70 74 69 6f 6e 73 28 2d 74 65 78 74 0 $options(-text
1fe0: 76 61 72 69 61 62 6c 65 29 20 76 0a 09 73 65 74 variable) v..set
1ff0: 20 76 61 6c 75 65 20 24 5f 74 72 61 6e 73 6c 61 value $_transla
2000: 74 65 64 5f 74 65 78 74 76 61 72 69 61 62 6c 65 ted_textvariable
2010: 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 ..if { $options(
2020: 2d 64 69 63 74 76 61 72 69 61 62 6c 65 29 20 6e -dictvariable) n
2030: 65 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 75 70 e "" } {.. up
2040: 76 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 var #0 $options(
2050: 2d 64 69 63 74 76 61 72 69 61 62 6c 65 29 20 76 -dictvariable) v
2060: 64 0a 09 20 20 20 20 69 66 20 7b 20 5b 69 6e 66 d.. if { [inf
2070: 6f 20 65 78 69 73 74 73 20 76 64 5d 20 7d 20 7b o exists vd] } {
2080: 0a 09 09 73 65 74 20 64 69 63 74 20 24 76 64 0a ...set dict $vd.
2090: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
20a0: 73 65 74 20 64 69 63 74 20 22 22 0a 09 20 20 20 set dict ""..
20b0: 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 }..} else {..
20c0: 20 20 73 65 74 20 64 69 63 74 20 24 6f 70 74 69 set dict $opti
20d0: 6f 6e 73 28 2d 64 69 63 74 29 0a 09 7d 0a 09 63 ons(-dict)..}..c
20e0: 61 74 63 68 20 7b 0a 09 20 20 20 20 73 65 74 20 atch {.. set
20f0: 76 61 6c 75 65 20 5b 64 69 63 74 20 67 65 74 20 value [dict get
2100: 5b 64 69 63 74 5f 69 6e 76 65 72 73 65 20 24 64 [dict_inverse $d
2110: 69 63 74 5d 20 24 76 61 6c 75 65 5d 0a 09 7d 0a ict] $value]..}.
2120: 09 69 66 20 7b 20 21 5b 69 6e 66 6f 20 65 78 69 .if { ![info exi
2130: 73 74 73 20 76 5d 20 7c 7c 20 24 76 20 6e 65 20 sts v] || $v ne
2140: 24 76 61 6c 75 65 20 7d 20 7b 0a 09 20 20 20 20 $value } {..
2150: 73 65 74 20 76 20 24 76 61 6c 75 65 0a 09 7d 0a set v $value..}.
2160: 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 }. method
2170: 20 5f 77 72 69 74 74 65 6e 5f 73 74 61 74 65 76 _written_statev
2180: 61 72 69 61 62 6c 65 20 7b 7d 20 7b 0a 09 75 70 ariable {} {..up
2190: 76 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 var #0 $options(
21a0: 2d 73 74 61 74 65 76 61 72 69 61 62 6c 65 29 20 -statevariable)
21b0: 76 0a 09 24 73 65 6c 66 20 73 74 61 74 65 20 24 v..$self state $
21c0: 76 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 v. }. meth
21d0: 6f 64 20 5f 72 65 61 64 5f 73 74 61 74 65 76 61 od _read_stateva
21e0: 72 69 61 62 6c 65 20 7b 7d 20 7b 0a 09 75 70 76 riable {} {..upv
21f0: 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d ar #0 $options(-
2200: 73 74 61 74 65 76 61 72 69 61 62 6c 65 29 20 76 statevariable) v
2210: 0a 09 73 65 74 20 76 20 5b 24 73 65 6c 66 20 73 ..set v [$self s
2220: 74 61 74 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 tate]. }.
2230: 6d 65 74 68 6f 64 20 63 6f 6d 62 6f 62 6f 78 5f method combobox_
2240: 73 65 6c 65 63 74 65 64 20 7b 7d 20 7b 0a 09 69 selected {} {..i
2250: 66 20 7b 20 21 5b 24 73 65 6c 66 20 69 6e 73 74 f { ![$self inst
2260: 61 74 65 20 72 65 61 64 6f 6e 6c 79 5d 20 7d 20 ate readonly] }
2270: 7b 0a 09 20 20 20 20 24 73 65 6c 66 20 5f 77 72 {.. $self _wr
2280: 69 74 74 65 6e 5f 74 65 78 74 76 61 72 69 61 62 itten_textvariab
2290: 6c 65 20 2d 66 6f 72 63 65 5f 64 69 63 74 0a 09 le -force_dict..
22a0: 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 23 23 23 23 23 }. }.}..#####
22b0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
22c0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
22d0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
22e0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
22f0: 23 23 23 23 23 23 23 23 23 23 23 0a 23 20 63 75 ###########.# cu
2300: 3a 3a 6d 75 6c 74 69 6c 69 6e 65 5f 65 6e 74 72 ::multiline_entr
2310: 79 0a 23 23 23 23 23 23 23 23 23 23 23 23 23 23 y.##############
2320: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2330: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2340: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2350: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2360: 23 23 0a 0a 73 6e 69 74 3a 3a 77 69 64 67 65 74 ##..snit::widget
2370: 20 63 75 3a 3a 6d 75 6c 74 69 6c 69 6e 65 5f 65 cu::multiline_e
2380: 6e 74 72 79 20 7b 0a 20 20 20 20 6f 70 74 69 6f ntry {. optio
2390: 6e 20 2d 74 65 78 74 76 61 72 69 61 62 6c 65 20 n -textvariable
23a0: 22 22 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d 74 "". option -t
23b0: 61 6b 65 66 6f 63 75 73 20 30 20 3b 23 20 6f 70 akefocus 0 ;# op
23c0: 74 69 6f 6e 20 75 73 65 64 20 62 79 20 74 68 65 tion used by the
23d0: 20 74 61 62 20 73 74 61 6e 64 61 72 64 20 62 69 tab standard bi
23e0: 6e 64 69 6e 67 73 0a 20 20 20 20 6f 70 74 69 6f ndings. optio
23f0: 6e 20 2d 76 61 6c 75 65 73 20 22 22 0a 20 20 20 n -values "".
2400: 20 6f 70 74 69 6f 6e 20 2d 76 61 6c 75 65 73 76 option -valuesv
2410: 61 72 69 61 62 6c 65 20 22 22 0a 20 20 20 20 6f ariable "". o
2420: 70 74 69 6f 6e 20 2d 73 74 61 74 65 20 22 22 0a ption -state "".
2430: 20 20 20 20 6f 70 74 69 6f 6e 20 2d 6a 75 73 74 option -just
2440: 69 66 79 20 22 22 0a 20 20 20 20 6f 70 74 69 6f ify "". optio
2450: 6e 20 2d 68 65 69 67 68 74 20 22 22 0a 0a 20 20 n -height ""..
2460: 20 20 68 75 6c 6c 74 79 70 65 20 66 72 61 6d 65 hulltype frame
2470: 0a 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 74 .. variable t
2480: 65 78 74 0a 20 20 20 20 76 61 72 69 61 62 6c 65 ext. variable
2490: 20 75 70 64 61 74 69 6e 67 20 30 0a 20 20 20 20 updating 0.
24a0: 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 74 6f . variable to
24b0: 63 74 72 65 65 0a 20 20 20 20 76 61 72 69 61 62 ctree. variab
24c0: 6c 65 20 66 6e 61 6d 65 73 20 22 22 0a 20 20 20 le fnames "".
24d0: 20 76 61 72 69 61 62 6c 65 20 6e 6f 5f 61 63 74 variable no_act
24e0: 69 76 65 5f 69 74 65 6d 73 20 22 22 0a 20 20 20 ive_items "".
24f0: 20 76 61 72 69 61 62 6c 65 20 6e 6f 5f 61 63 74 variable no_act
2500: 69 76 65 5f 76 61 6c 75 65 73 20 22 22 0a 20 20 ive_values "".
2510: 20 20 76 61 72 69 61 62 6c 65 20 63 6d 64 5f 69 variable cmd_i
2520: 74 65 6d 73 20 22 22 0a 20 20 20 20 0a 20 20 20 tems "". .
2530: 20 64 65 6c 65 67 61 74 65 20 6d 65 74 68 6f 64 delegate method
2540: 20 2a 20 74 6f 20 74 65 78 74 0a 20 20 20 20 64 * to text. d
2550: 65 6c 65 67 61 74 65 20 6d 65 74 68 6f 64 20 5f elegate method _
2560: 69 6e 73 65 72 74 20 74 6f 20 74 65 78 74 20 61 insert to text a
2570: 73 20 69 6e 73 65 72 74 0a 20 20 20 20 64 65 6c s insert. del
2580: 65 67 61 74 65 20 6f 70 74 69 6f 6e 20 2a 20 74 egate option * t
2590: 6f 20 74 65 78 74 0a 20 20 20 20 64 65 6c 65 67 o text. deleg
25a0: 61 74 65 20 6f 70 74 69 6f 6e 20 2d 5f 73 74 61 ate option -_sta
25b0: 74 65 20 74 6f 20 74 65 78 74 20 61 73 20 2d 73 te to text as -s
25c0: 74 61 74 65 0a 20 20 20 20 64 65 6c 65 67 61 74 tate. delegat
25d0: 65 20 6f 70 74 69 6f 6e 20 2d 5f 68 65 69 67 68 e option -_heigh
25e0: 74 20 74 6f 20 74 65 78 74 20 61 73 20 2d 68 65 t to text as -he
25f0: 69 67 68 74 0a 20 20 20 20 0a 20 20 20 20 64 65 ight. . de
2600: 6c 65 67 61 74 65 20 6d 65 74 68 6f 64 20 74 72 legate method tr
2610: 65 65 5f 69 74 65 6d 20 74 6f 20 74 6f 63 74 72 ee_item to toctr
2620: 65 65 20 61 73 20 69 74 65 6d 0a 20 20 20 20 64 ee as item. d
2630: 65 6c 65 67 61 74 65 20 6f 70 74 69 6f 6e 20 2d elegate option -
2640: 63 6f 6c 75 6d 6e 73 5f 6c 69 73 74 20 74 6f 20 columns_list to
2650: 74 6f 63 74 72 65 65 0a 20 20 20 20 0a 20 20 20 toctree. .
2660: 20 63 6f 6e 73 74 72 75 63 74 6f 72 20 61 72 67 constructor arg
2670: 73 20 7b 0a 0a 09 24 68 75 6c 6c 20 63 6f 6e 66 s {...$hull conf
2680: 69 67 75 72 65 20 2d 62 61 63 6b 67 72 6f 75 6e igure -backgroun
2690: 64 20 23 61 34 62 39 37 66 20 2d 62 64 20 30 0a d #a4b97f -bd 0.
26a0: 09 69 6e 73 74 61 6c 6c 20 74 65 78 74 20 75 73 .install text us
26b0: 69 6e 67 20 74 65 78 74 20 24 77 69 6e 2e 74 20 ing text $win.t
26c0: 2d 77 72 61 70 20 77 6f 72 64 20 2d 77 69 64 74 -wrap word -widt
26d0: 68 20 34 30 20 2d 68 65 69 67 68 74 20 33 20 2d h 40 -height 3 -
26e0: 62 6f 72 64 65 72 77 69 64 74 68 20 30 20 2d 68 borderwidth 0 -h
26f0: 69 67 68 6c 69 67 68 74 74 68 69 63 6b 6e 65 73 ighlightthicknes
2700: 73 20 30 0a 09 0a 09 63 75 3a 3a 61 64 64 5f 63 s 0....cu::add_c
2710: 6f 6e 74 65 78 74 75 61 6c 5f 6d 65 6e 75 5f 74 ontextual_menu_t
2720: 6f 5f 65 6e 74 72 79 20 24 74 65 78 74 20 69 6e o_entry $text in
2730: 69 74 0a 0a 09 67 72 69 64 20 24 74 65 78 74 20 it...grid $text
2740: 2d 70 61 64 78 20 31 20 2d 70 61 64 79 20 31 20 -padx 1 -pady 1
2750: 2d 73 74 69 63 6b 79 20 6e 73 65 77 0a 09 67 72 -sticky nsew..gr
2760: 69 64 20 63 6f 6c 75 6d 6e 63 6f 6e 66 69 67 75 id columnconfigu
2770: 72 65 20 24 77 69 6e 20 30 20 2d 77 65 69 67 68 re $win 0 -weigh
2780: 74 20 31 0a 09 67 72 69 64 20 72 6f 77 63 6f 6e t 1..grid rowcon
2790: 66 69 67 75 72 65 20 24 77 69 6e 20 30 20 2d 77 figure $win 0 -w
27a0: 65 69 67 68 74 20 31 0a 0a 09 62 69 6e 64 20 24 eight 1...bind $
27b0: 73 65 6c 66 20 3c 43 6f 6e 66 69 67 75 72 65 3e self <Configure>
27c0: 20 5b 6d 79 6d 65 74 68 6f 64 20 5f 63 68 65 63 [mymethod _chec
27d0: 6b 5f 63 6f 6e 66 69 67 75 72 65 5d 0a 09 62 69 k_configure]..bi
27e0: 6e 64 20 24 74 65 78 74 20 3c 54 61 62 3e 20 22 nd $text <Tab> "
27f0: 5b 62 69 6e 64 20 61 6c 6c 20 3c 54 61 62 3e 5d [bind all <Tab>]
2800: 20 3b 20 62 72 65 61 6b 22 0a 09 62 69 6e 64 20 ; break"..bind
2810: 24 74 65 78 74 20 3c 3c 50 72 65 76 57 69 6e 64 $text <<PrevWind
2820: 6f 77 3e 3e 20 22 5b 62 69 6e 64 20 61 6c 6c 20 ow>> "[bind all
2830: 3c 3c 50 72 65 76 57 69 6e 64 6f 77 3e 3e 5d 20 <<PrevWindow>>]
2840: 3b 20 62 72 65 61 6b 22 0a 09 62 69 6e 64 20 24 ; break"..bind $
2850: 74 65 78 74 20 3c 4b 65 79 50 72 65 73 73 3e 20 text <KeyPress>
2860: 5b 6d 79 6d 65 74 68 6f 64 20 6b 65 79 70 72 65 [mymethod keypre
2870: 73 73 5d 0a 09 62 69 6e 64 74 61 67 73 20 24 74 ss]..bindtags $t
2880: 65 78 74 20 5b 6c 69 73 74 20 24 77 69 6e 20 24 ext [list $win $
2890: 74 65 78 74 20 5b 77 69 6e 66 6f 20 63 6c 61 73 text [winfo clas
28a0: 73 20 24 77 69 6e 5d 20 5b 77 69 6e 66 6f 20 63 s $win] [winfo c
28b0: 6c 61 73 73 20 24 74 65 78 74 5d 20 5b 77 69 6e lass $text] [win
28c0: 66 6f 20 74 6f 70 6c 65 76 65 6c 20 24 74 65 78 fo toplevel $tex
28d0: 74 5d 20 61 6c 6c 5d 0a 09 62 69 6e 64 20 24 77 t] all]..bind $w
28e0: 69 6e 20 3c 46 6f 63 75 73 49 6e 3e 20 5b 6c 69 in <FocusIn> [li
28f0: 73 74 20 66 6f 63 75 73 20 24 74 65 78 74 5d 0a st focus $text].
2900: 09 24 73 65 6c 66 20 63 6f 6e 66 69 67 75 72 65 .$self configure
2910: 6c 69 73 74 20 24 61 72 67 73 0a 20 20 20 20 7d list $args. }
2920: 0a 20 20 20 20 64 65 73 74 72 75 63 74 6f 72 20 . destructor
2930: 7b 0a 09 24 73 65 6c 66 20 5f 63 6c 65 61 6e 5f {..$self _clean_
2940: 74 72 61 63 65 73 0a 20 20 20 20 7d 0a 20 20 20 traces. }.
2950: 20 6f 6e 63 6f 6e 66 69 67 75 72 65 20 2d 73 74 onconfigure -st
2960: 61 74 65 20 7b 76 61 6c 75 65 7d 20 7b 0a 09 73 ate {value} {..s
2970: 65 74 20 6f 70 74 69 6f 6e 73 28 2d 73 74 61 74 et options(-stat
2980: 65 29 20 24 76 61 6c 75 65 0a 09 24 73 65 6c 66 e) $value..$self
2990: 20 5f 75 70 64 61 74 65 5f 73 74 61 74 65 0a 20 _update_state.
29a0: 20 20 20 7d 0a 20 20 20 20 6f 6e 63 6f 6e 66 69 }. onconfi
29b0: 67 75 72 65 20 2d 68 65 69 67 68 74 20 7b 76 61 gure -height {va
29c0: 6c 75 65 7d 20 7b 0a 09 73 65 74 20 6f 70 74 69 lue} {..set opti
29d0: 6f 6e 73 28 2d 68 65 69 67 68 74 29 20 24 76 61 ons(-height) $va
29e0: 6c 75 65 0a 09 0a 09 24 73 65 6c 66 20 63 6f 6e lue....$self con
29f0: 66 69 67 75 72 65 20 2d 5f 68 65 69 67 68 74 20 figure -_height
2a00: 5b 6c 69 6e 64 65 78 20 24 76 61 6c 75 65 20 30 [lindex $value 0
2a10: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 6f 6e 63 6f ]. }. onco
2a20: 6e 66 69 67 75 72 65 20 2d 74 65 78 74 76 61 72 nfigure -textvar
2a30: 69 61 62 6c 65 20 7b 76 61 6c 75 65 7d 20 7b 0a iable {value} {.
2a40: 09 24 73 65 6c 66 20 5f 63 6c 65 61 6e 5f 74 72 .$self _clean_tr
2a50: 61 63 65 73 0a 09 73 65 74 20 6f 70 74 69 6f 6e aces..set option
2a60: 73 28 2d 74 65 78 74 76 61 72 69 61 62 6c 65 29 s(-textvariable)
2a70: 20 24 76 61 6c 75 65 0a 0a 09 73 65 74 20 63 6d $value...set cm
2a80: 64 20 22 5b 6d 79 6d 65 74 68 6f 64 20 5f 63 68 d "[mymethod _ch
2a90: 65 63 6b 5f 74 65 78 74 76 61 72 69 61 62 6c 65 eck_textvariable
2aa0: 5f 72 65 61 64 5d 20 3b 23 22 0a 09 74 72 61 63 _read] ;#"..trac
2ab0: 65 20 61 64 64 20 76 61 72 69 61 62 6c 65 20 24 e add variable $
2ac0: 6f 70 74 69 6f 6e 73 28 2d 74 65 78 74 76 61 72 options(-textvar
2ad0: 69 61 62 6c 65 29 20 72 65 61 64 20 24 63 6d 64 iable) read $cmd
2ae0: 0a 09 73 65 74 20 63 6d 64 20 22 5b 6d 79 6d 65 ..set cmd "[myme
2af0: 74 68 6f 64 20 5f 63 68 65 63 6b 5f 74 65 78 74 thod _check_text
2b00: 76 61 72 69 61 62 6c 65 5f 77 72 69 74 65 5d 20 variable_write]
2b10: 3b 23 22 0a 09 74 72 61 63 65 20 61 64 64 20 76 ;#"..trace add v
2b20: 61 72 69 61 62 6c 65 20 24 6f 70 74 69 6f 6e 73 ariable $options
2b30: 28 2d 74 65 78 74 76 61 72 69 61 62 6c 65 29 20 (-textvariable)
2b40: 77 72 69 74 65 20 24 63 6d 64 0a 09 24 73 65 6c write $cmd..$sel
2b50: 66 20 5f 63 68 65 63 6b 5f 74 65 78 74 76 61 72 f _check_textvar
2b60: 69 61 62 6c 65 5f 77 72 69 74 65 0a 20 20 20 20 iable_write.
2b70: 7d 0a 20 20 20 20 6f 6e 63 6f 6e 66 69 67 75 72 }. onconfigur
2b80: 65 20 2d 76 61 6c 75 65 73 20 7b 76 61 6c 75 65 e -values {value
2b90: 7d 20 7b 0a 09 73 65 74 20 6f 70 74 69 6f 6e 73 } {..set options
2ba0: 28 2d 76 61 6c 75 65 73 29 20 24 76 61 6c 75 65 (-values) $value
2bb0: 0a 09 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e ....if { $option
2bc0: 73 28 2d 76 61 6c 75 65 73 29 20 6e 65 20 22 22 s(-values) ne ""
2bd0: 20 7c 7c 20 24 6f 70 74 69 6f 6e 73 28 2d 76 61 || $options(-va
2be0: 6c 75 65 73 76 61 72 69 61 62 6c 65 29 20 6e 65 luesvariable) ne
2bf0: 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 24 73 65 "" } {.. $se
2c00: 6c 66 20 61 63 74 69 76 61 74 65 5f 6d 65 6e 75 lf activate_menu
2c10: 62 75 74 74 6f 6e 0a 0a 09 20 20 20 20 24 73 65 button... $se
2c20: 6c 66 20 74 72 65 65 5f 69 74 65 6d 20 64 65 6c lf tree_item del
2c30: 65 74 65 20 61 6c 6c 0a 09 20 20 20 20 24 73 65 ete all.. $se
2c40: 6c 66 20 74 72 65 65 5f 69 6e 73 65 72 74 20 65 lf tree_insert e
2c50: 6e 64 20 5b 5f 20 22 28 43 6c 65 61 72 29 22 5d nd [_ "(Clear)"]
2c60: 20 22 22 20 30 0a 09 20 20 20 20 66 6f 72 65 61 "" 0.. forea
2c70: 63 68 20 69 20 24 76 61 6c 75 65 20 7b 0a 09 09 ch i $value {...
2c80: 24 73 65 6c 66 20 74 72 65 65 5f 69 6e 73 65 72 $self tree_inser
2c90: 74 20 65 6e 64 20 24 69 20 24 69 20 30 0a 09 20 t end $i $i 0..
2ca0: 20 20 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b }..} elseif {
2cb0: 20 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 ![winfo exists
2cc0: 24 77 69 6e 2e 62 5d 20 7d 20 7b 0a 09 20 20 20 $win.b] } {..
2cd0: 20 64 65 73 74 72 6f 79 20 24 77 69 6e 2e 62 0a destroy $win.b.
2ce0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6f 6e 63 .}. }. onc
2cf0: 6f 6e 66 69 67 75 72 65 20 2d 76 61 6c 75 65 73 onfigure -values
2d00: 76 61 72 69 61 62 6c 65 20 7b 76 61 6c 75 65 7d variable {value}
2d10: 20 7b 0a 09 73 65 74 20 6f 70 74 69 6f 6e 73 28 {..set options(
2d20: 2d 76 61 6c 75 65 73 76 61 72 69 61 62 6c 65 29 -valuesvariable)
2d30: 20 24 76 61 6c 75 65 0a 0a 09 0a 09 69 66 20 7b $value.....if {
2d40: 20 24 6f 70 74 69 6f 6e 73 28 2d 76 61 6c 75 65 $options(-value
2d50: 73 29 20 6e 65 20 22 22 20 7c 7c 20 24 6f 70 74 s) ne "" || $opt
2d60: 69 6f 6e 73 28 2d 76 61 6c 75 65 73 76 61 72 69 ions(-valuesvari
2d70: 61 62 6c 65 29 20 6e 65 20 22 22 20 7d 20 7b 0a able) ne "" } {.
2d80: 09 20 20 20 20 24 73 65 6c 66 20 61 63 74 69 76 . $self activ
2d90: 61 74 65 5f 6d 65 6e 75 62 75 74 74 6f 6e 0a 09 ate_menubutton..
2da0: 7d 0a 09 75 70 76 61 72 20 23 30 20 24 6f 70 74 }..upvar #0 $opt
2db0: 69 6f 6e 73 28 2d 76 61 6c 75 65 73 76 61 72 69 ions(-valuesvari
2dc0: 61 62 6c 65 29 20 76 0a 0a 09 69 66 20 7b 20 5b able) v...if { [
2dd0: 69 6e 66 6f 20 65 78 69 73 74 73 20 76 5d 20 7d info exists v] }
2de0: 20 7b 0a 09 20 20 20 20 24 73 65 6c 66 20 5f 63 {.. $self _c
2df0: 68 61 6e 67 65 64 5f 76 61 6c 75 65 73 5f 76 61 hanged_values_va
2e00: 72 0a 09 20 20 20 20 74 72 61 63 65 20 61 64 64 r.. trace add
2e10: 20 76 61 72 69 61 62 6c 65 20 76 20 77 72 69 74 variable v writ
2e20: 65 20 22 5b 6d 79 6d 65 74 68 6f 64 20 5f 63 68 e "[mymethod _ch
2e30: 61 6e 67 65 64 5f 76 61 6c 75 65 73 5f 76 61 72 anged_values_var
2e40: 5d 3b 23 22 0a 09 7d 20 65 6c 73 65 69 66 20 7b ];#"..} elseif {
2e50: 20 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 ![winfo exists
2e60: 24 77 69 6e 2e 62 5d 20 7d 20 7b 0a 09 20 20 20 $win.b] } {..
2e70: 20 64 65 73 74 72 6f 79 20 24 77 69 6e 2e 62 0a destroy $win.b.
2e80: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 .}. }. met
2e90: 68 6f 64 20 61 63 74 69 76 61 74 65 5f 6d 65 6e hod activate_men
2ea0: 75 62 75 74 74 6f 6e 20 7b 7d 20 7b 0a 0a 09 69 ubutton {} {...i
2eb0: 66 20 7b 20 5b 77 69 6e 66 6f 20 65 78 69 73 74 f { [winfo exist
2ec0: 73 20 24 77 69 6e 2e 62 5d 20 7d 20 7b 20 72 65 s $win.b] } { re
2ed0: 74 75 72 6e 20 7d 0a 0a 09 69 66 20 7b 20 5b 69 turn }...if { [i
2ee0: 6e 66 6f 20 63 6f 6d 6d 61 6e 64 20 3a 3a 63 75 nfo command ::cu
2ef0: 3a 3a 6d 75 6c 74 69 6c 69 6e 65 5f 65 6e 74 72 ::multiline_entr
2f00: 79 3a 3a 6e 61 76 31 64 6f 77 6e 61 72 72 6f 77 y::nav1downarrow
2f10: 31 36 5d 20 65 71 20 22 22 20 7d 20 7b 0a 09 20 16] eq "" } {..
2f20: 20 20 20 69 6d 61 67 65 20 63 72 65 61 74 65 20 image create
2f30: 70 68 6f 74 6f 20 3a 3a 63 75 3a 3a 6d 75 6c 74 photo ::cu::mult
2f40: 69 6c 69 6e 65 5f 65 6e 74 72 79 3a 3a 6e 61 76 iline_entry::nav
2f50: 31 64 6f 77 6e 61 72 72 6f 77 31 36 20 2d 64 61 1downarrow16 -da
2f60: 74 61 20 7b 0a 09 09 52 30 6c 47 4f 44 6c 68 45 ta {...R0lGODlhE
2f70: 41 41 51 41 49 41 41 41 50 77 43 42 41 51 43 42 AAQAIAAAPwCBAQCB
2f80: 43 48 35 42 41 45 41 41 41 41 41 4c 41 41 41 41 CH5BAEAAAAALAAAA
2f90: 41 41 51 41 42 41 41 41 41 49 59 68 49 2b 70 79 AAQABAAAAIYhI+py
2fa0: 2b 30 50 55 5a 69 30 7a 6d 54 74 79 70 66 6c 56 +0PUZi0zmTtypflV
2fb0: 30 56 64 0a 09 09 52 4a 62 6d 36 66 67 46 41 43 0Vd...RJbm6fgFAC
2fc0: 48 2b 61 45 4e 79 5a 57 46 30 5a 57 51 67 59 6e H+aENyZWF0ZWQgYn
2fd0: 6b 67 51 6b 31 51 56 47 39 48 53 55 59 67 55 48 kgQk1QVG9HSUYgUH
2fe0: 4a 76 49 48 5a 6c 63 6e 4e 70 62 32 34 67 4d 69 JvIHZlcnNpb24gMi
2ff0: 34 31 44 51 71 70 49 45 52 6c 64 6d 56 73 51 32 41DQqpIERldmVsQ2
3000: 39 79 0a 09 09 49 44 45 35 4f 54 63 73 4d 54 6b 9y...IDE5OTcsMTk
3010: 35 4f 43 34 67 51 57 78 73 49 48 4a 70 5a 32 68 5OC4gQWxsIHJpZ2h
3020: 30 63 79 42 79 5a 58 4e 6c 63 6e 5a 6c 5a 43 34 0cyByZXNlcnZlZC4
3030: 4e 43 6d 68 30 64 48 41 36 4c 79 39 33 64 33 63 NCmh0dHA6Ly93d3c
3040: 75 5a 47 56 32 5a 57 78 6a 62 33 49 75 59 32 39 uZGV2ZWxjb3IuY29
3050: 74 0a 09 09 41 44 73 3d 0a 09 20 20 20 20 7d 0a t...ADs=.. }.
3060: 09 7d 0a 09 74 74 6b 3a 3a 6d 65 6e 75 62 75 74 .}..ttk::menubut
3070: 74 6f 6e 20 24 77 69 6e 2e 62 20 2d 69 6d 61 67 ton $win.b -imag
3080: 65 20 3a 3a 63 75 3a 3a 6d 75 6c 74 69 6c 69 6e e ::cu::multilin
3090: 65 5f 65 6e 74 72 79 3a 3a 6e 61 76 31 64 6f 77 e_entry::nav1dow
30a0: 6e 61 72 72 6f 77 31 36 20 2d 73 74 79 6c 65 20 narrow16 -style
30b0: 54 6f 6f 6c 62 75 74 74 6f 6e 0a 09 0a 09 62 69 Toolbutton....bi
30c0: 6e 64 20 24 77 69 6e 2e 62 20 3c 42 75 74 74 6f nd $win.b <Butto
30d0: 6e 50 72 65 73 73 2d 31 3e 20 5b 6d 79 6d 65 74 nPress-1> [mymet
30e0: 68 6f 64 20 42 50 31 20 25 78 20 25 79 5d 0a 09 hod BP1 %x %y]..
30f0: 62 69 6e 64 20 24 77 69 6e 2e 62 20 3c 42 75 74 bind $win.b <But
3100: 74 6f 6e 52 65 6c 65 61 73 65 2d 31 3e 20 5b 6d tonRelease-1> [m
3110: 79 6d 65 74 68 6f 64 20 42 52 31 20 25 78 20 25 ymethod BR1 %x %
3120: 79 5d 0a 09 0a 09 73 65 74 20 74 6f 63 74 72 65 y]....set toctre
3130: 65 20 24 77 69 6e 2e 62 2e 6d 0a 09 63 75 3a 3a e $win.b.m..cu::
3140: 5f 6d 65 6e 75 62 75 74 74 6f 6e 5f 74 72 65 65 _menubutton_tree
3150: 5f 68 65 6c 70 65 72 20 24 74 6f 63 74 72 65 65 _helper $toctree
3160: 20 2d 70 61 72 65 6e 74 20 24 77 69 6e 20 5c 0a -parent $win \.
3170: 09 20 20 20 20 2d 62 75 74 74 6f 6e 31 68 61 6e . -button1han
3180: 64 6c 65 72 20 5b 6d 79 6d 65 74 68 6f 64 20 70 dler [mymethod p
3190: 72 65 73 73 5d 20 2d 72 65 74 75 72 6e 68 61 6e ress] -returnhan
31a0: 64 6c 65 72 20 5b 6d 79 6d 65 74 68 6f 64 20 70 dler [mymethod p
31b0: 72 65 73 73 5f 72 65 74 75 72 6e 5d 0a 09 77 6d ress_return]..wm
31c0: 20 77 69 74 68 64 72 61 77 20 24 74 6f 63 74 72 withdraw $toctr
31d0: 65 65 0a 09 0a 09 62 69 6e 64 20 20 24 77 69 6e ee....bind $win
31e0: 2e 62 2e 6d 20 3c 73 70 61 63 65 3e 20 5b 6d 79 .b.m <space> [my
31f0: 6d 65 74 68 6f 64 20 70 6f 73 74 5d 0a 09 62 69 method post]..bi
3200: 6e 64 20 20 24 77 69 6e 2e 62 2e 6d 20 3c 52 65 nd $win.b.m <Re
3210: 74 75 72 6e 3e 20 5b 6d 79 6d 65 74 68 6f 64 20 turn> [mymethod
3220: 70 6f 73 74 5d 0a 09 0a 09 62 69 6e 64 20 24 74 post]....bind $t
3230: 6f 63 74 72 65 65 20 3c 3c 43 6f 6d 62 6f 62 6f octree <<Combobo
3240: 78 53 65 6c 65 63 74 65 64 3e 3e 20 5b 6d 79 6d xSelected>> [mym
3250: 65 74 68 6f 64 20 65 6e 64 70 6f 73 74 5d 0a 09 ethod endpost]..
3260: 0a 09 67 72 69 64 20 24 77 69 6e 2e 62 20 2d 72 ..grid $win.b -r
3270: 6f 77 20 30 20 2d 63 6f 6c 75 6d 6e 20 31 20 2d ow 0 -column 1 -
3280: 70 61 64 78 20 22 30 20 31 22 20 2d 70 61 64 79 padx "0 1" -pady
3290: 20 31 20 2d 73 74 69 63 6b 79 20 77 6e 73 0a 20 1 -sticky wns.
32a0: 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 }. method
32b0: 67 69 76 65 5f 77 69 6e 20 7b 7d 20 7b 0a 09 72 give_win {} {..r
32c0: 65 74 75 72 6e 20 24 74 65 78 74 0a 20 20 20 20 eturn $text.
32d0: 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 67 69 76 }. method giv
32e0: 65 5f 74 72 65 65 20 7b 7d 20 7b 0a 09 72 65 74 e_tree {} {..ret
32f0: 75 72 6e 20 24 74 6f 63 74 72 65 65 0a 20 20 20 urn $toctree.
3300: 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 73 65 }. method se
3310: 74 5f 74 65 78 74 20 7b 20 74 78 74 20 7d 20 7b t_text { txt } {
3320: 0a 09 66 6f 63 75 73 20 24 74 65 78 74 0a 09 75 ..focus $text..u
3330: 70 64 61 74 65 20 69 64 6c 65 74 61 73 6b 73 0a pdate idletasks.
3340: 09 24 74 65 78 74 20 64 65 6c 65 74 65 20 31 2e .$text delete 1.
3350: 30 20 65 6e 64 0a 09 24 74 65 78 74 20 69 6e 73 0 end..$text ins
3360: 65 72 74 20 65 6e 64 20 24 74 78 74 0a 09 24 74 ert end $txt..$t
3370: 65 78 74 20 74 61 67 20 61 64 64 20 73 65 6c 20 ext tag add sel
3380: 31 2e 30 20 65 6e 64 2d 31 63 0a 09 24 73 65 6c 1.0 end-1c..$sel
3390: 66 20 5f 63 68 65 63 6b 5f 63 6f 6e 66 69 67 75 f _check_configu
33a0: 72 65 0a 09 24 73 65 6c 66 20 5f 75 70 64 61 74 re..$self _updat
33b0: 65 5f 73 74 61 74 65 0a 20 20 20 20 7d 0a 20 20 e_state. }.
33c0: 20 20 6d 65 74 68 6f 64 20 69 6e 73 65 72 74 20 method insert
33d0: 7b 20 61 72 67 73 20 7d 20 7b 0a 09 24 73 65 6c { args } {..$sel
33e0: 66 20 5f 69 6e 73 65 72 74 20 7b 2a 7d 24 61 72 f _insert {*}$ar
33f0: 67 73 0a 09 24 73 65 6c 66 20 5f 63 68 65 63 6b gs..$self _check
3400: 5f 63 6f 6e 66 69 67 75 72 65 0a 09 24 73 65 6c _configure..$sel
3410: 66 20 5f 75 70 64 61 74 65 5f 73 74 61 74 65 0a f _update_state.
3420: 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 }. method
3430: 20 6b 65 79 70 72 65 73 73 20 7b 7d 20 7b 0a 09 keypress {} {..
3440: 61 66 74 65 72 20 69 64 6c 65 20 5b 6d 79 6d 65 after idle [myme
3450: 74 68 6f 64 20 5f 63 68 65 63 6b 5f 63 6f 6e 66 thod _check_conf
3460: 69 67 75 72 65 5d 0a 09 61 66 74 65 72 20 69 64 igure]..after id
3470: 6c 65 20 5b 6d 79 6d 65 74 68 6f 64 20 5f 75 70 le [mymethod _up
3480: 64 61 74 65 5f 73 74 61 74 65 5d 0a 20 20 20 20 date_state].
3490: 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 5f 75 70 }. method _up
34a0: 64 61 74 65 5f 73 74 61 74 65 20 7b 7d 20 7b 0a date_state {} {.
34b0: 09 0a 09 73 77 69 74 63 68 20 24 6f 70 74 69 6f ...switch $optio
34c0: 6e 73 28 2d 73 74 61 74 65 29 20 7b 0a 09 20 20 ns(-state) {..
34d0: 20 20 64 69 73 61 62 6c 65 64 20 7b 0a 09 09 24 disabled {...$
34e0: 73 65 6c 66 20 63 6f 6e 66 69 67 75 72 65 20 2d self configure -
34f0: 5f 73 74 61 74 65 20 64 69 73 61 62 6c 65 64 20 _state disabled
3500: 2d 66 6f 72 65 67 72 6f 75 6e 64 20 67 72 65 79 -foreground grey
3510: 20 2d 68 69 67 68 6c 69 67 68 74 74 68 69 63 6b -highlightthick
3520: 6e 65 73 73 20 30 0a 09 09 67 72 69 64 20 63 6f ness 0...grid co
3530: 6e 66 69 67 75 72 65 20 24 74 65 78 74 20 2d 70 nfigure $text -p
3540: 61 64 78 20 31 20 2d 70 61 64 79 20 31 0a 09 20 adx 1 -pady 1..
3550: 20 20 20 7d 0a 09 20 20 20 20 72 65 61 64 6f 6e }.. readon
3560: 6c 79 20 7b 0a 09 09 24 73 65 6c 66 20 63 6f 6e ly {...$self con
3570: 66 69 67 75 72 65 20 2d 5f 73 74 61 74 65 20 64 figure -_state d
3580: 69 73 61 62 6c 65 64 20 2d 66 6f 72 65 67 72 6f isabled -foregro
3590: 75 6e 64 20 62 6c 61 63 6b 20 2d 68 69 67 68 6c und black -highl
35a0: 69 67 68 74 74 68 69 63 6b 6e 65 73 73 20 30 0a ightthickness 0.
35b0: 09 09 67 72 69 64 20 20 63 6f 6e 66 69 67 75 72 ..grid configur
35c0: 65 20 24 74 65 78 74 20 2d 70 61 64 78 20 30 20 e $text -padx 0
35d0: 2d 70 61 64 79 20 30 0a 09 20 20 20 20 7d 0a 09 -pady 0.. }..
35e0: 20 20 20 20 64 65 66 61 75 6c 74 20 7b 0a 09 09 default {...
35f0: 24 73 65 6c 66 20 63 6f 6e 66 69 67 75 72 65 20 $self configure
3600: 2d 5f 73 74 61 74 65 20 6e 6f 72 6d 61 6c 20 2d -_state normal -
3610: 66 6f 72 65 67 72 6f 75 6e 64 20 62 6c 61 63 6b foreground black
3620: 20 2d 68 69 67 68 6c 69 67 68 74 74 68 69 63 6b -highlightthick
3630: 6e 65 73 73 20 31 0a 09 09 67 72 69 64 20 20 63 ness 1...grid c
3640: 6f 6e 66 69 67 75 72 65 20 24 74 65 78 74 20 2d onfigure $text -
3650: 70 61 64 78 20 31 20 2d 70 61 64 79 20 31 0a 09 padx 1 -pady 1..
3660: 20 20 20 20 7d 0a 09 7d 0a 09 69 66 20 7b 20 24 }..}..if { $
3670: 6f 70 74 69 6f 6e 73 28 2d 6a 75 73 74 69 66 79 options(-justify
3680: 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 20 20 20 ) ne "" } {..
3690: 20 24 73 65 6c 66 20 74 61 67 20 63 6f 6e 66 69 $self tag confi
36a0: 67 75 72 65 20 6a 75 73 74 69 66 79 20 2d 6a 75 gure justify -ju
36b0: 73 74 69 66 79 20 24 6f 70 74 69 6f 6e 73 28 2d stify $options(-
36c0: 6a 75 73 74 69 66 79 29 0a 09 20 20 20 20 24 73 justify).. $s
36d0: 65 6c 66 20 74 61 67 20 61 64 64 20 6a 75 73 74 elf tag add just
36e0: 69 66 79 20 31 2e 30 20 65 6e 64 0a 09 7d 0a 20 ify 1.0 end..}.
36f0: 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 }. method
3700: 5f 63 6c 65 61 6e 5f 74 72 61 63 65 73 20 7b 7d _clean_traces {}
3710: 20 7b 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e {..if { $option
3720: 73 28 2d 74 65 78 74 76 61 72 69 61 62 6c 65 29 s(-textvariable)
3730: 20 6e 65 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 ne "" } {..
3740: 73 65 74 20 63 6d 64 20 22 5b 6d 79 6d 65 74 68 set cmd "[mymeth
3750: 6f 64 20 5f 63 68 65 63 6b 5f 74 65 78 74 76 61 od _check_textva
3760: 72 69 61 62 6c 65 5f 72 65 61 64 5d 20 3b 23 22 riable_read] ;#"
3770: 0a 09 20 20 20 20 74 72 61 63 65 20 72 65 6d 6f .. trace remo
3780: 76 65 20 76 61 72 69 61 62 6c 65 20 24 6f 70 74 ve variable $opt
3790: 69 6f 6e 73 28 2d 74 65 78 74 76 61 72 69 61 62 ions(-textvariab
37a0: 6c 65 29 20 72 65 61 64 20 24 63 6d 64 0a 09 20 le) read $cmd..
37b0: 20 20 20 73 65 74 20 63 6d 64 20 22 5b 6d 79 6d set cmd "[mym
37c0: 65 74 68 6f 64 20 5f 63 68 65 63 6b 5f 74 65 78 ethod _check_tex
37d0: 74 76 61 72 69 61 62 6c 65 5f 77 72 69 74 65 5d tvariable_write]
37e0: 20 3b 23 22 0a 09 20 20 20 20 74 72 61 63 65 20 ;#".. trace
37f0: 72 65 6d 6f 76 65 20 76 61 72 69 61 62 6c 65 20 remove variable
3800: 24 6f 70 74 69 6f 6e 73 28 2d 74 65 78 74 76 61 $options(-textva
3810: 72 69 61 62 6c 65 29 20 77 72 69 74 65 20 24 63 riable) write $c
3820: 6d 64 0a 09 7d 0a 09 69 66 20 7b 20 24 6f 70 74 md..}..if { $opt
3830: 69 6f 6e 73 28 2d 76 61 6c 75 65 73 76 61 72 69 ions(-valuesvari
3840: 61 62 6c 65 29 20 6e 65 20 22 22 20 7d 20 7b 0a able) ne "" } {.
3850: 09 20 20 20 20 75 70 76 61 72 20 23 30 20 24 6f . upvar #0 $o
3860: 70 74 69 6f 6e 73 28 2d 76 61 6c 75 65 73 76 61 ptions(-valuesva
3870: 72 69 61 62 6c 65 29 20 76 0a 09 20 20 20 20 74 riable) v.. t
3880: 72 61 63 65 20 72 65 6d 6f 76 65 20 76 61 72 69 race remove vari
3890: 61 62 6c 65 20 76 20 77 72 69 74 65 20 22 5b 6d able v write "[m
38a0: 79 6d 65 74 68 6f 64 20 5f 63 68 61 6e 67 65 64 ymethod _changed
38b0: 5f 76 61 6c 75 65 73 5f 76 61 72 5d 3b 23 22 0a _values_var];#".
38c0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 .}. }. met
38d0: 68 6f 64 20 42 50 31 20 7b 20 78 20 79 20 7d 20 hod BP1 { x y }
38e0: 7b 0a 20 20 20 20 20 20 20 24 73 65 6c 66 20 70 {. $self p
38f0: 6f 73 74 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 ost. }. me
3900: 74 68 6f 64 20 42 52 31 20 7b 20 78 20 79 20 7d thod BR1 { x y }
3910: 20 7b 0a 09 24 77 69 6e 2e 62 20 69 6e 73 74 61 {..$win.b insta
3920: 74 65 20 7b 70 72 65 73 73 65 64 20 21 64 69 73 te {pressed !dis
3930: 61 62 6c 65 64 7d 20 7b 0a 09 20 20 20 20 24 77 abled} {.. $w
3940: 69 6e 2e 62 20 73 74 61 74 65 20 21 70 72 65 73 in.b state !pres
3950: 73 65 64 0a 09 7d 0a 09 72 65 74 75 72 6e 20 2d sed..}..return -
3960: 63 6f 64 65 20 62 72 65 61 6b 0a 20 20 20 20 7d code break. }
3970: 0a 20 20 20 20 6d 65 74 68 6f 64 20 70 72 65 73 . method pres
3980: 73 5f 72 65 74 75 72 6e 20 7b 20 74 20 69 64 73 s_return { t ids
3990: 20 7d 20 7b 0a 09 24 73 65 6c 66 20 70 72 65 73 } {..$self pres
39a0: 73 20 24 74 20 24 69 64 73 20 5b 6c 69 73 74 20 s $t $ids [list
39b0: 69 74 65 6d 20 5b 6c 69 6e 64 65 78 20 24 69 64 item [lindex $id
39c0: 73 20 30 5d 20 63 6f 6c 75 6d 6e 20 30 20 65 6c s 0] column 0 el
39d0: 65 6d 20 65 5f 74 65 78 74 5f 73 65 6c 5d 20 22 em e_text_sel] "
39e0: 22 20 22 22 0a 20 20 20 20 7d 0a 20 20 20 20 6d " "". }. m
39f0: 65 74 68 6f 64 20 70 72 65 73 73 20 7b 20 74 20 ethod press { t
3a00: 69 64 73 20 69 64 65 6e 74 69 66 79 20 78 20 79 ids identify x y
3a10: 20 7d 20 7b 0a 09 73 65 74 20 69 64 20 5b 6c 69 } {..set id [li
3a20: 6e 64 65 78 20 24 69 64 73 20 30 5d 0a 09 0a 09 ndex $ids 0]....
3a30: 69 66 20 7b 20 21 5b 72 65 67 65 78 70 20 7b 69 if { ![regexp {i
3a40: 74 65 6d 20 5c 53 2b 20 63 6f 6c 75 6d 6e 20 5c tem \S+ column \
3a50: 53 2b 20 65 6c 65 6d 20 28 5c 53 2b 29 7d 20 24 S+ elem (\S+)} $
3a60: 69 64 65 6e 74 69 66 79 20 7b 7d 20 65 6c 65 6d identify {} elem
3a70: 5d 20 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 ] } {.. retur
3a80: 6e 0a 09 7d 0a 09 69 66 20 7b 20 24 65 6c 65 6d n..}..if { $elem
3a90: 20 65 71 20 22 65 5f 69 6d 61 67 65 5f 72 22 20 eq "e_image_r"
3aa0: 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 6e 20 } {.. return
3ab0: 5b 24 73 65 6c 66 20 63 6c 65 61 72 5f 74 72 65 [$self clear_tre
3ac0: 65 5f 65 6e 74 72 79 20 24 69 64 5d 0a 09 7d 0a e_entry $id]..}.
3ad0: 09 69 66 20 7b 20 5b 64 69 63 74 20 65 78 69 73 .if { [dict exis
3ae0: 74 73 20 24 63 6d 64 5f 69 74 65 6d 73 20 24 69 ts $cmd_items $i
3af0: 64 5d 20 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b d] } {.. if {
3b00: 20 21 5b 64 69 63 74 20 65 78 69 73 74 73 20 24 ![dict exists $
3b10: 6e 6f 5f 61 63 74 69 76 65 5f 69 74 65 6d 73 20 no_active_items
3b20: 24 69 64 5d 20 7d 20 7b 20 0a 09 09 24 73 65 6c $id] } { ...$sel
3b30: 66 20 61 63 74 69 6f 6e 20 4c 42 43 61 6e 63 65 f action LBCance
3b40: 6c 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 75 70 l.. }.. up
3b50: 6c 65 76 65 6c 20 23 30 20 5b 64 69 63 74 20 67 level #0 [dict g
3b60: 65 74 20 24 63 6d 64 5f 69 74 65 6d 73 20 24 69 et $cmd_items $i
3b70: 64 5d 20 24 69 64 0a 09 20 20 20 20 72 65 74 75 d] $id.. retu
3b80: 72 6e 0a 09 7d 0a 09 69 66 20 7b 20 5b 64 69 63 rn..}..if { [dic
3b90: 74 20 65 78 69 73 74 73 20 24 6e 6f 5f 61 63 74 t exists $no_act
3ba0: 69 76 65 5f 69 74 65 6d 73 20 24 69 64 5d 20 7d ive_items $id] }
3bb0: 20 7b 20 72 65 74 75 72 6e 20 7d 0a 09 0a 09 24 { return }....$
3bc0: 73 65 6c 66 20 73 65 74 5f 74 65 78 74 20 5b 64 self set_text [d
3bd0: 69 63 74 20 67 65 74 20 24 66 6e 61 6d 65 73 20 ict get $fnames
3be0: 24 69 64 5d 0a 09 23 75 70 6c 65 76 65 6c 20 23 $id]..#uplevel #
3bf0: 30 20 24 6f 70 74 69 6f 6e 73 28 2d 63 6f 6d 6d 0 $options(-comm
3c00: 61 6e 64 29 20 5b 6c 69 73 74 20 5b 64 69 63 74 and) [list [dict
3c10: 20 67 65 74 20 24 66 6e 61 6d 65 73 20 24 69 64 get $fnames $id
3c20: 5d 5d 0a 09 24 74 6f 63 74 72 65 65 20 75 6e 70 ]]..$toctree unp
3c30: 6f 73 74 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 ost. }. me
3c40: 74 68 6f 64 20 63 6c 65 61 72 5f 74 72 65 65 5f thod clear_tree_
3c50: 65 6e 74 72 79 20 7b 20 69 64 20 7d 20 7b 0a 09 entry { id } {..
3c60: 73 65 74 20 74 78 74 20 5b 64 69 63 74 20 67 65 set txt [dict ge
3c70: 74 20 24 66 6e 61 6d 65 73 20 24 69 64 5d 0a 09 t $fnames $id]..
3c80: 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 74 if { $options(-t
3c90: 65 78 74 76 61 72 69 61 62 6c 65 29 20 6e 65 20 extvariable) ne
3ca0: 22 22 20 7d 20 7b 0a 09 20 20 20 20 75 70 76 61 "" } {.. upva
3cb0: 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d 76 r #0 $options(-v
3cc0: 61 6c 75 65 73 76 61 72 69 61 62 6c 65 29 20 76 aluesvariable) v
3cd0: 0a 09 20 20 20 20 73 65 74 20 69 70 6f 73 20 5b .. set ipos [
3ce0: 6c 73 65 61 72 63 68 20 2d 65 78 61 63 74 20 24 lsearch -exact $
3cf0: 76 20 24 74 78 74 5d 0a 09 20 20 20 20 73 65 74 v $txt].. set
3d00: 20 76 20 5b 6c 72 65 70 6c 61 63 65 20 24 76 20 v [lreplace $v
3d10: 24 69 70 6f 73 20 24 69 70 6f 73 5d 0a 09 7d 20 $ipos $ipos]..}
3d20: 65 6c 73 65 20 7b 0a 09 20 20 20 20 65 72 72 6f else {.. erro
3d30: 72 20 22 65 72 72 6f 72 20 69 6e 20 63 6c 65 61 r "error in clea
3d40: 72 5f 74 72 65 65 5f 65 6e 74 72 79 2e 20 6e 6f r_tree_entry. no
3d50: 74 20 69 6d 70 6c 65 6d 65 6e 74 65 64 22 0a 09 t implemented"..
3d60: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 }. }. meth
3d70: 6f 64 20 70 6f 73 74 20 7b 7d 20 7b 0a 09 24 77 od post {} {..$w
3d80: 69 6e 2e 62 20 69 6e 73 74 61 74 65 20 21 64 69 in.b instate !di
3d90: 73 61 62 6c 65 64 20 7b 0a 09 20 20 20 20 63 61 sabled {.. ca
3da0: 74 63 68 20 7b 20 74 69 6c 65 3a 3a 63 6c 69 63 tch { tile::clic
3db0: 6b 54 6f 46 6f 63 75 73 20 24 77 69 6e 2e 62 20 kToFocus $win.b
3dc0: 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 74 }.. catch { t
3dd0: 74 6b 3a 3a 63 6c 69 63 6b 54 6f 46 6f 63 75 73 tk::clickToFocus
3de0: 20 24 77 69 6e 2e 62 20 7d 0a 09 20 20 20 20 24 $win.b }.. $
3df0: 77 69 6e 2e 62 20 73 74 61 74 65 20 70 72 65 73 win.b state pres
3e00: 73 65 64 0a 09 20 20 20 20 73 65 74 20 78 20 5b sed.. set x [
3e10: 77 69 6e 66 6f 20 72 6f 6f 74 78 20 24 77 69 6e winfo rootx $win
3e20: 5d 0a 09 20 20 20 20 73 65 74 20 79 20 5b 65 78 ].. set y [ex
3e30: 70 72 20 7b 5b 77 69 6e 66 6f 20 72 6f 6f 74 79 pr {[winfo rooty
3e40: 20 24 77 69 6e 5d 2b 5b 77 69 6e 66 6f 20 68 65 $win]+[winfo he
3e50: 69 67 68 74 20 24 77 69 6e 5d 7d 5d 0a 09 20 20 ight $win]}]..
3e60: 20 20 24 74 6f 63 74 72 65 65 20 64 65 69 63 6f $toctree deico
3e70: 6e 69 66 79 20 24 78 20 24 79 20 5b 65 78 70 72 nify $x $y [expr
3e80: 20 7b 5b 77 69 6e 66 6f 20 77 69 64 74 68 20 24 {[winfo width $
3e90: 77 69 6e 5d 2d 30 7d 5d 0a 09 7d 0a 20 20 20 20 win]-0}]..}.
3ea0: 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 65 6e 64 }. method end
3eb0: 70 6f 73 74 20 7b 7d 20 7b 0a 09 24 77 69 6e 2e post {} {..$win.
3ec0: 62 20 69 6e 73 74 61 74 65 20 7b 70 72 65 73 73 b instate {press
3ed0: 65 64 20 21 64 69 73 61 62 6c 65 64 7d 20 7b 0a ed !disabled} {.
3ee0: 09 20 20 20 20 24 77 69 6e 2e 62 20 73 74 61 74 . $win.b stat
3ef0: 65 20 21 70 72 65 73 73 65 64 0a 09 7d 0a 09 65 e !pressed..}..e
3f00: 76 65 6e 74 20 67 65 6e 65 72 61 74 65 20 24 77 vent generate $w
3f10: 69 6e 2e 62 20 3c 3c 43 6f 6d 62 6f 62 6f 78 53 in.b <<ComboboxS
3f20: 65 6c 65 63 74 65 64 3e 3e 0a 20 20 20 20 7d 0a elected>>. }.
3f30: 20 20 20 20 6d 65 74 68 6f 64 20 5f 63 68 65 63 method _chec
3f40: 6b 5f 74 65 78 74 76 61 72 69 61 62 6c 65 5f 72 k_textvariable_r
3f50: 65 61 64 20 7b 7d 20 7b 0a 09 69 66 20 7b 20 24 ead {} {..if { $
3f60: 75 70 64 61 74 69 6e 67 20 7d 20 7b 20 72 65 74 updating } { ret
3f70: 75 72 6e 20 7d 0a 09 75 70 76 61 72 20 23 30 20 urn }..upvar #0
3f80: 24 6f 70 74 69 6f 6e 73 28 2d 74 65 78 74 76 61 $options(-textva
3f90: 72 69 61 62 6c 65 29 20 76 0a 09 73 65 74 20 76 riable) v..set v
3fa0: 20 5b 24 74 65 78 74 20 67 65 74 20 31 2e 30 20 [$text get 1.0
3fb0: 65 6e 64 2d 31 63 5d 0a 20 20 20 20 7d 0a 20 20 end-1c]. }.
3fc0: 20 20 6d 65 74 68 6f 64 20 5f 63 68 65 63 6b 5f method _check_
3fd0: 74 65 78 74 76 61 72 69 61 62 6c 65 5f 77 72 69 textvariable_wri
3fe0: 74 65 20 7b 7d 20 7b 0a 09 75 70 76 61 72 20 23 te {} {..upvar #
3ff0: 30 20 24 6f 70 74 69 6f 6e 73 28 2d 74 65 78 74 0 $options(-text
4000: 76 61 72 69 61 62 6c 65 29 20 76 0a 09 24 74 65 variable) v..$te
4010: 78 74 20 64 65 6c 65 74 65 20 31 2e 30 20 65 6e xt delete 1.0 en
4020: 64 0a 09 73 65 74 20 75 70 64 61 74 69 6e 67 20 d..set updating
4030: 31 0a 09 69 66 20 7b 20 5b 69 6e 66 6f 20 65 78 1..if { [info ex
4040: 69 73 74 73 20 76 5d 20 7d 20 7b 0a 09 20 20 20 ists v] } {..
4050: 20 24 74 65 78 74 20 69 6e 73 65 72 74 20 65 6e $text insert en
4060: 64 20 24 76 0a 09 7d 0a 09 73 65 74 20 75 70 64 d $v..}..set upd
4070: 61 74 69 6e 67 20 30 0a 09 24 73 65 6c 66 20 5f ating 0..$self _
4080: 63 68 65 63 6b 5f 63 6f 6e 66 69 67 75 72 65 0a check_configure.
4090: 09 24 73 65 6c 66 20 5f 75 70 64 61 74 65 5f 73 .$self _update_s
40a0: 74 61 74 65 0a 20 20 20 20 7d 0a 20 20 20 20 6d tate. }. m
40b0: 65 74 68 6f 64 20 5f 63 68 61 6e 67 65 64 5f 76 ethod _changed_v
40c0: 61 6c 75 65 73 5f 76 61 72 20 7b 7d 20 7b 0a 09 alues_var {} {..
40d0: 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 76 if { $options(-v
40e0: 61 6c 75 65 73 76 61 72 69 61 62 6c 65 29 20 6e aluesvariable) n
40f0: 65 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 75 70 e "" } {.. up
4100: 76 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 var #0 $options(
4110: 2d 76 61 6c 75 65 73 76 61 72 69 61 62 6c 65 29 -valuesvariable)
4120: 20 76 0a 09 20 20 20 20 0a 09 20 20 20 20 24 73 v.. .. $s
4130: 65 6c 66 20 74 72 65 65 5f 69 74 65 6d 20 64 65 elf tree_item de
4140: 6c 65 74 65 20 61 6c 6c 0a 09 20 20 20 20 24 73 lete all.. $s
4150: 65 6c 66 20 74 72 65 65 5f 69 6e 73 65 72 74 20 elf tree_insert
4160: 65 6e 64 20 5b 5f 20 22 28 43 6c 65 61 72 29 22 end [_ "(Clear)"
4170: 5d 20 22 22 20 30 0a 09 20 20 20 20 66 6f 72 65 ] "" 0.. fore
4180: 61 63 68 20 69 20 24 76 20 7b 0a 09 09 24 73 65 ach i $v {...$se
4190: 6c 66 20 74 72 65 65 5f 69 6e 73 65 72 74 20 65 lf tree_insert e
41a0: 6e 64 20 24 69 20 24 69 20 30 0a 09 20 20 20 20 nd $i $i 0..
41b0: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6d }..}. }. m
41c0: 65 74 68 6f 64 20 5f 63 68 65 63 6b 5f 63 6f 6e ethod _check_con
41d0: 66 69 67 75 72 65 20 7b 7d 20 7b 0a 09 0a 09 69 figure {} {....i
41e0: 66 20 7b 20 5b 77 69 6e 66 6f 20 77 69 64 74 68 f { [winfo width
41f0: 20 24 77 69 6e 5d 20 3c 3d 20 31 20 7d 20 7b 20 $win] <= 1 } {
4200: 72 65 74 75 72 6e 20 7d 0a 09 69 66 20 7b 20 5b return }..if { [
4210: 6c 6c 65 6e 67 74 68 20 24 6f 70 74 69 6f 6e 73 llength $options
4220: 28 2d 68 65 69 67 68 74 29 5d 20 3c 20 32 20 7d (-height)] < 2 }
4230: 20 7b 20 72 65 74 75 72 6e 20 7d 0a 09 73 65 74 { return }..set
4240: 20 64 73 20 5b 24 77 69 6e 20 63 6f 75 6e 74 20 ds [$win count
4250: 2d 64 69 73 70 6c 61 79 6c 69 6e 65 73 20 31 2e -displaylines 1.
4260: 30 20 65 6e 64 5d 0a 09 6c 61 73 73 69 67 6e 20 0 end]..lassign
4270: 24 6f 70 74 69 6f 6e 73 28 2d 68 65 69 67 68 74 $options(-height
4280: 29 20 6d 69 6e 20 6d 61 78 0a 09 69 66 20 7b 20 ) min max..if {
4290: 24 64 73 20 3c 20 24 6d 69 6e 20 7d 20 7b 20 73 $ds < $min } { s
42a0: 65 74 20 64 73 20 24 6d 69 6e 20 7d 0a 09 69 66 et ds $min }..if
42b0: 20 7b 20 24 64 73 20 3e 20 24 6d 61 78 20 7d 20 { $ds > $max }
42c0: 7b 20 73 65 74 20 64 73 20 24 6d 61 78 20 7d 0a { set ds $max }.
42d0: 09 69 66 20 7b 20 24 64 73 20 21 3d 20 5b 24 77 .if { $ds != [$w
42e0: 69 6e 20 63 67 65 74 20 2d 5f 68 65 69 67 68 74 in cget -_height
42f0: 5d 20 7d 20 7b 0a 09 20 20 20 20 24 77 69 6e 20 ] } {.. $win
4300: 63 6f 6e 66 69 67 75 72 65 20 2d 5f 68 65 69 67 configure -_heig
4310: 68 74 20 24 64 73 0a 09 7d 0a 20 20 20 20 7d 0a ht $ds..}. }.
4320: 20 20 20 20 6d 65 74 68 6f 64 20 74 72 65 65 5f method tree_
4330: 69 6e 73 65 72 74 20 7b 20 61 72 67 73 20 7d 20 insert { args }
4340: 7b 0a 09 73 65 74 20 6f 70 74 69 6f 6e 61 6c 20 {..set optional
4350: 7b 0a 09 20 20 20 20 7b 20 2d 69 6d 61 67 65 20 {.. { -image
4360: 69 6d 61 67 65 20 22 22 20 7d 0a 09 20 20 20 20 image "" }..
4370: 7b 20 2d 63 6f 6c 6c 61 70 73 65 20 62 6f 6f 6c { -collapse bool
4380: 65 61 6e 20 30 20 7d 0a 09 20 20 20 20 7b 20 2d ean 0 }.. { -
4390: 61 63 74 69 76 65 20 62 6f 6f 6c 65 61 6e 20 31 active boolean 1
43a0: 20 7d 0a 09 20 20 20 20 7b 20 2d 63 6f 6d 6d 61 }.. { -comma
43b0: 6e 64 20 63 6d 64 20 22 22 20 7d 0a 09 7d 0a 09 nd cmd "" }..}..
43c0: 73 65 74 20 63 6f 6d 70 75 6c 73 6f 72 79 20 22 set compulsory "
43d0: 69 64 78 20 6e 61 6d 65 20 66 75 6c 6c 6e 61 6d idx name fullnam
43e0: 65 20 70 61 72 65 6e 74 22 0a 09 70 61 72 73 65 e parent"..parse
43f0: 5f 61 72 67 73 20 24 6f 70 74 69 6f 6e 61 6c 20 _args $optional
4400: 24 63 6f 6d 70 75 6c 73 6f 72 79 20 24 61 72 67 $compulsory $arg
4410: 73 0a 0a 09 69 66 20 7b 20 24 69 6d 61 67 65 20 s...if { $image
4420: 65 71 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 73 eq "" } {.. s
4430: 65 74 20 69 6d 61 67 65 20 61 70 70 62 6f 6f 6b et image appbook
4440: 31 36 0a 09 7d 20 65 6c 73 65 69 66 20 7b 20 24 16..} elseif { $
4450: 69 6d 61 67 65 20 65 71 20 22 2d 22 20 7d 20 7b image eq "-" } {
4460: 0a 09 20 20 20 20 73 65 74 20 69 6d 61 67 65 20 .. set image
4470: 22 22 0a 09 7d 0a 09 69 66 20 7b 20 5b 24 73 65 ""..}..if { [$se
4480: 6c 66 20 63 67 65 74 20 2d 63 6f 6c 75 6d 6e 73 lf cget -columns
4490: 5f 6c 69 73 74 5d 20 65 71 20 22 22 20 7d 20 7b _list] eq "" } {
44a0: 0a 09 20 20 20 20 73 65 74 20 64 61 74 61 20 5b .. set data [
44b0: 6c 69 73 74 20 5b 6c 69 73 74 20 24 69 6d 61 67 list [list $imag
44c0: 65 20 24 6e 61 6d 65 5d 5d 0a 09 7d 20 65 6c 73 e $name]]..} els
44d0: 65 20 7b 0a 09 20 20 20 20 73 65 74 20 64 61 74 e {.. set dat
44e0: 61 20 5b 6c 69 73 74 20 5b 6c 69 73 74 20 24 69 a [list [list $i
44f0: 6d 61 67 65 20 5b 6c 69 6e 64 65 78 20 24 6e 61 mage [lindex $na
4500: 6d 65 20 30 5d 5d 5d 0a 09 20 20 20 20 6c 61 70 me 0]]].. lap
4510: 70 65 6e 64 20 64 61 74 61 20 7b 2a 7d 5b 6c 72 pend data {*}[lr
4520: 61 6e 67 65 20 24 6e 61 6d 65 20 31 20 65 6e 64 ange $name 1 end
4530: 5d 0a 09 7d 0a 09 73 65 74 20 69 64 20 5b 24 74 ]..}..set id [$t
4540: 6f 63 74 72 65 65 20 69 6e 73 65 72 74 20 24 69 octree insert $i
4550: 64 78 20 24 64 61 74 61 20 24 70 61 72 65 6e 74 dx $data $parent
4560: 5d 0a 09 69 66 20 7b 20 24 63 6f 6c 6c 61 70 73 ]..if { $collaps
4570: 65 20 7d 20 7b 0a 09 20 20 20 20 24 74 6f 63 74 e } {.. $toct
4580: 72 65 65 20 69 74 65 6d 20 63 6f 6c 6c 61 70 73 ree item collaps
4590: 65 20 24 69 64 0a 09 7d 0a 09 69 66 20 7b 20 21 e $id..}..if { !
45a0: 24 61 63 74 69 76 65 20 7d 20 7b 0a 09 20 20 20 $active } {..
45b0: 20 64 69 63 74 20 73 65 74 20 6e 6f 5f 61 63 74 dict set no_act
45c0: 69 76 65 5f 69 74 65 6d 73 20 24 69 64 20 22 22 ive_items $id ""
45d0: 0a 09 20 20 20 20 64 69 63 74 20 73 65 74 20 6e .. dict set n
45e0: 6f 5f 61 63 74 69 76 65 5f 76 61 6c 75 65 73 20 o_active_values
45f0: 24 66 75 6c 6c 6e 61 6d 65 20 22 22 0a 09 7d 0a $fullname ""..}.
4600: 09 69 66 20 7b 20 21 5b 69 6e 66 6f 20 65 78 69 .if { ![info exi
4610: 73 74 73 20 63 6d 64 5f 69 74 65 6d 73 5d 20 7d sts cmd_items] }
4620: 20 7b 0a 09 20 20 20 20 73 65 74 20 63 6d 64 5f {.. set cmd_
4630: 69 74 65 6d 73 20 22 22 0a 09 7d 0a 09 69 66 20 items ""..}..if
4640: 7b 20 24 63 6f 6d 6d 61 6e 64 20 6e 65 20 22 22 { $command ne ""
4650: 20 7d 20 7b 0a 09 20 20 20 20 64 69 63 74 20 73 } {.. dict s
4660: 65 74 20 63 6d 64 5f 69 74 65 6d 73 20 24 69 64 et cmd_items $id
4670: 20 24 63 6f 6d 6d 61 6e 64 0a 09 7d 0a 09 64 69 $command..}..di
4680: 63 74 20 73 65 74 20 66 6e 61 6d 65 73 20 24 69 ct set fnames $i
4690: 64 20 24 66 75 6c 6c 6e 61 6d 65 0a 09 0a 09 24 d $fullname....$
46a0: 74 6f 63 74 72 65 65 20 69 74 65 6d 20 73 74 79 toctree item sty
46b0: 6c 65 20 73 65 74 20 24 69 64 20 30 20 69 6d 61 le set $id 0 ima
46c0: 67 65 74 65 78 74 69 6d 61 67 65 0a 09 24 74 6f getextimage..$to
46d0: 63 74 72 65 65 20 69 74 65 6d 20 65 6c 65 6d 65 ctree item eleme
46e0: 6e 74 20 63 6f 6e 66 69 67 75 72 65 20 24 69 64 nt configure $id
46f0: 20 30 20 65 5f 74 65 78 74 5f 73 65 6c 20 2d 74 0 e_text_sel -t
4700: 65 78 74 20 24 6e 61 6d 65 0a 09 24 74 6f 63 74 ext $name..$toct
4710: 72 65 65 20 69 74 65 6d 20 65 6c 65 6d 65 6e 74 ree item element
4720: 20 63 6f 6e 66 69 67 75 72 65 20 24 69 64 20 30 configure $id 0
4730: 20 65 5f 69 6d 61 67 65 20 2d 69 6d 61 67 65 20 e_image -image
4740: 24 69 6d 61 67 65 0a 09 63 61 74 63 68 20 7b 0a $image..catch {.
4750: 09 20 20 20 20 24 74 6f 63 74 72 65 65 20 69 74 . $toctree it
4760: 65 6d 20 65 6c 65 6d 65 6e 74 20 63 6f 6e 66 69 em element confi
4770: 67 75 72 65 20 24 69 64 20 30 20 65 5f 69 6d 61 gure $id 0 e_ima
4780: 67 65 5f 72 20 2d 69 6d 61 67 65 20 5b 63 75 3a ge_r -image [cu:
4790: 3a 67 65 74 5f 69 6d 61 67 65 20 61 63 74 69 74 :get_image actit
47a0: 65 6d 64 65 6c 65 74 65 31 36 5d 0a 09 7d 0a 09 emdelete16]..}..
47b0: 72 65 74 75 72 6e 20 24 69 64 0a 20 20 20 20 7d return $id. }
47c0: 0a 7d 0a 0a 23 23 23 23 23 23 23 23 23 23 23 23 .}..############
47d0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
47e0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
47f0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
4800: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
4810: 23 23 23 23 0a 23 20 20 20 20 6d 65 6e 75 62 75 ####.# menubu
4820: 74 74 6f 6e 5f 74 72 65 65 0a 23 23 23 23 23 23 tton_tree.######
4830: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
4840: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
4850: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
4860: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
4870: 23 23 23 23 23 23 23 23 23 23 0a 0a 73 6e 69 74 ##########..snit
4880: 3a 3a 77 69 64 67 65 74 20 63 75 3a 3a 5f 6d 65 ::widget cu::_me
4890: 6e 75 62 75 74 74 6f 6e 5f 74 72 65 65 5f 68 65 nubutton_tree_he
48a0: 6c 70 65 72 20 7b 0a 20 20 20 20 6f 70 74 69 6f lper {. optio
48b0: 6e 20 2d 70 61 72 65 6e 74 20 22 22 0a 20 20 20 n -parent "".
48c0: 20 6f 70 74 69 6f 6e 20 2d 63 6f 6c 75 6d 6e 73 option -columns
48d0: 5f 6c 69 73 74 20 22 22 0a 20 20 20 20 68 75 6c _list "". hul
48e0: 6c 74 79 70 65 20 74 6f 70 6c 65 76 65 6c 0a 20 ltype toplevel.
48f0: 20 20 20 0a 20 20 20 20 64 65 6c 65 67 61 74 65 . delegate
4900: 20 6d 65 74 68 6f 64 20 2a 20 74 6f 20 74 72 65 method * to tre
4910: 65 0a 20 20 20 20 64 65 6c 65 67 61 74 65 20 6f e. delegate o
4920: 70 74 69 6f 6e 20 2a 20 74 6f 20 74 72 65 65 0a ption * to tree.
4930: 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 74 72 . variable tr
4940: 65 65 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 ee. variable
4950: 6d 61 72 6b 65 72 5f 72 65 73 69 7a 65 5f 78 79 marker_resize_xy
4960: 30 0a 0a 20 20 20 20 63 6f 6e 73 74 72 75 63 74 0.. construct
4970: 6f 72 20 61 72 67 73 20 7b 0a 09 77 6d 20 6f 76 or args {..wm ov
4980: 65 72 72 69 64 65 72 65 64 69 72 65 63 74 20 24 errideredirect $
4990: 77 69 6e 20 31 0a 0a 09 70 61 63 6b 61 67 65 20 win 1...package
49a0: 72 65 71 75 69 72 65 20 66 75 6c 6c 74 6b 74 72 require fulltktr
49b0: 65 65 0a 09 73 65 74 20 63 6f 6c 75 6d 6e 73 20 ee..set columns
49c0: 5b 6c 69 73 74 20 5b 6c 69 73 74 20 32 30 20 22 [list [list 20 "
49d0: 22 20 6c 65 66 74 20 69 6d 61 67 65 74 65 78 74 " left imagetext
49e0: 20 31 5d 5d 0a 09 73 65 74 20 74 72 65 65 20 5b 1]]..set tree [
49f0: 66 75 6c 6c 74 6b 74 72 65 65 20 24 77 69 6e 2e fulltktree $win.
4a00: 74 72 65 65 20 2d 68 65 69 67 68 74 20 35 30 20 tree -height 50
4a10: 2d 68 61 73 5f 73 69 7a 65 67 72 69 70 20 31 20 -has_sizegrip 1
4a20: 5c 0a 09 09 2d 63 6f 6c 75 6d 6e 73 20 24 63 6f \...-columns $co
4a30: 6c 75 6d 6e 73 20 2d 65 78 70 61 6e 64 20 31 5d lumns -expand 1]
4a40: 0a 09 0a 09 67 72 69 64 20 24 74 72 65 65 20 2d ....grid $tree -
4a50: 73 74 69 63 6b 79 20 6e 73 65 77 0a 09 67 72 69 sticky nsew..gri
4a60: 64 20 63 6f 6c 75 6d 6e 63 6f 6e 66 69 67 75 72 d columnconfigur
4a70: 65 20 24 77 69 6e 20 30 20 2d 77 65 69 67 68 74 e $win 0 -weight
4a80: 20 31 0a 09 67 72 69 64 20 72 6f 77 63 6f 6e 66 1..grid rowconf
4a90: 69 67 75 72 65 20 24 77 69 6e 20 30 20 2d 77 65 igure $win 0 -we
4aa0: 69 67 68 74 20 31 0a 09 0a 09 24 73 65 6c 66 20 ight 1....$self
4ab0: 63 6f 6e 66 69 67 75 72 65 20 2d 62 64 20 31 20 configure -bd 1
4ac0: 2d 72 65 6c 69 65 66 20 73 6f 6c 69 64 20 2d 62 -relief solid -b
4ad0: 61 63 6b 67 72 6f 75 6e 64 20 77 68 69 74 65 0a ackground white.
4ae0: 09 24 73 65 6c 66 20 63 6f 6e 66 69 67 75 72 65 .$self configure
4af0: 6c 69 73 74 20 24 61 72 67 73 0a 0a 09 67 72 69 list $args...gri
4b00: 64 20 63 6f 6e 66 69 67 75 72 65 20 24 74 72 65 d configure $tre
4b10: 65 2e 74 20 2d 72 6f 77 73 70 61 6e 20 32 0a 0a e.t -rowspan 2..
4b20: 09 62 69 6e 64 20 24 77 69 6e 20 3c 42 75 74 74 .bind $win <Butt
4b30: 6f 6e 50 72 65 73 73 2d 31 3e 20 5b 6d 79 6d 65 onPress-1> [myme
4b40: 74 68 6f 64 20 63 68 65 63 6b 5f 75 6e 70 6f 73 thod check_unpos
4b50: 74 20 25 78 20 25 79 5d 0a 09 62 69 6e 64 20 24 t %x %y]..bind $
4b60: 77 69 6e 20 3c 45 73 63 61 70 65 3e 20 22 5b 6d win <Escape> "[m
4b70: 79 6d 65 74 68 6f 64 20 75 6e 70 6f 73 74 5d 20 ymethod unpost]
4b80: 3b 20 62 72 65 61 6b 22 0a 20 20 20 20 7d 0a 20 ; break". }.
4b90: 20 20 20 6f 6e 63 6f 6e 66 69 67 75 72 65 20 2d onconfigure -
4ba0: 63 6f 6c 75 6d 6e 73 5f 6c 69 73 74 20 7b 20 76 columns_list { v
4bb0: 61 6c 75 65 20 7d 20 7b 0a 09 69 66 20 7b 20 24 alue } {..if { $
4bc0: 76 61 6c 75 65 20 65 71 20 24 6f 70 74 69 6f 6e value eq $option
4bd0: 73 28 2d 63 6f 6c 75 6d 6e 73 5f 6c 69 73 74 29 s(-columns_list)
4be0: 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a 09 73 } { return }..s
4bf0: 65 74 20 6f 70 74 69 6f 6e 73 28 2d 63 6f 6c 75 et options(-colu
4c00: 6d 6e 73 5f 6c 69 73 74 29 20 24 76 61 6c 75 65 mns_list) $value
4c10: 0a 0a 09 73 65 74 20 63 6f 6c 75 6d 6e 73 20 22 ...set columns "
4c20: 22 0a 09 73 65 74 20 69 64 78 20 30 0a 09 66 6f "..set idx 0..fo
4c30: 72 65 61 63 68 20 69 20 24 6f 70 74 69 6f 6e 73 reach i $options
4c40: 28 2d 63 6f 6c 75 6d 6e 73 5f 6c 69 73 74 29 20 (-columns_list)
4c50: 7b 0a 09 20 20 20 20 6c 61 73 73 69 67 6e 20 24 {.. lassign $
4c60: 69 20 6e 61 6d 65 20 64 69 63 74 0a 09 20 20 20 i name dict..
4c70: 20 69 66 20 7b 20 24 69 64 78 20 3d 3d 20 30 20 if { $idx == 0
4c80: 7d 20 7b 0a 09 09 73 65 74 20 74 79 70 65 20 69 } {...set type i
4c90: 6d 61 67 65 74 65 78 74 0a 09 20 20 20 20 7d 20 magetext.. }
4ca0: 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 74 79 70 else {...set typ
4cb0: 65 20 74 65 78 74 0a 09 20 20 20 20 7d 0a 09 20 e text.. }..
4cc0: 20 20 20 66 6f 72 65 61 63 68 20 22 6f 70 74 20 foreach "opt
4cd0: 64 65 66 61 75 6c 74 22 20 5b 6c 69 73 74 20 6c default" [list l
4ce0: 65 6e 20 31 30 20 6a 75 73 74 69 66 79 20 6c 65 en 10 justify le
4cf0: 66 74 20 69 73 5f 65 64 69 74 61 62 6c 65 20 31 ft is_editable 1
4d00: 20 65 78 70 61 6e 64 20 22 22 5d 20 7b 0a 09 09 expand ""] {...
4d10: 73 65 74 20 24 6f 70 74 20 5b 64 69 63 74 5f 67 set $opt [dict_g
4d20: 65 74 64 20 24 64 69 63 74 20 24 6f 70 74 20 24 etd $dict $opt $
4d30: 64 65 66 61 75 6c 74 5d 0a 09 20 20 20 20 7d 0a default].. }.
4d40: 09 20 20 20 20 6c 61 70 70 65 6e 64 20 63 6f 6c . lappend col
4d50: 75 6d 6e 73 20 5b 6c 69 73 74 20 24 6c 65 6e 20 umns [list $len
4d60: 24 6e 61 6d 65 20 24 6a 75 73 74 69 66 79 20 24 $name $justify $
4d70: 74 79 70 65 20 24 69 73 5f 65 64 69 74 61 62 6c type $is_editabl
4d80: 65 20 24 65 78 70 61 6e 64 5d 0a 09 20 20 20 20 e $expand]..
4d90: 69 6e 63 72 20 69 64 78 0a 09 7d 0a 09 24 74 72 incr idx..}..$tr
4da0: 65 65 20 63 6f 6e 66 69 67 75 72 65 20 2d 65 78 ee configure -ex
4db0: 70 61 6e 64 20 30 20 2d 63 6f 6c 75 6d 6e 73 20 pand 0 -columns
4dc0: 24 63 6f 6c 75 6d 6e 73 0a 20 20 20 20 7d 0a 20 $columns. }.
4dd0: 20 20 20 6d 65 74 68 6f 64 20 64 65 69 63 6f 6e method deicon
4de0: 69 66 79 20 7b 20 78 20 79 20 6d 69 6e 5f 77 69 ify { x y min_wi
4df0: 64 74 68 20 7d 20 7b 0a 09 09 0a 09 73 65 74 20 dth } {.....set
4e00: 6e 20 5b 24 74 72 65 65 20 69 6e 64 65 78 20 6c n [$tree index l
4e10: 61 73 74 5d 0a 09 69 66 20 7b 20 24 6e 20 3c 20 ast]..if { $n <
4e20: 37 20 7d 20 7b 20 73 65 74 20 6e 20 37 20 7d 0a 7 } { set n 7 }.
4e30: 09 69 66 20 7b 20 24 6e 20 3e 20 31 35 20 7d 20 .if { $n > 15 }
4e40: 7b 20 73 65 74 20 6e 20 31 35 20 7d 0a 09 69 66 { set n 15 }..if
4e50: 20 7b 20 5b 24 74 72 65 65 20 63 67 65 74 20 2d { [$tree cget -
4e60: 69 74 65 6d 68 65 69 67 68 74 5d 20 21 3d 20 30 itemheight] != 0
4e70: 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 68 20 } {.. set h
4e80: 5b 65 78 70 72 20 7b 5b 24 74 72 65 65 20 63 67 [expr {[$tree cg
4e90: 65 74 20 2d 69 74 65 6d 68 65 69 67 68 74 5d 2a et -itemheight]*
4ea0: 24 6e 7d 5d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 $n}]..} else {..
4eb0: 20 20 20 20 73 65 74 20 68 20 5b 65 78 70 72 20 set h [expr
4ec0: 7b 5b 24 74 72 65 65 20 63 67 65 74 20 2d 6d 69 {[$tree cget -mi
4ed0: 6e 69 74 65 6d 68 65 69 67 68 74 5d 2a 24 6e 7d nitemheight]*$n}
4ee0: 5d 0a 09 7d 0a 09 24 74 72 65 65 20 63 6f 6e 66 ]..}..$tree conf
4ef0: 69 67 75 72 65 20 2d 68 65 69 67 68 74 20 24 68 igure -height $h
4f00: 0a 09 73 65 74 20 77 69 20 5b 77 69 6e 66 6f 20 ..set wi [winfo
4f10: 77 69 64 74 68 20 24 77 69 6e 5d 0a 09 69 66 20 width $win]..if
4f20: 7b 20 24 77 69 20 3c 20 24 6d 69 6e 5f 77 69 64 { $wi < $min_wid
4f30: 74 68 20 7d 20 7b 20 73 65 74 20 77 69 20 24 6d th } { set wi $m
4f40: 69 6e 5f 77 69 64 74 68 20 7d 0a 09 69 66 20 7b in_width }..if {
4f50: 20 24 77 69 2b 24 78 20 3e 20 5b 77 69 6e 66 6f $wi+$x > [winfo
4f60: 20 73 63 72 65 65 6e 77 69 64 74 68 20 24 77 69 screenwidth $wi
4f70: 6e 5d 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 n] } {.. set
4f80: 77 69 20 5b 65 78 70 72 20 7b 5b 77 69 6e 66 6f wi [expr {[winfo
4f90: 20 73 63 72 65 65 6e 77 69 64 74 68 20 24 77 69 screenwidth $wi
4fa0: 6e 5d 2d 24 78 7d 5d 0a 09 7d 0a 09 69 66 20 7b n]-$x}]..}..if {
4fb0: 20 24 79 2b 24 68 2b 31 30 20 3e 20 5b 77 69 6e $y+$h+10 > [win
4fc0: 66 6f 20 73 63 72 65 65 6e 68 65 69 67 68 74 20 fo screenheight
4fd0: 24 77 69 6e 5d 20 7d 20 7b 0a 09 20 20 20 20 73 $win] } {.. s
4fe0: 65 74 20 68 20 5b 65 78 70 72 20 7b 5b 77 69 6e et h [expr {[win
4ff0: 66 6f 20 73 63 72 65 65 6e 68 65 69 67 68 74 20 fo screenheight
5000: 24 77 69 6e 5d 2d 24 79 2d 31 30 7d 5d 0a 09 7d $win]-$y-10}]..}
5010: 0a 09 77 6d 20 67 65 6f 6d 65 74 72 79 20 24 77 ..wm geometry $w
5020: 69 6e 20 24 7b 77 69 7d 78 24 68 2b 24 78 2b 24 in ${wi}x$h+$x+$
5030: 79 0a 09 75 70 64 61 74 65 0a 09 77 6d 20 64 65 y..update..wm de
5040: 69 63 6f 6e 69 66 79 20 24 77 69 6e 0a 09 66 6f iconify $win..fo
5050: 63 75 73 20 24 74 72 65 65 0a 09 67 72 61 62 20 cus $tree..grab
5060: 2d 67 6c 6f 62 61 6c 20 24 77 69 6e 0a 20 20 20 -global $win.
5070: 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 63 68 }. method ch
5080: 65 63 6b 5f 75 6e 70 6f 73 74 20 7b 20 78 20 79 eck_unpost { x y
5090: 20 7d 20 7b 0a 09 69 66 20 7b 20 24 78 20 3c 20 } {..if { $x <
50a0: 30 20 7c 7c 20 24 78 20 3e 20 5b 77 69 6e 66 6f 0 || $x > [winfo
50b0: 20 77 69 64 74 68 20 24 77 69 6e 5d 20 7c 7c 20 width $win] ||
50c0: 0a 09 20 20 20 20 24 79 20 3c 20 30 20 7c 7c 20 .. $y < 0 ||
50d0: 24 79 20 3e 20 5b 77 69 6e 66 6f 20 68 65 69 67 $y > [winfo heig
50e0: 68 74 20 24 77 69 6e 5d 20 7d 20 7b 0a 09 20 20 ht $win] } {..
50f0: 20 20 24 73 65 6c 66 20 75 6e 70 6f 73 74 0a 09 $self unpost..
5100: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 }. }. meth
5110: 6f 64 20 75 6e 70 6f 73 74 20 7b 7d 20 7b 0a 09 od unpost {} {..
5120: 0a 09 24 74 72 65 65 20 63 6c 6f 73 65 5f 73 65 ..$tree close_se
5130: 61 72 63 68 5f 6c 61 62 65 6c 0a 0a 09 67 72 61 arch_label...gra
5140: 62 20 72 65 6c 65 61 73 65 20 24 77 69 6e 0a 09 b release $win..
5150: 77 6d 20 77 69 74 68 64 72 61 77 20 24 77 69 6e wm withdraw $win
5160: 0a 09 65 76 65 6e 74 20 67 65 6e 65 72 61 74 65 ..event generate
5170: 20 24 77 69 6e 20 3c 3c 43 6f 6d 62 6f 62 6f 78 $win <<Combobox
5180: 53 65 6c 65 63 74 65 64 3e 3e 20 0a 20 20 20 20 Selected>> .
5190: 7d 0a 7d 0a 0a 23 23 23 23 23 23 23 23 23 23 23 }.}..###########
51a0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
51b0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
51c0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
51d0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
51e0: 23 23 23 23 23 0a 23 20 20 20 20 63 75 3a 3a 61 #####.# cu::a
51f0: 64 61 70 74 5f 74 65 78 74 5f 6c 65 6e 67 74 68 dapt_text_length
5200: 0a 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 .###############
5210: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5220: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5230: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5240: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5250: 23 0a 0a 23 20 72 65 6d 65 6d 62 65 72 20 74 6f #..# remember to
5260: 20 67 72 69 64 20 74 68 65 20 6c 61 62 65 6c 20 grid the label
5270: 74 6f 20 66 69 6c 6c 20 61 6c 6c 20 73 70 61 63 to fill all spac
5280: 65 2e 20 46 6f 72 20 65 78 61 6d 70 6c 65 20 77 e. For example w
5290: 69 74 68 20 2d 73 74 69 63 6b 79 20 65 77 0a 70 ith -sticky ew.p
52a0: 72 6f 63 20 63 75 3a 3a 61 64 61 70 74 5f 74 65 roc cu::adapt_te
52b0: 78 74 5f 6c 65 6e 67 74 68 20 7b 20 61 72 67 73 xt_length { args
52c0: 20 7d 20 7b 0a 20 20 20 20 66 6f 72 65 61 63 68 } {. foreach
52d0: 20 77 20 24 61 72 67 73 20 7b 0a 09 62 69 6e 64 w $args {..bind
52e0: 20 24 77 20 3c 43 6f 6e 66 69 67 75 72 65 3e 20 $w <Configure>
52f0: 5b 6c 69 73 74 20 63 75 3a 3a 5f 61 64 61 70 74 [list cu::_adapt
5300: 5f 74 65 78 74 5f 6c 65 6e 67 74 68 5f 64 6f 20 _text_length_do
5310: 24 77 5d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f $w]. }.}..pro
5320: 63 20 63 75 3a 3a 5f 61 64 61 70 74 5f 74 65 78 c cu::_adapt_tex
5330: 74 5f 6c 65 6e 67 74 68 5f 64 6f 20 7b 20 77 20 t_length_do { w
5340: 7d 20 7b 0a 20 20 20 20 69 66 20 7b 20 5b 77 69 } {. if { [wi
5350: 6e 66 6f 20 77 69 64 74 68 20 24 77 5d 20 3e 20 nfo width $w] >
5360: 31 20 7d 20 7b 0a 09 24 77 20 63 6f 6e 66 69 67 1 } {..$w config
5370: 75 72 65 20 2d 77 72 61 70 6c 65 6e 67 74 68 20 ure -wraplength
5380: 5b 77 69 6e 66 6f 20 77 69 64 74 68 20 24 77 5d [winfo width $w]
5390: 20 2d 6a 75 73 74 69 66 79 20 6c 65 66 74 0a 20 -justify left.
53a0: 20 20 20 7d 0a 7d 0a 0a 23 23 23 23 23 23 23 23 }.}..########
53b0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
53c0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
53d0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
53e0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
53f0: 23 23 23 23 23 23 23 23 0a 23 20 20 20 20 61 64 ########.# ad
5400: 64 5f 63 6f 6e 74 65 78 74 75 61 6c 5f 6d 65 6e d_contextual_men
5410: 75 5f 74 6f 5f 65 6e 74 72 79 0a 23 23 23 23 23 u_to_entry.#####
5420: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5430: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5440: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5450: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5460: 23 23 23 23 23 23 23 23 23 23 23 0a 0a 70 72 6f ###########..pro
5470: 63 20 63 75 3a 3a 61 64 64 5f 63 6f 6e 74 65 78 c cu::add_contex
5480: 74 75 61 6c 5f 6d 65 6e 75 5f 74 6f 5f 65 6e 74 tual_menu_to_ent
5490: 72 79 20 7b 20 77 20 77 68 61 74 20 61 72 67 73 ry { w what args
54a0: 20 7d 20 7b 0a 20 20 20 20 73 77 69 74 63 68 20 } {. switch
54b0: 24 77 68 61 74 20 7b 0a 09 69 6e 69 74 20 7b 0a $what {..init {.
54c0: 09 20 20 20 20 62 69 6e 64 20 24 77 20 3c 42 75 . bind $w <Bu
54d0: 74 74 6f 6e 52 65 6c 65 61 73 65 2d 33 3e 20 5b ttonRelease-3> [
54e0: 6c 69 73 74 20 63 75 3a 3a 61 64 64 5f 63 6f 6e list cu::add_con
54f0: 74 65 78 74 75 61 6c 5f 6d 65 6e 75 5f 74 6f 5f textual_menu_to_
5500: 65 6e 74 72 79 20 24 77 20 70 6f 73 74 20 25 58 entry $w post %X
5510: 20 25 59 5d 0a 09 7d 0a 09 70 6f 73 74 20 7b 0a %Y]..}..post {.
5520: 09 20 20 20 20 6c 61 73 73 69 67 6e 20 24 61 72 . lassign $ar
5530: 67 73 20 78 20 79 0a 09 20 20 20 20 73 65 74 20 gs x y.. set
5540: 6d 65 6e 75 20 24 77 2e 6d 65 6e 75 0a 09 20 20 menu $w.menu..
5550: 20 20 63 61 74 63 68 20 7b 20 64 65 73 74 72 6f catch { destro
5560: 79 20 24 6d 65 6e 75 20 7d 0a 09 20 20 20 20 6d y $menu }.. m
5570: 65 6e 75 20 24 6d 65 6e 75 20 2d 74 65 61 72 6f enu $menu -tearo
5580: 66 66 20 30 0a 09 20 20 20 20 66 6f 72 65 61 63 ff 0.. foreac
5590: 68 20 69 20 5b 6c 69 73 74 20 63 75 74 20 63 6f h i [list cut co
55a0: 70 79 20 70 61 73 74 65 20 2d 2d 2d 20 73 65 6c py paste --- sel
55b0: 65 63 74 5f 61 6c 6c 20 2d 2d 2d 20 63 6c 65 61 ect_all --- clea
55c0: 72 5d 20 5c 0a 09 09 74 78 74 20 5b 6c 69 73 74 r] \...txt [list
55d0: 20 5b 5f 20 22 43 75 74 22 5d 20 5b 5f 20 22 43 [_ "Cut"] [_ "C
55e0: 6f 70 79 22 5d 20 5b 5f 20 22 50 61 73 74 65 22 opy"] [_ "Paste"
55f0: 5d 20 2d 2d 2d 20 5b 5f 20 22 53 65 6c 65 63 74 ] --- [_ "Select
5600: 20 61 6c 6c 22 5d 20 2d 2d 2d 20 5b 5f 20 22 43 all"] --- [_ "C
5610: 6c 65 61 72 22 5d 5d 20 7b 0a 09 09 69 66 20 7b lear"]] {...if {
5620: 20 24 69 20 65 71 20 22 2d 2d 2d 22 20 7d 20 7b $i eq "---" } {
5630: 0a 09 09 20 20 20 20 24 6d 65 6e 75 20 61 64 64 ... $menu add
5640: 20 73 65 70 61 72 61 74 6f 72 0a 09 09 7d 20 65 separator...} e
5650: 6c 73 65 20 7b 0a 09 09 20 20 20 20 24 6d 65 6e lse {... $men
5660: 75 20 61 64 64 20 63 6f 6d 6d 61 6e 64 20 2d 6c u add command -l
5670: 61 62 65 6c 20 24 74 78 74 20 2d 63 6f 6d 6d 61 abel $txt -comma
5680: 6e 64 20 5b 6c 69 73 74 20 63 75 3a 3a 61 64 64 nd [list cu::add
5690: 5f 63 6f 6e 74 65 78 74 75 61 6c 5f 6d 65 6e 75 _contextual_menu
56a0: 5f 74 6f 5f 65 6e 74 72 79 20 24 77 20 24 69 5d _to_entry $w $i]
56b0: 0a 09 09 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 ...}.. }..
56c0: 20 74 6b 5f 70 6f 70 75 70 20 24 6d 65 6e 75 20 tk_popup $menu
56d0: 24 78 20 24 79 0a 09 7d 0a 09 63 6c 65 61 72 20 $x $y..}..clear
56e0: 7b 0a 09 20 20 20 20 69 66 20 7b 20 5b 77 69 6e {.. if { [win
56f0: 66 6f 20 63 6c 61 73 73 20 24 77 5d 20 65 71 20 fo class $w] eq
5700: 22 54 65 78 74 22 20 7d 20 7b 0a 09 09 24 77 20 "Text" } {...$w
5710: 64 65 6c 65 74 65 20 31 2e 30 20 65 6e 64 0a 09 delete 1.0 end..
5720: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 24 } else {...$
5730: 77 20 64 65 6c 65 74 65 20 30 20 65 6e 64 0a 09 w delete 0 end..
5740: 20 20 20 20 7d 0a 09 7d 0a 09 63 75 74 20 7b 0a }..}..cut {.
5750: 09 20 20 20 20 65 76 65 6e 74 20 67 65 6e 65 72 . event gener
5760: 61 74 65 20 24 77 20 3c 3c 43 75 74 3e 3e 0a 09 ate $w <<Cut>>..
5770: 7d 0a 09 63 6f 70 79 20 7b 0a 09 20 20 20 20 65 }..copy {.. e
5780: 76 65 6e 74 20 67 65 6e 65 72 61 74 65 20 24 77 vent generate $w
5790: 20 3c 3c 43 6f 70 79 3e 3e 0a 09 7d 0a 09 70 61 <<Copy>>..}..pa
57a0: 73 74 65 20 7b 0a 09 20 20 20 20 65 76 65 6e 74 ste {.. event
57b0: 20 67 65 6e 65 72 61 74 65 20 24 77 20 3c 3c 50 generate $w <<P
57c0: 61 73 74 65 3e 3e 0a 09 7d 0a 09 73 65 6c 65 63 aste>>..}..selec
57d0: 74 5f 61 6c 6c 20 7b 0a 09 20 20 20 20 69 66 20 t_all {.. if
57e0: 7b 20 5b 77 69 6e 66 6f 20 63 6c 61 73 73 20 24 { [winfo class $
57f0: 77 5d 20 65 71 20 22 54 65 78 74 22 20 7d 20 7b w] eq "Text" } {
5800: 0a 09 09 24 77 20 74 61 67 20 61 64 64 20 73 65 ...$w tag add se
5810: 6c 20 31 2e 30 20 65 6e 64 2d 31 63 0a 09 20 20 l 1.0 end-1c..
5820: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 24 77 20 } else {...$w
5830: 73 65 6c 65 63 74 69 6f 6e 20 72 61 6e 67 65 20 selection range
5840: 30 20 65 6e 64 0a 09 20 20 20 20 7d 0a 09 7d 0a 0 end.. }..}.
5850: 20 20 20 20 7d 0a 7d 0a 0a 23 23 23 23 23 23 23 }.}..#######
5860: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5870: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5880: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5890: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
58a0: 23 23 23 23 23 23 23 23 23 0a 23 20 20 20 20 20 #########.#
58b0: 63 75 3a 3a 74 65 78 74 5f 65 6e 74 72 79 5f 62 cu::text_entry_b
58c0: 69 6e 64 69 6e 67 73 0a 23 23 23 23 23 23 23 23 indings.########
58d0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
58e0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
58f0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5900: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5910: 23 23 23 23 23 23 23 23 0a 0a 70 72 6f 63 20 63 ########..proc c
5920: 75 3a 3a 74 65 78 74 5f 65 6e 74 72 79 5f 62 69 u::text_entry_bi
5930: 6e 64 69 6e 67 73 20 7b 20 77 20 7d 20 7b 0a 0a ndings { w } {..
5940: 20 20 20 20 69 66 20 7b 20 21 5b 69 6e 66 6f 20 if { ![info
5950: 65 78 69 73 74 73 20 3a 3a 63 6f 6e 74 72 6f 6c exists ::control
5960: 5d 20 7d 20 7b 0a 09 69 66 20 7b 20 24 3a 3a 74 ] } {..if { $::t
5970: 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 cl_platform(plat
5980: 66 6f 72 6d 29 20 65 71 20 22 77 69 6e 64 6f 77 form) eq "window
5990: 73 22 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 s" } {.. set
59a0: 3a 3a 63 6f 6e 74 72 6f 6c 20 43 6f 6e 74 72 6f ::control Contro
59b0: 6c 0a 09 7d 20 65 6c 73 65 69 66 20 7b 20 5b 74 l..} elseif { [t
59c0: 6b 20 77 69 6e 64 6f 77 69 6e 67 73 79 73 74 65 k windowingsyste
59d0: 6d 5d 20 65 71 20 22 61 71 75 61 22 20 7d 20 7b m] eq "aqua" } {
59e0: 0a 09 20 20 20 20 73 65 74 20 3a 3a 63 6f 6e 74 .. set ::cont
59f0: 72 6f 6c 20 43 6f 6d 6d 61 6e 64 0a 09 7d 20 65 rol Command..} e
5a00: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 3a lse {.. set :
5a10: 3a 63 6f 6e 74 72 6f 6c 20 43 6f 6e 74 72 6f 6c :control Control
5a20: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 23 20 ..}. }. #
5a30: 22 62 61 63 6b 73 6c 61 73 68 22 20 61 6e 64 20 "backslash" and
5a40: 22 63 22 20 61 72 65 20 68 65 72 65 20 74 6f 20 "c" are here to
5a50: 68 65 6c 70 20 77 69 74 68 20 61 20 70 72 6f 62 help with a prob
5a60: 6c 65 6d 20 69 6e 20 41 6e 64 72 6f 69 64 20 56 lem in Android V
5a70: 4e 43 0a 20 20 20 20 62 69 6e 64 20 24 77 20 3c NC. bind $w <
5a80: 24 3a 3a 63 6f 6e 74 72 6f 6c 2d 62 61 63 6b 73 $::control-backs
5a90: 6c 61 73 68 3e 20 22 5b 6c 69 73 74 20 63 75 3a lash> "[list cu:
5aa0: 3a 74 65 78 74 5f 65 6e 74 72 79 5f 69 6e 73 65 :text_entry_inse
5ab0: 72 74 20 24 77 5d 3b 62 72 65 61 6b 22 0a 20 20 rt $w];break".
5ac0: 20 20 62 69 6e 64 20 24 77 20 3c 24 3a 3a 63 6f bind $w <$::co
5ad0: 6e 74 72 6f 6c 2d 6c 65 73 73 3e 20 22 5b 6c 69 ntrol-less> "[li
5ae0: 73 74 20 63 75 3a 3a 74 65 78 74 5f 65 6e 74 72 st cu::text_entr
5af0: 79 5f 69 6e 73 65 72 74 20 24 77 5d 3b 62 72 65 y_insert $w];bre
5b00: 61 6b 22 0a 20 20 20 20 66 6f 72 65 61 63 68 20 ak". foreach
5b10: 22 61 63 63 31 20 61 63 63 32 20 63 22 20 5b 6c "acc1 acc2 c" [l
5b20: 69 73 74 20 70 6c 75 73 20 22 22 20 7b 5b 5d 7d ist plus "" {[]}
5b30: 20 63 20 22 22 20 7b 7b 7d 7d 20 63 63 65 64 69 c "" {{}} ccedi
5b40: 6c 6c 61 20 22 22 20 7b 7b 7d 7d 20 31 20 22 22 lla "" {{}} 1 ""
5b50: 20 7c 7c 20 31 20 31 20 5c 5c 20 33 20 22 22 20 || 1 1 \\ 3 ""
5b60: 7b 23 7d 5d 20 7b 0a 09 73 65 74 20 63 6d 64 20 {#}] {..set cmd
5b70: 22 5b 6c 69 73 74 20 63 75 3a 3a 74 65 78 74 5f "[list cu::text_
5b80: 65 6e 74 72 79 5f 69 6e 73 65 72 74 20 24 77 20 entry_insert $w
5b90: 24 63 5d 3b 62 72 65 61 6b 22 0a 09 69 66 20 7b $c];break"..if {
5ba0: 20 24 61 63 63 32 20 65 71 20 22 22 20 7d 20 7b $acc2 eq "" } {
5bb0: 0a 09 20 20 20 20 73 65 74 20 6b 32 20 22 22 0a .. set k2 "".
5bc0: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 .} else {.. s
5bd0: 65 74 20 6b 32 20 3c 4b 65 79 50 72 65 73 73 2d et k2 <KeyPress-
5be0: 24 61 63 63 32 3e 0a 09 7d 0a 09 62 69 6e 64 20 $acc2>..}..bind
5bf0: 24 77 20 3c 24 3a 3a 63 6f 6e 74 72 6f 6c 2d 6c $w <$::control-l
5c00: 65 73 73 3e 3c 4b 65 79 50 72 65 73 73 2d 24 61 ess><KeyPress-$a
5c10: 63 63 31 3e 24 6b 32 20 24 63 6d 64 0a 09 62 69 cc1>$k2 $cmd..bi
5c20: 6e 64 20 24 77 20 3c 24 3a 3a 63 6f 6e 74 72 6f nd $w <$::contro
5c30: 6c 2d 62 61 63 6b 73 6c 61 73 68 3e 3c 4b 65 79 l-backslash><Key
5c40: 50 72 65 73 73 2d 24 61 63 63 31 3e 24 6b 32 20 Press-$acc1>$k2
5c50: 24 63 6d 64 0a 20 20 20 20 7d 0a 20 20 20 20 0a $cmd. }. .
5c60: 20 20 20 20 69 66 20 7b 20 24 3a 3a 74 63 6c 5f if { $::tcl_
5c70: 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 platform(platfor
5c80: 6d 29 20 6e 65 20 22 77 69 6e 64 6f 77 73 22 20 m) ne "windows"
5c90: 7d 20 7b 0a 09 66 6f 72 65 61 63 68 20 22 65 76 } {..foreach "ev
5ca0: 20 6b 22 20 5b 6c 69 73 74 20 62 72 61 63 65 6c k" [list bracel
5cb0: 65 66 74 20 5c 7b 20 62 72 61 63 65 72 69 67 68 eft \{ bracerigh
5cc0: 74 20 5c 7d 20 62 72 61 63 6b 65 74 6c 65 66 74 t \} bracketleft
5cd0: 20 5c 5b 20 62 72 61 63 6b 65 74 72 69 67 68 74 \[ bracketright
5ce0: 20 5c 5d 20 62 61 63 6b 73 6c 61 73 68 20 5c 5c \] backslash \\
5cf0: 20 5c 0a 09 09 62 61 72 20 7c 20 61 74 20 40 20 \...bar | at @
5d00: 6e 75 6d 62 65 72 73 69 67 6e 20 23 20 61 73 63 numbersign # asc
5d10: 69 69 74 69 6c 64 65 20 7e 5d 20 7b 0a 09 20 20 iitilde ~] {..
5d20: 20 20 23 20 45 75 72 6f 53 69 67 6e 20 e2 82 ac # EuroSign ...
5d30: 0a 09 20 20 20 20 23 20 74 68 65 79 20 61 72 65 .. # they are
5d40: 20 63 6c 61 73 73 20 62 69 6e 64 69 6e 67 73 20 class bindings
5d50: 73 6f 20 61 73 20 73 65 61 72 63 68 20 69 6e 20 so as search in
5d60: 74 65 78 74 20 77 69 64 67 65 74 73 20 63 61 6e text widgets can
5d70: 20 63 6f 6e 74 69 6e 75 65 20 77 6f 72 6b 69 6e continue workin
5d80: 67 0a 09 20 20 20 20 62 69 6e 64 20 54 65 78 74 g.. bind Text
5d90: 20 3c 24 65 76 3e 20 22 5b 6c 69 73 74 20 74 6b <$ev> "[list tk
5da0: 3a 3a 54 65 78 74 49 6e 73 65 72 74 20 25 57 20 ::TextInsert %W
5db0: 24 6b 5d 3b 20 62 72 65 61 6b 22 0a 09 20 20 20 $k]; break"..
5dc0: 20 62 69 6e 64 20 54 45 6e 74 72 79 20 3c 24 65 bind TEntry <$e
5dd0: 76 3e 20 22 5b 6c 69 73 74 20 74 74 6b 3a 3a 65 v> "[list ttk::e
5de0: 6e 74 72 79 3a 3a 49 6e 73 65 72 74 20 25 57 20 ntry::Insert %W
5df0: 24 6b 5d 3b 20 62 72 65 61 6b 22 0a 09 20 20 20 $k]; break"..
5e00: 20 62 69 6e 64 20 54 43 6f 6d 62 6f 62 6f 78 20 bind TCombobox
5e10: 3c 24 65 76 3e 20 22 5b 6c 69 73 74 20 74 74 6b <$ev> "[list ttk
5e20: 3a 3a 65 6e 74 72 79 3a 3a 49 6e 73 65 72 74 20 ::entry::Insert
5e30: 25 57 20 24 6b 5d 3b 20 62 72 65 61 6b 22 0a 09 %W $k]; break"..
5e40: 20 20 20 20 62 69 6e 64 20 45 6e 74 72 79 20 3c bind Entry <
5e50: 24 65 76 3e 20 22 5b 6c 69 73 74 20 74 6b 3a 3a $ev> "[list tk::
5e60: 45 6e 74 72 79 49 6e 73 65 72 74 20 25 57 20 24 EntryInsert %W $
5e70: 6b 5d 3b 20 62 72 65 61 6b 22 0a 09 7d 0a 20 20 k]; break"..}.
5e80: 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 63 75 3a 3a }.}..proc cu::
5e90: 74 65 78 74 5f 65 6e 74 72 79 5f 69 6e 73 65 72 text_entry_inser
5ea0: 74 20 7b 20 77 20 7b 20 77 68 61 74 20 22 22 20 t { w { what ""
5eb0: 7d 20 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 62 } } {. variab
5ec0: 6c 65 20 6c 61 73 74 5f 74 65 78 74 5f 65 6e 74 le last_text_ent
5ed0: 79 5f 62 69 6e 64 69 6e 67 73 0a 20 20 20 20 0a y_bindings. .
5ee0: 20 20 20 20 69 66 20 7b 20 21 5b 69 6e 66 6f 20 if { ![info
5ef0: 65 78 69 73 74 73 20 6c 61 73 74 5f 74 65 78 74 exists last_text
5f00: 5f 65 6e 74 79 5f 62 69 6e 64 69 6e 67 73 5d 20 _enty_bindings]
5f10: 7d 20 7b 0a 09 73 65 74 20 6c 61 73 74 5f 74 65 } {..set last_te
5f20: 78 74 5f 65 6e 74 79 5f 62 69 6e 64 69 6e 67 73 xt_enty_bindings
5f30: 20 22 22 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 "". }. se
5f40: 74 20 6c 69 73 74 20 5b 6c 69 73 74 20 22 7b 7d t list [list "{}
5f50: 22 20 22 5c 5b 5c 5d 22 20 22 7c 7c 22 20 22 5c " "\[\]" "||" "\
5f60: 5c 22 20 22 23 22 5d 0a 20 20 20 20 73 65 74 20 \" "#"]. set
5f70: 74 20 5b 63 6c 6f 63 6b 20 6d 69 6c 6c 69 73 65 t [clock millise
5f80: 63 6f 6e 64 73 5d 0a 20 20 20 20 6c 61 73 73 69 conds]. lassi
5f90: 67 6e 20 5b 64 69 63 74 5f 67 65 74 64 20 24 6c gn [dict_getd $l
5fa0: 61 73 74 5f 74 65 78 74 5f 65 6e 74 79 5f 62 69 ast_text_enty_bi
5fb0: 6e 64 69 6e 67 73 20 24 77 20 22 22 5d 20 74 69 ndings $w ""] ti
5fc0: 6d 65 20 64 0a 20 20 20 20 0a 20 20 20 20 69 66 me d. . if
5fd0: 20 7b 20 24 64 20 65 71 20 22 22 20 7d 20 7b 20 { $d eq "" } {
5fe0: 73 65 74 20 64 20 22 7b 7d 22 20 7d 0a 20 20 20 set d "{}" }.
5ff0: 20 69 66 20 7b 20 24 74 69 6d 65 20 6e 65 20 22 if { $time ne "
6000: 22 20 26 26 20 24 74 20 3c 20 24 74 69 6d 65 2b " && $t < $time+
6010: 33 30 30 30 20 7d 20 7b 0a 09 69 66 20 7b 20 5b 3000 } {..if { [
6020: 77 69 6e 66 6f 20 63 6c 61 73 73 20 24 77 5d 20 winfo class $w]
6030: 65 71 20 22 54 65 78 74 22 20 7d 20 7b 0a 09 20 eq "Text" } {..
6040: 20 20 20 73 65 74 20 69 64 78 20 5b 24 77 20 73 set idx [$w s
6050: 65 61 72 63 68 20 24 64 20 69 6e 73 65 72 74 2d earch $d insert-
6060: 31 63 5d 0a 09 20 20 20 20 69 66 20 7b 20 5b 24 1c].. if { [$
6070: 77 20 63 6f 6d 70 61 72 65 20 24 69 64 78 20 3d w compare $idx =
6080: 3d 20 69 6e 73 65 72 74 2d 31 63 5d 20 7d 20 7b = insert-1c] } {
6090: 0a 09 09 69 66 20 7b 20 5b 73 74 72 69 6e 67 20 ...if { [string
60a0: 6c 65 6e 67 74 68 20 24 64 5d 20 3d 3d 20 31 20 length $d] == 1
60b0: 7d 20 7b 0a 09 09 20 20 20 20 24 77 20 64 65 6c } {... $w del
60c0: 65 74 65 20 69 6e 73 65 72 74 2d 31 63 0a 09 09 ete insert-1c...
60d0: 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 24 } else {... $
60e0: 77 20 64 65 6c 65 74 65 20 69 6e 73 65 72 74 2d w delete insert-
60f0: 31 63 20 69 6e 73 65 72 74 2b 31 63 0a 09 09 7d 1c insert+1c...}
6100: 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 .. }..} else
6110: 7b 0a 09 20 20 20 20 73 65 74 20 69 64 78 20 5b {.. set idx [
6120: 24 77 20 69 6e 64 65 78 20 69 6e 73 65 72 74 5d $w index insert]
6130: 0a 09 20 20 20 20 69 66 20 7b 20 24 69 64 78 20 .. if { $idx
6140: 3e 20 30 20 7d 20 7b 0a 09 09 73 65 74 20 69 64 > 0 } {...set id
6150: 78 31 20 5b 65 78 70 72 20 7b 24 69 64 78 2d 31 x1 [expr {$idx-1
6160: 7d 5d 0a 09 09 73 65 74 20 69 64 78 32 20 5b 65 }]...set idx2 [e
6170: 78 70 72 20 7b 24 69 64 78 2d 31 2b 5b 73 74 72 xpr {$idx-1+[str
6180: 69 6e 67 20 6c 65 6e 67 74 68 20 24 64 5d 7d 5d ing length $d]}]
6190: 0a 09 09 73 65 74 20 74 78 74 20 5b 73 74 72 69 ...set txt [stri
61a0: 6e 67 20 72 61 6e 67 65 20 5b 24 77 20 67 65 74 ng range [$w get
61b0: 5d 20 24 69 64 78 31 20 24 69 64 78 32 5d 0a 09 ] $idx1 $idx2]..
61c0: 09 69 66 20 7b 20 5b 73 74 72 69 6e 67 20 65 71 .if { [string eq
61d0: 75 61 6c 20 24 64 20 24 74 78 74 5d 20 7d 20 7b ual $d $txt] } {
61e0: 0a 09 09 20 20 20 20 24 77 20 64 65 6c 65 74 65 ... $w delete
61f0: 20 24 69 64 78 31 20 24 69 64 78 32 0a 09 09 7d $idx1 $idx2...}
6200: 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 69 66 20 7b .. }..}..if {
6210: 20 24 77 68 61 74 20 65 71 20 22 22 20 7d 20 7b $what eq "" } {
6220: 0a 09 20 20 20 20 73 65 74 20 69 70 6f 73 20 5b .. set ipos [
6230: 6c 73 65 61 72 63 68 20 2d 65 78 61 63 74 20 24 lsearch -exact $
6240: 6c 69 73 74 20 24 64 5d 0a 09 20 20 20 20 69 6e list $d].. in
6250: 63 72 20 69 70 6f 73 0a 09 20 20 20 20 69 66 20 cr ipos.. if
6260: 7b 20 24 69 70 6f 73 20 3e 3d 20 5b 6c 6c 65 6e { $ipos >= [llen
6270: 67 74 68 20 24 6c 69 73 74 5d 20 7d 20 7b 0a 09 gth $list] } {..
6280: 09 73 65 74 20 69 70 6f 73 20 30 0a 09 20 20 20 .set ipos 0..
6290: 20 7d 0a 09 20 20 20 20 73 65 74 20 64 20 5b 6c }.. set d [l
62a0: 69 6e 64 65 78 20 24 6c 69 73 74 20 24 69 70 6f index $list $ipo
62b0: 73 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 s]..}. }.
62c0: 69 66 20 7b 20 24 77 68 61 74 20 6e 65 20 22 22 if { $what ne ""
62d0: 20 7d 20 7b 0a 09 73 65 74 20 64 20 24 77 68 61 } {..set d $wha
62e0: 74 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b t. }. if {
62f0: 20 5b 77 69 6e 66 6f 20 63 6c 61 73 73 20 24 77 [winfo class $w
6300: 5d 20 65 71 20 22 54 65 78 74 22 20 7d 20 7b 0a ] eq "Text" } {.
6310: 09 73 65 74 20 69 64 78 20 5b 24 77 20 69 6e 64 .set idx [$w ind
6320: 65 78 20 69 6e 73 65 72 74 5d 0a 09 24 77 20 69 ex insert]..$w i
6330: 6e 73 65 72 74 20 69 6e 73 65 72 74 20 24 64 0a nsert insert $d.
6340: 09 24 77 20 6d 61 72 6b 20 73 65 74 20 69 6e 73 .$w mark set ins
6350: 65 72 74 20 22 24 69 64 78 2b 31 63 22 0a 20 20 ert "$idx+1c".
6360: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 } else {..set
6370: 69 64 78 20 5b 24 77 20 69 6e 64 65 78 20 69 6e idx [$w index in
6380: 73 65 72 74 5d 0a 09 24 77 20 69 6e 73 65 72 74 sert]..$w insert
6390: 20 69 6e 73 65 72 74 20 24 64 0a 09 24 77 20 69 insert $d..$w i
63a0: 63 75 72 73 6f 72 20 5b 65 78 70 72 20 7b 24 69 cursor [expr {$i
63b0: 64 78 2b 31 7d 5d 0a 20 20 20 20 7d 0a 20 20 20 dx+1}]. }.
63c0: 20 64 69 63 74 20 73 65 74 20 6c 61 73 74 5f 74 dict set last_t
63d0: 65 78 74 5f 65 6e 74 79 5f 62 69 6e 64 69 6e 67 ext_enty_binding
63e0: 73 20 24 77 20 5b 6c 69 73 74 20 24 74 20 24 64 s $w [list $t $d
63f0: 5d 0a 7d 0a 0a 23 23 23 23 23 23 23 23 23 23 23 ].}..###########
6400: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6410: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6420: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6430: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6440: 23 23 23 23 23 0a 23 20 20 20 20 20 63 75 3a 3a #####.# cu::
6450: 74 65 78 74 20 6f 70 65 72 61 74 69 6f 6e 73 20 text operations
6460: 6f 6e 20 74 65 78 74 20 77 69 64 67 65 74 0a 23 on text widget.#
6470: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6480: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6490: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
64a0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
64b0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 0a ###############.
64c0: 0a 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c 20 .namespace eval
64d0: 63 75 3a 3a 74 65 78 74 20 7b 7d 0a 0a 70 72 6f cu::text {}..pro
64e0: 63 20 63 75 3a 3a 74 65 78 74 3a 3a 67 65 74 5f c cu::text::get_
64f0: 73 65 6c 65 63 74 69 6f 6e 5f 6f 72 5f 77 6f 72 selection_or_wor
6500: 64 20 7b 20 61 72 67 73 20 7d 20 7b 0a 20 20 20 d { args } {.
6510: 20 0a 20 20 20 20 73 65 74 20 6f 70 74 69 6f 6e . set option
6520: 61 6c 20 7b 0a 09 7b 20 2d 72 65 74 75 72 6e 5f al {..{ -return_
6530: 72 61 6e 67 65 20 62 6f 6f 6c 65 61 6e 20 30 20 range boolean 0
6540: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
6550: 63 6f 6d 70 75 6c 73 6f 72 79 20 22 74 65 78 74 compulsory "text
6560: 20 69 64 78 22 0a 20 20 20 20 70 61 72 73 65 5f idx". parse_
6570: 61 72 67 73 20 24 6f 70 74 69 6f 6e 61 6c 20 24 args $optional $
6580: 63 6f 6d 70 75 6c 73 6f 72 79 20 24 61 72 67 73 compulsory $args
6590: 0a 20 20 20 20 0a 20 20 20 20 73 65 74 20 72 61 . . set ra
65a0: 6e 67 65 20 5b 24 74 65 78 74 20 74 61 67 20 72 nge [$text tag r
65b0: 61 6e 67 65 73 20 73 65 6c 5d 0a 20 20 20 20 69 anges sel]. i
65c0: 66 20 7b 20 24 72 61 6e 67 65 20 21 3d 20 22 22 f { $range != ""
65d0: 20 26 26 20 5b 24 74 65 78 74 20 63 6f 6d 70 61 && [$text compa
65e0: 72 65 20 5b 6c 69 6e 64 65 78 20 24 72 61 6e 67 re [lindex $rang
65f0: 65 20 30 5d 20 3c 3d 20 24 69 64 78 5d 20 26 26 e 0] <= $idx] &&
6600: 20 5c 0a 09 5b 24 74 65 78 74 20 63 6f 6d 70 61 \..[$text compa
6610: 72 65 20 5b 6c 69 6e 64 65 78 20 24 72 61 6e 67 re [lindex $rang
6620: 65 20 31 5d 20 3e 3d 20 24 69 64 78 5d 20 7d 20 e 1] >= $idx] }
6630: 7b 0a 09 69 66 20 7b 20 24 72 65 74 75 72 6e 5f {..if { $return_
6640: 72 61 6e 67 65 20 7d 20 7b 0a 09 20 20 20 20 72 range } {.. r
6650: 65 74 75 72 6e 20 24 72 61 6e 67 65 0a 09 7d 20 eturn $range..}
6660: 65 6c 73 65 20 7b 0a 09 20 20 20 20 72 65 74 75 else {.. retu
6670: 72 6e 20 5b 24 74 65 78 74 20 67 65 74 20 7b 2a rn [$text get {*
6680: 7d 24 72 61 6e 67 65 5d 0a 09 7d 0a 20 20 20 20 }$range]..}.
6690: 7d 20 65 6c 73 65 20 7b 0a 09 69 66 20 7b 20 24 } else {..if { $
66a0: 69 64 78 20 21 3d 20 22 22 20 7d 20 7b 0a 09 20 idx != "" } {..
66b0: 20 20 20 73 65 74 20 76 61 72 20 22 22 0a 09 20 set var ""..
66c0: 20 20 20 73 65 74 20 69 64 78 30 20 24 69 64 78 set idx0 $idx
66d0: 0a 09 20 20 20 20 73 65 74 20 63 68 61 72 20 5b .. set char [
66e0: 24 74 65 78 74 20 67 65 74 20 24 69 64 78 30 5d $text get $idx0]
66f0: 0a 09 20 20 20 20 69 66 20 7b 20 5b 72 65 67 65 .. if { [rege
6700: 78 70 20 7b 5b 5c 73 2c 3b 5d 7d 20 24 63 68 61 xp {[\s,;]} $cha
6710: 72 5d 20 7d 20 7b 0a 09 09 73 65 74 20 63 20 5b r] } {...set c [
6720: 24 74 65 78 74 20 67 65 74 20 22 24 69 64 78 30 $text get "$idx0
6730: 2d 31 63 22 5d 0a 09 09 69 66 20 7b 20 5b 73 74 -1c"]...if { [st
6740: 72 69 6e 67 20 69 73 20 77 6f 72 64 63 68 61 72 ring is wordchar
6750: 20 24 63 5d 20 7d 20 7b 0a 09 09 20 20 20 20 73 $c] } {... s
6760: 65 74 20 69 64 78 20 5b 24 74 65 78 74 20 69 6e et idx [$text in
6770: 64 65 78 20 22 24 69 64 78 30 2d 31 63 22 5d 0a dex "$idx0-1c"].
6780: 09 09 20 20 20 20 73 65 74 20 69 64 78 30 20 24 .. set idx0 $
6790: 69 64 78 0a 09 09 20 20 20 20 73 65 74 20 63 68 idx... set ch
67a0: 61 72 20 5b 24 74 65 78 74 20 67 65 74 20 24 69 ar [$text get $i
67b0: 64 78 30 5d 0a 09 09 7d 0a 09 20 20 20 20 7d 0a dx0]...}.. }.
67c0: 09 20 20 20 20 77 68 69 6c 65 20 7b 20 5b 73 74 . while { [st
67d0: 72 69 6e 67 20 69 73 20 77 6f 72 64 63 68 61 72 ring is wordchar
67e0: 20 24 63 68 61 72 5d 20 7d 20 7b 0a 09 09 23 20 $char] } {...#
67f0: 20 7c 7c 20 24 63 68 61 72 20 3d 3d 20 22 28 22 || $char == "("
6800: 20 7c 7c 20 24 63 68 61 72 20 3d 3d 20 22 29 22 || $char == ")"
6810: 0a 09 09 73 65 74 20 76 61 72 20 24 63 68 61 72 ...set var $char
6820: 24 76 61 72 0a 09 09 73 65 74 20 69 64 78 30 20 $var...set idx0
6830: 5b 24 74 65 78 74 20 69 6e 64 65 78 20 24 69 64 [$text index $id
6840: 78 30 2d 31 63 5d 0a 09 09 69 66 20 7b 20 5b 24 x0-1c]...if { [$
6850: 74 65 78 74 20 63 6f 6d 70 61 72 65 20 24 69 64 text compare $id
6860: 78 30 20 3c 3d 20 31 2e 30 5d 20 7d 20 7b 20 62 x0 <= 1.0] } { b
6870: 72 65 61 6b 20 7d 0a 09 09 73 65 74 20 63 68 61 reak }...set cha
6880: 72 20 5b 24 74 65 78 74 20 67 65 74 20 24 69 64 r [$text get $id
6890: 78 30 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 x0].. }..
68a0: 73 65 74 20 69 64 78 31 20 5b 24 74 65 78 74 20 set idx1 [$text
68b0: 69 6e 64 65 78 20 24 69 64 78 2b 31 63 5d 0a 09 index $idx+1c]..
68c0: 20 20 20 20 73 65 74 20 63 68 61 72 20 5b 24 74 set char [$t
68d0: 65 78 74 20 67 65 74 20 24 69 64 78 31 5d 0a 09 ext get $idx1]..
68e0: 20 20 20 20 77 68 69 6c 65 20 7b 20 5b 73 74 72 while { [str
68f0: 69 6e 67 20 69 73 20 77 6f 72 64 63 68 61 72 20 ing is wordchar
6900: 24 63 68 61 72 5d 20 7d 20 7b 0a 09 09 23 20 20 $char] } {...#
6910: 7c 7c 20 24 63 68 61 72 20 3d 3d 20 22 28 22 20 || $char == "("
6920: 7c 7c 20 24 63 68 61 72 20 3d 3d 20 22 29 22 0a || $char == ")".
6930: 09 09 61 70 70 65 6e 64 20 76 61 72 20 24 63 68 ..append var $ch
6940: 61 72 0a 09 09 73 65 74 20 69 64 78 31 20 5b 24 ar...set idx1 [$
6950: 74 65 78 74 20 69 6e 64 65 78 20 24 69 64 78 31 text index $idx1
6960: 2b 31 63 5d 0a 09 09 69 66 20 7b 20 5b 24 74 65 +1c]...if { [$te
6970: 78 74 20 63 6f 6d 70 61 72 65 20 24 69 64 78 31 xt compare $idx1
6980: 20 3e 3d 20 65 6e 64 2d 31 63 5d 20 7d 20 7b 20 >= end-1c] } {
6990: 62 72 65 61 6b 20 7d 0a 09 09 73 65 74 20 63 68 break }...set ch
69a0: 61 72 20 5b 24 74 65 78 74 20 67 65 74 20 24 69 ar [$text get $i
69b0: 64 78 31 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 dx1].. }..
69c0: 20 69 66 20 7b 20 21 5b 72 65 67 65 78 70 20 7b if { ![regexp {
69d0: 5b 5e 28 29 5d 2a 5c 28 5b 5e 5c 29 5d 2b 5c 29 [^()]*\([^\)]+\)
69e0: 7d 20 24 76 61 72 5d 20 7d 20 7b 0a 09 09 73 65 } $var] } {...se
69f0: 74 20 76 61 72 20 5b 73 74 72 69 6e 67 20 74 72 t var [string tr
6a00: 69 6d 72 69 67 68 74 20 24 76 61 72 20 22 28 29 imright $var "()
6a10: 22 5d 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 "].. }..} els
6a20: 65 20 7b 20 73 65 74 20 76 61 72 20 22 22 20 7d e { set var "" }
6a30: 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 20 . }. if {
6a40: 24 72 65 74 75 72 6e 5f 72 61 6e 67 65 20 7d 20 $return_range }
6a50: 7b 0a 09 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 {..return [list
6a60: 5b 24 74 65 78 74 20 69 6e 64 65 78 20 22 24 69 [$text index "$i
6a70: 64 78 30 2b 31 63 22 5d 20 5b 24 74 65 78 74 20 dx0+1c"] [$text
6a80: 69 6e 64 65 78 20 22 24 69 64 78 31 22 5d 5d 0a index "$idx1"]].
6a90: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 72 65 } else {..re
6aa0: 74 75 72 6e 20 24 76 61 72 0a 20 20 20 20 7d 0a turn $var. }.
6ab0: 7d 0a 0a 23 23 23 23 23 23 23 23 23 23 23 23 23 }..#############
6ac0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6ad0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6ae0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6af0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6b00: 23 23 23 0a 23 20 20 20 20 73 74 6f 72 65 20 70 ###.# store p
6b10: 72 65 66 65 72 65 6e 63 65 73 0a 23 23 23 23 23 references.#####
6b20: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6b30: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6b40: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6b50: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
6b60: 23 23 23 23 23 23 23 23 23 23 23 0a 0a 70 72 6f ###########..pro
6b70: 63 20 63 75 3a 3a 73 74 6f 72 65 5f 70 72 6f 67 c cu::store_prog
6b80: 72 61 6d 5f 70 72 65 66 65 72 65 6e 63 65 73 20 ram_preferences
6b90: 7b 20 61 72 67 73 20 7d 20 7b 0a 0a 20 20 20 20 { args } {..
6ba0: 73 65 74 20 6f 70 74 69 6f 6e 61 6c 20 7b 0a 09 set optional {..
6bb0: 7b 20 2d 76 61 6c 75 65 4e 61 6d 65 20 6e 61 6d { -valueName nam
6bc0: 65 20 22 22 20 7d 0a 20 20 20 20 7d 0a 20 20 20 e "" }. }.
6bd0: 20 73 65 74 20 63 6f 6d 70 75 6c 73 6f 72 79 20 set compulsory
6be0: 22 70 72 6f 67 72 61 6d 5f 6e 61 6d 65 20 64 61 "program_name da
6bf0: 74 61 22 0a 0a 20 20 20 20 70 61 72 73 65 5f 61 ta".. parse_a
6c00: 72 67 73 20 24 6f 70 74 69 6f 6e 61 6c 20 24 63 rgs $optional $c
6c10: 6f 6d 70 75 6c 73 6f 72 79 20 24 61 72 67 73 0a ompulsory $args.
6c20: 0a 20 20 20 20 69 66 20 7b 20 24 76 61 6c 75 65 . if { $value
6c30: 4e 61 6d 65 20 65 71 20 22 22 20 7d 20 7b 0a 09 Name eq "" } {..
6c40: 73 65 74 20 76 61 6c 75 65 4e 61 6d 65 46 20 49 set valueNameF I
6c50: 6e 69 44 61 74 61 0a 20 20 20 20 7d 20 65 6c 73 niData. } els
6c60: 65 20 7b 0a 09 73 65 74 20 76 61 6c 75 65 4e 61 e {..set valueNa
6c70: 6d 65 46 20 49 6e 69 44 61 74 61 5f 24 76 61 6c meF IniData_$val
6c80: 75 65 4e 61 6d 65 0a 20 20 20 20 7d 0a 0a 20 20 ueName. }..
6c90: 20 20 69 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 6c if { $::tcl_pl
6ca0: 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 atform(platform)
6cb0: 20 65 71 20 22 77 69 6e 64 6f 77 73 22 20 26 26 eq "windows" &&
6cc0: 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d $::tcl_platform
6cd0: 28 6f 73 29 20 6e 65 20 22 57 69 6e 64 6f 77 73 (os) ne "Windows
6ce0: 20 43 45 22 20 7d 20 7b 0a 09 73 65 74 20 6b 65 CE" } {..set ke
6cf0: 79 20 22 48 4b 45 59 5f 43 55 52 52 45 4e 54 5f y "HKEY_CURRENT_
6d00: 55 53 45 52 5c 5c 53 6f 66 74 77 61 72 65 5c 5c USER\\Software\\
6d10: 43 6f 6d 70 61 73 73 5c 5c 24 70 72 6f 67 72 61 Compass\\$progra
6d20: 6d 5f 6e 61 6d 65 22 0a 09 70 61 63 6b 61 67 65 m_name"..package
6d30: 20 72 65 71 75 69 72 65 20 72 65 67 69 73 74 72 require registr
6d40: 79 0a 09 72 65 67 69 73 74 72 79 20 73 65 74 20 y..registry set
6d50: 24 6b 65 79 20 24 76 61 6c 75 65 4e 61 6d 65 46 $key $valueNameF
6d60: 20 24 64 61 74 61 0a 20 20 20 20 7d 20 65 6c 73 $data. } els
6d70: 65 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 e {..package req
6d80: 75 69 72 65 20 74 64 6f 6d 0a 09 69 66 20 7b 20 uire tdom..if {
6d90: 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 $::tcl_platform(
6da0: 6f 73 29 20 65 71 20 22 57 69 6e 64 6f 77 73 20 os) eq "Windows
6db0: 43 45 22 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 CE" } {.. set
6dc0: 20 64 69 72 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 dir [file join
6dd0: 2f 20 22 41 70 70 6c 69 63 61 74 69 6f 6e 20 44 / "Application D
6de0: 61 74 61 22 20 43 6f 6d 70 61 73 73 20 24 70 72 ata" Compass $pr
6df0: 6f 67 72 61 6d 5f 6e 61 6d 65 5d 0a 09 20 20 20 ogram_name]..
6e00: 20 66 69 6c 65 20 6d 6b 64 69 72 20 24 64 69 72 file mkdir $dir
6e10: 0a 09 20 20 20 20 73 65 74 20 66 69 6c 65 20 5b .. set file [
6e20: 66 69 6c 65 20 6a 6f 69 6e 20 24 64 69 72 20 70 file join $dir p
6e30: 72 65 66 73 5d 0a 09 7d 20 65 6c 73 65 69 66 20 refs]..} elseif
6e40: 7b 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 3a { [info exists :
6e50: 3a 65 6e 76 28 48 4f 4d 45 29 5d 20 7d 20 7b 0a :env(HOME)] } {.
6e60: 09 20 20 20 20 73 65 74 20 66 69 6c 65 20 5b 66 . set file [f
6e70: 69 6c 65 20 6e 6f 72 6d 61 6c 69 7a 65 20 7e 2f ile normalize ~/
6e80: 2e 63 6f 6d 70 61 73 73 5f 24 7b 70 72 6f 67 72 .compass_${progr
6e90: 61 6d 5f 6e 61 6d 65 7d 5f 70 72 65 66 73 5d 0a am_name}_prefs].
6ea0: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 .} else {.. s
6eb0: 65 74 20 66 69 6c 65 20 5b 66 69 6c 65 20 6e 6f et file [file no
6ec0: 72 6d 61 6c 69 7a 65 20 5b 66 69 6c 65 20 6a 6f rmalize [file jo
6ed0: 69 6e 20 2f 74 6d 70 20 63 6f 6d 70 61 73 73 5f in /tmp compass_
6ee0: 24 7b 70 72 6f 67 72 61 6d 5f 6e 61 6d 65 7d 5f ${program_name}_
6ef0: 70 72 65 66 73 5d 5d 0a 09 7d 0a 09 73 65 74 20 prefs]]..}..set
6f00: 65 72 72 20 5b 63 61 74 63 68 20 7b 20 74 44 4f err [catch { tDO
6f10: 4d 3a 3a 78 6d 6c 52 65 61 64 46 69 6c 65 20 24 M::xmlReadFile $
6f20: 66 69 6c 65 20 7d 20 78 6d 6c 5d 0a 09 69 66 20 file } xml]..if
6f30: 7b 20 24 65 72 72 20 7d 20 7b 20 73 65 74 20 78 { $err } { set x
6f40: 6d 6c 20 22 3c 70 72 65 66 65 72 65 6e 63 65 73 ml "<preferences
6f50: 2f 3e 22 20 7d 0a 09 73 65 74 20 64 6f 63 20 5b />" }..set doc [
6f60: 64 6f 6d 20 70 61 72 73 65 20 24 78 6d 6c 5d 0a dom parse $xml].
6f70: 09 73 65 74 20 72 6f 6f 74 20 5b 24 64 6f 63 20 .set root [$doc
6f80: 64 6f 63 75 6d 65 6e 74 45 6c 65 6d 65 6e 74 5d documentElement]
6f90: 0a 09 73 65 74 20 64 6f 6d 4e 6f 64 65 20 5b 24 ..set domNode [$
6fa0: 72 6f 6f 74 20 73 65 6c 65 63 74 4e 6f 64 65 73 root selectNodes
6fb0: 20 22 70 72 65 66 5c 5b 40 6e 3d 5b 78 70 61 74 "pref\[@n=[xpat
6fc0: 68 5f 73 74 72 20 24 76 61 6c 75 65 4e 61 6d 65 h_str $valueName
6fd0: 46 5d 5c 5d 22 5d 0a 09 69 66 20 7b 20 24 64 6f F]\]"]..if { $do
6fe0: 6d 4e 6f 64 65 20 6e 65 20 22 22 20 7d 20 7b 20 mNode ne "" } {
6ff0: 24 64 6f 6d 4e 6f 64 65 20 64 65 6c 65 74 65 20 $domNode delete
7000: 7d 0a 09 73 65 74 20 70 20 5b 24 72 6f 6f 74 20 }..set p [$root
7010: 61 70 70 65 6e 64 43 68 69 6c 64 54 61 67 20 70 appendChildTag p
7020: 72 65 66 5d 0a 09 24 70 20 73 65 74 41 74 74 72 ref]..$p setAttr
7030: 69 62 75 74 65 20 6e 20 24 76 61 6c 75 65 4e 61 ibute n $valueNa
7040: 6d 65 46 0a 09 24 70 20 61 70 70 65 6e 64 43 68 meF..$p appendCh
7050: 69 6c 64 54 65 78 74 20 24 64 61 74 61 0a 0a 09 ildText $data...
7060: 73 65 74 20 66 6f 75 74 20 5b 6f 70 65 6e 20 24 set fout [open $
7070: 66 69 6c 65 20 77 5d 0a 09 66 63 6f 6e 66 69 67 file w]..fconfig
7080: 75 72 65 20 24 66 6f 75 74 20 2d 65 6e 63 6f 64 ure $fout -encod
7090: 69 6e 67 20 75 74 66 2d 38 0a 09 70 75 74 73 20 ing utf-8..puts
70a0: 24 66 6f 75 74 20 5b 24 64 6f 63 20 61 73 58 4d $fout [$doc asXM
70b0: 4c 5d 0a 09 63 6c 6f 73 65 20 24 66 6f 75 74 0a L]..close $fout.
70c0: 20 20 20 20 7d 0a 7d 0a 70 72 6f 63 20 63 75 3a }.}.proc cu:
70d0: 3a 67 65 74 5f 70 72 6f 67 72 61 6d 5f 70 72 65 :get_program_pre
70e0: 66 65 72 65 6e 63 65 73 20 7b 20 61 72 67 73 20 ferences { args
70f0: 7d 20 7b 0a 0a 20 20 20 20 73 65 74 20 6f 70 74 } {.. set opt
7100: 69 6f 6e 61 6c 20 7b 0a 09 7b 20 2d 76 61 6c 75 ional {..{ -valu
7110: 65 4e 61 6d 65 20 6e 61 6d 65 20 22 22 20 7d 0a eName name "" }.
7120: 09 7b 20 2d 64 65 66 61 75 6c 74 20 64 65 66 61 .{ -default defa
7130: 75 6c 74 5f 76 61 6c 75 65 20 22 22 20 7d 0a 20 ult_value "" }.
7140: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 6f 6d }. set com
7150: 70 75 6c 73 6f 72 79 20 22 70 72 6f 67 72 61 6d pulsory "program
7160: 5f 6e 61 6d 65 22 0a 0a 20 20 20 20 70 61 72 73 _name".. pars
7170: 65 5f 61 72 67 73 20 24 6f 70 74 69 6f 6e 61 6c e_args $optional
7180: 20 24 63 6f 6d 70 75 6c 73 6f 72 79 20 24 61 72 $compulsory $ar
7190: 67 73 0a 0a 20 20 20 20 69 66 20 7b 20 24 76 61 gs.. if { $va
71a0: 6c 75 65 4e 61 6d 65 20 65 71 20 22 22 20 7d 20 lueName eq "" }
71b0: 7b 0a 09 73 65 74 20 76 61 6c 75 65 4e 61 6d 65 {..set valueName
71c0: 46 20 49 6e 69 44 61 74 61 0a 20 20 20 20 7d 20 F IniData. }
71d0: 65 6c 73 65 20 7b 0a 09 73 65 74 20 76 61 6c 75 else {..set valu
71e0: 65 4e 61 6d 65 46 20 49 6e 69 44 61 74 61 5f 24 eNameF IniData_$
71f0: 76 61 6c 75 65 4e 61 6d 65 0a 20 20 20 20 7d 0a valueName. }.
7200: 0a 20 20 20 20 73 65 74 20 64 61 74 61 20 24 64 . set data $d
7210: 65 66 61 75 6c 74 0a 20 20 20 20 69 66 20 7b 20 efault. if {
7220: 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 $::tcl_platform(
7230: 70 6c 61 74 66 6f 72 6d 29 20 65 71 20 22 77 69 platform) eq "wi
7240: 6e 64 6f 77 73 22 20 26 26 20 24 3a 3a 74 63 6c ndows" && $::tcl
7250: 5f 70 6c 61 74 66 6f 72 6d 28 6f 73 29 20 6e 65 _platform(os) ne
7260: 20 22 57 69 6e 64 6f 77 73 20 43 45 22 20 7d 20 "Windows CE" }
7270: 7b 0a 09 73 65 74 20 6b 65 79 20 22 48 4b 45 59 {..set key "HKEY
7280: 5f 43 55 52 52 45 4e 54 5f 55 53 45 52 5c 5c 53 _CURRENT_USER\\S
7290: 6f 66 74 77 61 72 65 5c 5c 43 6f 6d 70 61 73 73 oftware\\Compass
72a0: 5c 5c 24 70 72 6f 67 72 61 6d 5f 6e 61 6d 65 22 \\$program_name"
72b0: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
72c0: 65 20 72 65 67 69 73 74 72 79 0a 09 73 65 74 20 e registry..set
72d0: 65 72 72 20 5b 63 61 74 63 68 20 7b 20 72 65 67 err [catch { reg
72e0: 69 73 74 72 79 20 67 65 74 20 24 6b 65 79 20 24 istry get $key $
72f0: 76 61 6c 75 65 4e 61 6d 65 46 20 7d 20 64 61 74 valueNameF } dat
7300: 61 5d 0a 09 69 66 20 7b 20 24 65 72 72 20 7d 20 a]..if { $err }
7310: 7b 0a 09 20 20 20 20 73 65 74 20 64 61 74 61 20 {.. set data
7320: 24 64 65 66 61 75 6c 74 0a 09 7d 0a 20 20 20 20 $default..}.
7330: 7d 20 65 6c 73 65 20 7b 0a 09 70 61 63 6b 61 67 } else {..packag
7340: 65 20 72 65 71 75 69 72 65 20 74 64 6f 6d 0a 09 e require tdom..
7350: 69 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 if { $::tcl_plat
7360: 66 6f 72 6d 28 6f 73 29 20 65 71 20 22 57 69 6e form(os) eq "Win
7370: 64 6f 77 73 20 43 45 22 20 7d 20 7b 0a 09 20 20 dows CE" } {..
7380: 20 20 73 65 74 20 64 69 72 20 5b 66 69 6c 65 20 set dir [file
7390: 6a 6f 69 6e 20 2f 20 22 41 70 70 6c 69 63 61 74 join / "Applicat
73a0: 69 6f 6e 20 44 61 74 61 22 20 43 6f 6d 70 61 73 ion Data" Compas
73b0: 73 20 24 70 72 6f 67 72 61 6d 5f 6e 61 6d 65 5d s $program_name]
73c0: 0a 09 20 20 20 20 66 69 6c 65 20 6d 6b 64 69 72 .. file mkdir
73d0: 20 24 64 69 72 0a 09 20 20 20 20 73 65 74 20 66 $dir.. set f
73e0: 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 ile [file join $
73f0: 64 69 72 20 70 72 65 66 73 5d 0a 09 7d 20 65 6c dir prefs]..} el
7400: 73 65 69 66 20 7b 20 5b 69 6e 66 6f 20 65 78 69 seif { [info exi
7410: 73 74 73 20 3a 3a 65 6e 76 28 48 4f 4d 45 29 5d sts ::env(HOME)]
7420: 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 66 69 } {.. set fi
7430: 6c 65 20 5b 66 69 6c 65 20 6e 6f 72 6d 61 6c 69 le [file normali
7440: 7a 65 20 7e 2f 2e 63 6f 6d 70 61 73 73 5f 24 7b ze ~/.compass_${
7450: 70 72 6f 67 72 61 6d 5f 6e 61 6d 65 7d 5f 70 72 program_name}_pr
7460: 65 66 73 5d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 efs]..} else {..
7470: 20 20 20 20 73 65 74 20 66 69 6c 65 20 5b 66 69 set file [fi
7480: 6c 65 20 6e 6f 72 6d 61 6c 69 7a 65 20 5b 66 69 le normalize [fi
7490: 6c 65 20 6a 6f 69 6e 20 2f 74 6d 70 20 63 6f 6d le join /tmp com
74a0: 70 61 73 73 5f 24 7b 70 72 6f 67 72 61 6d 5f 6e pass_${program_n
74b0: 61 6d 65 7d 5f 70 72 65 66 73 5d 5d 0a 09 7d 0a ame}_prefs]]..}.
74c0: 09 73 65 74 20 65 72 72 20 5b 63 61 74 63 68 20 .set err [catch
74d0: 7b 20 74 44 4f 4d 3a 3a 78 6d 6c 52 65 61 64 46 { tDOM::xmlReadF
74e0: 69 6c 65 20 24 66 69 6c 65 20 7d 20 78 6d 6c 5d ile $file } xml]
74f0: 0a 09 69 66 20 7b 20 21 24 65 72 72 20 7d 20 7b ..if { !$err } {
7500: 0a 09 20 20 20 20 73 65 74 20 64 6f 63 20 5b 64 .. set doc [d
7510: 6f 6d 20 70 61 72 73 65 20 24 78 6d 6c 5d 0a 09 om parse $xml]..
7520: 20 20 20 20 73 65 74 20 72 6f 6f 74 20 5b 24 64 set root [$d
7530: 6f 63 20 64 6f 63 75 6d 65 6e 74 45 6c 65 6d 65 oc documentEleme
7540: 6e 74 5d 0a 09 20 20 20 20 73 65 74 20 64 6f 6d nt].. set dom
7550: 4e 6f 64 65 20 5b 24 72 6f 6f 74 20 73 65 6c 65 Node [$root sele
7560: 63 74 4e 6f 64 65 73 20 22 70 72 65 66 5c 5b 40 ctNodes "pref\[@
7570: 6e 3d 5b 78 70 61 74 68 5f 73 74 72 20 24 76 61 n=[xpath_str $va
7580: 6c 75 65 4e 61 6d 65 46 5d 5c 5d 22 5d 0a 09 20 lueNameF]\]"]..
7590: 20 20 20 69 66 20 7b 20 24 64 6f 6d 4e 6f 64 65 if { $domNode
75a0: 20 6e 65 20 22 22 20 7d 20 7b 0a 09 09 73 65 74 ne "" } {...set
75b0: 20 64 61 74 61 20 5b 24 64 6f 6d 4e 6f 64 65 20 data [$domNode
75c0: 74 65 78 74 5d 0a 09 20 20 20 20 7d 0a 09 7d 0a text].. }..}.
75d0: 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 6e }. return
75e0: 20 24 64 61 74 61 0a 7d 0a 0a 23 23 23 23 23 23 $data.}..######
75f0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
7600: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
7610: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
7620: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
7630: 23 23 23 23 23 23 23 23 23 23 0a 23 20 20 20 20 ##########.#
7640: 63 75 3a 3a 73 65 74 5f 77 69 6e 64 6f 77 5f 67 cu::set_window_g
7650: 65 6f 6d 65 74 72 79 20 75 3a 3a 67 69 76 65 5f eometry u::give_
7660: 77 69 6e 64 6f 77 5f 67 65 6f 6d 65 74 72 79 0a window_geometry.
7670: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
7680: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
7690: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
76a0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
76b0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
76c0: 0a 0a 70 72 6f 63 20 63 75 3a 3a 67 69 76 65 5f ..proc cu::give_
76d0: 77 69 6e 64 6f 77 5f 67 65 6f 6d 65 74 72 79 20 window_geometry
76e0: 7b 20 77 20 7d 20 7b 0a 0a 20 20 20 20 72 65 67 { w } {.. reg
76f0: 65 78 70 20 7b 28 5c 64 2b 29 78 28 5c 64 2b 29 exp {(\d+)x(\d+)
7700: 28 5b 2d 2b 5d 29 28 5b 2d 5c 64 5d 5c 64 2a 29 ([-+])([-\d]\d*)
7710: 28 5b 2d 2b 5d 29 28 5b 2d 5c 64 5d 2b 29 7d 20 ([-+])([-\d]+)}
7720: 5b 77 6d 20 67 65 6f 6d 65 74 72 79 20 24 77 5d [wm geometry $w]
7730: 20 7b 7d 20 77 69 64 74 68 20 68 65 69 67 68 74 {} width height
7740: 20 6d 31 20 78 20 6d 32 20 79 0a 20 20 20 20 69 m1 x m2 y. i
7750: 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 f { $::tcl_platf
7760: 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 65 71 orm(platform) eq
7770: 20 22 75 6e 69 78 22 20 7d 20 7b 0a 09 23 20 6e "unix" } {..# n
7780: 6f 74 65 3a 20 74 68 69 73 20 77 6f 72 6b 20 69 ote: this work i
7790: 6e 20 75 62 75 6e 74 75 20 39 2e 30 34 0a 09 69 n ubuntu 9.04..i
77a0: 6e 63 72 20 78 20 2d 34 0a 09 69 6e 63 72 20 79 ncr x -4..incr y
77b0: 20 2d 32 34 0a 20 20 20 20 7d 0a 20 20 20 20 72 -24. }. r
77c0: 65 74 75 72 6e 20 24 7b 77 69 64 74 68 7d 78 24 eturn ${width}x$
77d0: 68 65 69 67 68 74 24 6d 31 24 78 24 6d 32 24 79 height$m1$x$m2$y
77e0: 0a 7d 0a 0a 70 72 6f 63 20 63 75 3a 3a 73 65 74 .}..proc cu::set
77f0: 5f 77 69 6e 64 6f 77 5f 67 65 6f 6d 65 74 72 79 _window_geometry
7800: 20 7b 20 77 20 67 65 6f 6d 65 74 72 79 20 7d 20 { w geometry }
7810: 7b 0a 0a 20 20 20 20 69 66 20 7b 20 21 5b 72 65 {.. if { ![re
7820: 67 65 78 70 20 7b 28 5c 64 2b 29 78 28 5c 64 2b gexp {(\d+)x(\d+
7830: 29 28 5b 2d 2b 5d 29 28 5b 2d 5c 64 5d 5c 64 2a )([-+])([-\d]\d*
7840: 29 28 5b 2d 2b 5d 29 28 5b 2d 5c 64 5d 2b 29 7d )([-+])([-\d]+)}
7850: 20 24 67 65 6f 6d 65 74 72 79 20 7b 7d 20 77 69 $geometry {} wi
7860: 64 74 68 20 68 65 69 67 68 74 20 6d 31 20 78 20 dth height m1 x
7870: 6d 32 20 79 5d 20 7d 20 7b 0a 09 72 65 67 65 78 m2 y] } {..regex
7880: 70 20 7b 28 5c 64 2b 29 78 28 5c 64 2b 29 7d 20 p {(\d+)x(\d+)}
7890: 24 67 65 6f 6d 65 74 72 79 20 7b 7d 20 77 69 64 $geometry {} wid
78a0: 74 68 20 68 65 69 67 68 74 0a 09 6c 61 73 73 69 th height..lassi
78b0: 67 6e 20 5b 6c 69 73 74 20 30 20 30 20 2b 20 2b gn [list 0 0 + +
78c0: 5d 20 78 20 79 20 6d 31 20 6d 32 0a 20 20 20 20 ] x y m1 m2.
78d0: 7d 0a 20 20 20 20 69 66 20 7b 20 24 78 20 3c 20 }. if { $x <
78e0: 30 20 7d 20 7b 20 73 65 74 20 78 20 30 20 7d 0a 0 } { set x 0 }.
78f0: 20 20 20 20 69 66 20 7b 20 24 79 20 3c 20 30 20 if { $y < 0
7900: 7d 20 7b 20 73 65 74 20 79 20 30 20 7d 0a 20 20 } { set y 0 }.
7910: 20 20 69 66 20 7b 20 24 78 20 3e 20 5b 77 69 6e if { $x > [win
7920: 66 6f 20 73 63 72 65 65 6e 77 69 64 74 68 20 24 fo screenwidth $
7930: 77 5d 2d 31 30 30 20 7d 20 7b 20 73 65 74 20 78 w]-100 } { set x
7940: 20 5b 65 78 70 72 20 7b 5b 77 69 6e 66 6f 20 73 [expr {[winfo s
7950: 63 72 65 65 6e 77 69 64 74 68 20 24 77 5d 2d 31 creenwidth $w]-1
7960: 30 30 7d 5d 20 7d 0a 20 20 20 20 69 66 20 7b 20 00}] }. if {
7970: 24 79 20 3e 20 5b 77 69 6e 66 6f 20 73 63 72 65 $y > [winfo scre
7980: 65 6e 68 65 69 67 68 74 20 24 77 5d 2d 31 30 30 enheight $w]-100
7990: 20 7d 20 7b 20 73 65 74 20 79 20 5b 65 78 70 72 } { set y [expr
79a0: 20 7b 5b 77 69 6e 66 6f 20 73 63 72 65 65 6e 68 {[winfo screenh
79b0: 65 69 67 68 74 20 24 77 5d 2d 31 30 30 7d 5d 20 eight $w]-100}]
79c0: 7d 0a 20 20 20 20 0a 20 20 20 20 69 66 20 7b 20 }. . if {
79d0: 24 6d 32 20 65 71 20 22 2b 22 20 26 26 20 24 79 $m2 eq "+" && $y
79e0: 2b 24 68 65 69 67 68 74 20 3e 20 5b 77 69 6e 66 +$height > [winf
79f0: 6f 20 73 63 72 65 65 6e 68 65 69 67 68 74 20 24 o screenheight $
7a00: 77 5d 20 7d 20 7b 0a 09 69 66 20 7b 20 24 79 20 w] } {..if { $y
7a10: 3e 20 30 2e 35 2a 5b 77 69 6e 66 6f 20 73 63 72 > 0.5*[winfo scr
7a20: 65 65 6e 68 65 69 67 68 74 20 24 77 5d 20 7d 20 eenheight $w] }
7a30: 7b 0a 09 20 20 20 20 73 65 74 20 79 20 5b 65 78 {.. set y [ex
7a40: 70 72 20 7b 72 6f 75 6e 64 28 30 2e 35 2a 5b 77 pr {round(0.5*[w
7a50: 69 6e 66 6f 20 73 63 72 65 65 6e 68 65 69 67 68 info screenheigh
7a60: 74 20 24 77 5d 29 7d 5d 0a 09 7d 0a 09 73 65 74 t $w])}]..}..set
7a70: 20 68 65 69 67 68 74 20 5b 65 78 70 72 20 7b 5b height [expr {[
7a80: 77 69 6e 66 6f 20 73 63 72 65 65 6e 68 65 69 67 winfo screenheig
7a90: 68 74 20 24 77 5d 2d 24 79 7d 5d 0a 20 20 20 20 ht $w]-$y}].
7aa0: 7d 0a 20 20 20 20 77 6d 20 67 65 6f 6d 65 74 72 }. wm geometr
7ab0: 79 20 24 77 20 24 7b 77 69 64 74 68 7d 78 24 68 y $w ${width}x$h
7ac0: 65 69 67 68 74 24 6d 31 24 78 24 6d 32 24 79 0a eight$m1$x$m2$y.
7ad0: 7d 0a 0a 70 72 6f 63 20 63 75 3a 3a 63 72 65 61 }..proc cu::crea
7ae0: 74 65 5f 74 6f 6f 6c 74 69 70 5f 74 6f 70 6c 65 te_tooltip_tople
7af0: 76 65 6c 20 7b 20 61 72 67 73 20 7d 20 7b 0a 0a vel { args } {..
7b00: 20 20 20 20 73 65 74 20 6f 70 74 69 6f 6e 61 6c set optional
7b10: 20 7b 0a 09 7b 20 2d 77 69 74 68 64 72 61 77 20 {..{ -withdraw
7b20: 22 22 20 30 20 7d 0a 20 20 20 20 7d 0a 20 20 20 "" 0 }. }.
7b30: 20 73 65 74 20 63 6f 6d 70 75 6c 73 6f 72 79 20 set compulsory
7b40: 22 62 22 0a 20 20 20 20 70 61 72 73 65 5f 61 72 "b". parse_ar
7b50: 67 73 20 24 6f 70 74 69 6f 6e 61 6c 20 24 63 6f gs $optional $co
7b60: 6d 70 75 6c 73 6f 72 79 20 24 61 72 67 73 0a 0a mpulsory $args..
7b70: 20 20 20 20 74 6f 70 6c 65 76 65 6c 20 24 62 20 toplevel $b
7b80: 2d 63 6c 61 73 73 20 54 6f 6f 6c 74 69 70 0a 20 -class Tooltip.
7b90: 20 20 20 69 66 20 7b 20 24 77 69 74 68 64 72 61 if { $withdra
7ba0: 77 20 7d 20 7b 0a 09 77 6d 20 77 69 74 68 64 72 w } {..wm withdr
7bb0: 61 77 20 24 62 0a 20 20 20 20 7d 0a 20 20 20 20 aw $b. }.
7bc0: 69 66 20 7b 5b 74 6b 20 77 69 6e 64 6f 77 69 6e if {[tk windowin
7bd0: 67 73 79 73 74 65 6d 5d 20 65 71 20 22 61 71 75 gsystem] eq "aqu
7be0: 61 22 7d 20 7b 0a 09 3a 3a 74 6b 3a 3a 75 6e 73 a"} {..::tk::uns
7bf0: 75 70 70 6f 72 74 65 64 3a 3a 4d 61 63 57 69 6e upported::MacWin
7c00: 64 6f 77 53 74 79 6c 65 20 73 74 79 6c 65 20 24 dowStyle style $
7c10: 62 20 68 65 6c 70 20 6e 6f 6e 65 0a 20 20 20 20 b help none.
7c20: 7d 20 65 6c 73 65 20 7b 0a 09 77 6d 20 6f 76 65 } else {..wm ove
7c30: 72 72 69 64 65 72 65 64 69 72 65 63 74 20 24 62 rrideredirect $b
7c40: 20 31 0a 20 20 20 20 7d 0a 20 20 20 20 63 61 74 1. }. cat
7c50: 63 68 20 7b 77 6d 20 61 74 74 72 69 62 75 74 65 ch {wm attribute
7c60: 73 20 24 62 20 2d 74 6f 70 6d 6f 73 74 20 31 7d s $b -topmost 1}
7c70: 0a 20 20 20 20 23 20 61 76 6f 69 64 20 74 68 65 . # avoid the
7c80: 20 62 6c 69 6e 6b 20 69 73 73 75 65 20 77 69 74 blink issue wit
7c90: 68 20 31 20 74 6f 20 3c 31 20 61 6c 70 68 61 20 h 1 to <1 alpha
7ca0: 6f 6e 20 57 69 6e 64 6f 77 73 0a 20 20 20 20 63 on Windows. c
7cb0: 61 74 63 68 20 7b 77 6d 20 61 74 74 72 69 62 75 atch {wm attribu
7cc0: 74 65 73 20 24 62 20 2d 61 6c 70 68 61 20 30 2e tes $b -alpha 0.
7cd0: 39 39 7d 0a 20 20 20 20 77 6d 20 70 6f 73 69 74 99}. wm posit
7ce0: 69 6f 6e 66 72 6f 6d 20 24 62 20 70 72 6f 67 72 ionfrom $b progr
7cf0: 61 6d 0a 20 20 20 20 69 66 20 7b 20 5b 74 6b 20 am. if { [tk
7d00: 77 69 6e 64 6f 77 69 6e 67 73 79 73 74 65 6d 5d windowingsystem]
7d10: 20 20 65 71 20 22 78 31 31 22 20 7d 20 7b 0a 09 eq "x11" } {..
7d20: 73 65 74 20 66 6f 63 75 73 20 5b 66 6f 63 75 73 set focus [focus
7d30: 5d 0a 09 66 6f 63 75 73 20 2d 66 6f 72 63 65 20 ]..focus -force
7d40: 24 62 0a 09 72 61 69 73 65 20 24 62 0a 09 69 66 $b..raise $b..if
7d50: 20 7b 20 24 66 6f 63 75 73 20 6e 65 20 22 22 20 { $focus ne ""
7d60: 7d 20 7b 0a 09 20 20 20 20 61 66 74 65 72 20 31 } {.. after 1
7d70: 30 30 20 5b 6c 69 73 74 20 66 6f 63 75 73 20 2d 00 [list focus -
7d80: 66 6f 72 63 65 20 24 66 6f 63 75 73 5d 0a 09 7d force $focus]..}
7d90: 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 . }. retur
7da0: 6e 20 24 62 0a 7d 0a 0a 70 72 6f 63 20 63 75 3a n $b.}..proc cu:
7db0: 3a 67 69 76 65 5f 77 69 64 67 65 74 5f 62 61 63 :give_widget_bac
7dc0: 6b 67 72 6f 75 6e 64 20 7b 20 77 20 7d 20 7b 0a kground { w } {.
7dd0: 20 0a 20 20 20 20 73 65 74 20 65 72 72 20 5b 63 . set err [c
7de0: 61 74 63 68 20 7b 20 24 77 20 63 67 65 74 20 2d atch { $w cget -
7df0: 62 61 63 6b 67 72 6f 75 6e 64 20 7d 20 62 67 63 background } bgc
7e00: 6f 6c 6f 72 5d 0a 20 20 20 20 69 66 20 7b 20 24 olor]. if { $
7e10: 65 72 72 20 7d 20 7b 0a 09 73 65 74 20 65 72 72 err } {..set err
7e20: 20 5b 63 61 74 63 68 20 7b 0a 09 09 73 65 74 20 [catch {...set
7e30: 73 74 79 6c 65 20 5b 24 77 20 63 67 65 74 20 2d style [$w cget -
7e40: 73 74 79 6c 65 5d 0a 09 09 69 66 20 7b 20 24 73 style]...if { $s
7e50: 74 79 6c 65 20 65 71 20 22 22 20 7d 20 7b 0a 09 tyle eq "" } {..
7e60: 09 20 20 20 20 73 65 74 20 73 74 79 6c 65 20 5b . set style [
7e70: 77 69 6e 66 6f 20 63 6c 61 73 73 20 24 77 5d 0a winfo class $w].
7e80: 09 09 7d 0a 09 09 73 65 74 20 62 67 63 6f 6c 6f ..}...set bgcolo
7e90: 72 20 5b 74 74 6b 3a 3a 73 74 79 6c 65 20 6c 6f r [ttk::style lo
7ea0: 6f 6b 75 70 20 24 73 74 79 6c 65 20 2d 62 61 63 okup $style -bac
7eb0: 6b 67 72 6f 75 6e 64 5d 0a 09 20 20 20 20 7d 5d kground].. }]
7ec0: 0a 09 69 66 20 7b 20 24 65 72 72 20 7d 20 7b 0a ..if { $err } {.
7ed0: 09 20 20 20 20 69 66 20 7b 20 24 3a 3a 74 63 6c . if { $::tcl
7ee0: 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f _platform(platfo
7ef0: 72 6d 29 20 65 71 20 22 77 69 6e 64 6f 77 73 22 rm) eq "windows"
7f00: 20 7d 20 7b 0a 09 09 73 65 74 20 62 67 63 6f 6c } {...set bgcol
7f10: 6f 72 20 53 79 73 74 65 6d 42 75 74 74 6f 6e 46 or SystemButtonF
7f20: 61 63 65 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ace.. } else
7f30: 7b 0a 09 09 73 65 74 20 62 67 63 6f 6c 6f 72 20 {...set bgcolor
7f40: 67 72 65 79 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 grey.. }..}.
7f50: 20 20 20 7d 0a 20 20 20 72 65 74 75 72 6e 20 24 }. return $
7f60: 62 67 63 6f 6c 6f 72 0a 7d 0a 0a 23 23 23 23 23 bgcolor.}..#####
7f70: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
7f80: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
7f90: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
7fa0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
7fb0: 23 23 23 23 23 23 23 23 23 23 23 0a 23 20 20 20 ###########.#
7fc0: 20 61 64 64 5f 64 6f 77 6e 5f 61 72 72 6f 77 5f add_down_arrow_
7fd0: 74 6f 5f 69 6d 61 67 65 0a 23 23 23 23 23 23 23 to_image.#######
7fe0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
7ff0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
8000: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
8010: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
8020: 23 23 23 23 23 23 23 23 23 0a 0a 70 72 6f 63 20 #########..proc
8030: 63 75 3a 3a 61 64 64 5f 64 6f 77 6e 5f 61 72 72 cu::add_down_arr
8040: 6f 77 5f 74 6f 5f 69 6d 61 67 65 20 7b 20 61 72 ow_to_image { ar
8050: 67 73 20 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 gs } {. varia
8060: 62 6c 65 20 61 64 64 5f 64 6f 77 6e 5f 61 72 72 ble add_down_arr
8070: 6f 77 5f 74 6f 5f 69 6d 61 67 65 5f 64 65 6c 74 ow_to_image_delt
8080: 61 0a 20 20 20 20 0a 20 20 20 20 73 65 74 20 6f a. . set o
8090: 70 74 69 6f 6e 61 6c 20 7b 0a 09 7b 20 2d 63 6f ptional {..{ -co
80a0: 6c 6f 72 20 63 6f 6c 6f 72 20 62 6c 61 63 6b 20 lor color black
80b0: 7d 0a 09 7b 20 2d 77 20 77 69 64 67 65 74 20 22 }..{ -w widget "
80c0: 22 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 " }. }. se
80d0: 74 20 63 6f 6d 70 75 6c 73 6f 72 79 20 22 69 6d t compulsory "im
80e0: 67 22 0a 20 20 20 20 70 61 72 73 65 5f 61 72 67 g". parse_arg
80f0: 73 20 24 6f 70 74 69 6f 6e 61 6c 20 24 63 6f 6d s $optional $com
8100: 70 75 6c 73 6f 72 79 20 24 61 72 67 73 0a 0a 20 pulsory $args..
8110: 20 20 20 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 if {![info ex
8120: 69 73 74 73 20 61 64 64 5f 64 6f 77 6e 5f 61 72 ists add_down_ar
8130: 72 6f 77 5f 74 6f 5f 69 6d 61 67 65 5f 64 65 6c row_to_image_del
8140: 74 61 5d 20 7d 20 7b 0a 09 73 65 74 20 61 64 64 ta] } {..set add
8150: 5f 64 6f 77 6e 5f 61 72 72 6f 77 5f 74 6f 5f 69 _down_arrow_to_i
8160: 6d 61 67 65 5f 64 65 6c 74 61 20 37 0a 20 20 20 mage_delta 7.
8170: 20 7d 0a 20 20 20 20 69 66 20 7b 20 24 69 6d 67 }. if { $img
8180: 20 6e 65 20 22 22 20 7d 20 7b 0a 09 73 65 74 20 ne "" } {..set
8190: 77 69 64 74 68 20 5b 69 6d 61 67 65 20 77 69 64 width [image wid
81a0: 74 68 20 24 69 6d 67 5d 0a 09 73 65 74 20 68 65 th $img]..set he
81b0: 69 67 68 74 20 5b 69 6d 61 67 65 20 68 65 69 67 ight [image heig
81c0: 68 74 20 24 69 6d 67 5d 0a 20 20 20 20 7d 20 65 ht $img]. } e
81d0: 6c 73 65 20 7b 0a 09 6c 61 73 73 69 67 6e 20 5b lse {..lassign [
81e0: 6c 69 73 74 20 30 20 31 36 5d 20 77 69 64 74 68 list 0 16] width
81f0: 20 68 65 69 67 68 74 0a 20 20 20 20 7d 0a 20 20 height. }.
8200: 20 20 73 65 74 20 6e 65 77 5f 69 6d 67 20 5b 69 set new_img [i
8210: 6d 61 67 65 20 63 72 65 61 74 65 20 70 68 6f 74 mage create phot
8220: 6f 20 2d 77 69 64 74 68 20 5b 65 78 70 72 20 7b o -width [expr {
8230: 24 77 69 64 74 68 2b 24 61 64 64 5f 64 6f 77 6e $width+$add_down
8240: 5f 61 72 72 6f 77 5f 74 6f 5f 69 6d 61 67 65 5f _arrow_to_image_
8250: 64 65 6c 74 61 7d 5d 20 2d 68 65 69 67 68 74 20 delta}] -height
8260: 24 68 65 69 67 68 74 5d 0a 20 20 20 20 69 66 20 $height]. if
8270: 7b 20 24 69 6d 67 20 6e 65 20 22 22 20 7d 20 7b { $img ne "" } {
8280: 20 24 6e 65 77 5f 69 6d 67 20 63 6f 70 79 20 24 $new_img copy $
8290: 69 6d 67 20 2d 74 6f 20 30 20 30 20 7d 0a 20 20 img -to 0 0 }.
82a0: 20 20 73 65 74 20 63 6f 6f 72 64 73 20 7b 0a 09 set coords {..
82b0: 2d 33 20 2d 31 0a 09 2d 34 20 2d 32 20 2d 33 20 -3 -1..-4 -2 -3
82c0: 2d 32 20 2d 32 20 2d 32 0a 09 2d 35 20 2d 33 20 -2 -2 -2..-5 -3
82d0: 2d 34 20 2d 33 20 2d 33 20 2d 33 20 2d 32 20 2d -4 -3 -3 -3 -2 -
82e0: 33 20 2d 31 20 2d 33 0a 20 20 20 20 7d 0a 20 20 3 -1 -3. }.
82f0: 20 20 66 6f 72 65 61 63 68 20 22 78 20 79 22 20 foreach "x y"
8300: 24 63 6f 6f 72 64 73 20 7b 0a 09 24 6e 65 77 5f $coords {..$new_
8310: 69 6d 67 20 70 75 74 20 24 63 6f 6c 6f 72 20 2d img put $color -
8320: 74 6f 20 5b 65 78 70 72 20 7b 24 77 69 64 74 68 to [expr {$width
8330: 2b 24 61 64 64 5f 64 6f 77 6e 5f 61 72 72 6f 77 +$add_down_arrow
8340: 5f 74 6f 5f 69 6d 61 67 65 5f 64 65 6c 74 61 2b _to_image_delta+
8350: 24 78 7d 5d 20 5b 65 78 70 72 20 7b 24 68 65 69 $x}] [expr {$hei
8360: 67 68 74 2b 24 79 7d 5d 0a 20 20 20 20 7d 0a 20 ght+$y}]. }.
8370: 20 20 20 69 66 20 7b 20 24 77 20 6e 65 20 22 22 if { $w ne ""
8380: 20 7d 20 7b 0a 09 24 77 20 63 6f 6e 66 69 67 75 } {..$w configu
8390: 72 65 20 2d 69 6d 61 67 65 20 24 6e 65 77 5f 69 re -image $new_i
83a0: 6d 67 0a 09 62 69 6e 64 20 24 77 20 3c 44 65 73 mg..bind $w <Des
83b0: 74 72 6f 79 3e 20 2b 5b 6c 69 73 74 20 69 6d 61 troy> +[list ima
83c0: 67 65 20 64 65 6c 65 74 65 20 24 6e 65 77 5f 69 ge delete $new_i
83d0: 6d 67 5d 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 mg]. }. re
83e0: 74 75 72 6e 20 24 6e 65 77 5f 69 6d 67 0a 7d 0a turn $new_img.}.
83f0: 0a 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 .###############
8400: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
8410: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
8420: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
8430: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
8440: 23 0a 23 20 20 20 20 58 4d 4c 20 26 20 78 70 61 #.# XML & xpa
8450: 74 68 20 75 74 69 6c 69 74 69 65 73 0a 23 23 23 th utilities.###
8460: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
8470: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
8480: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
8490: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
84a0: 23 23 23 23 23 23 23 23 23 23 23 23 23 0a 0a 70 #############..p
84b0: 72 6f 63 20 78 70 61 74 68 5f 73 74 72 20 7b 20 roc xpath_str {
84c0: 73 74 72 20 7d 20 7b 0a 20 20 20 20 0a 20 20 20 str } {. .
84d0: 20 66 6f 72 65 61 63 68 20 22 73 74 72 4c 69 73 foreach "strLis
84e0: 74 20 74 79 70 65 20 70 6f 73 22 20 5b 6c 69 73 t type pos" [lis
84f0: 74 20 22 22 20 22 22 20 30 5d 20 62 72 65 61 6b t "" "" 0] break
8500: 0a 20 20 20 20 77 68 69 6c 65 20 31 20 7b 0a 09 . while 1 {..
8510: 73 77 69 74 63 68 20 24 74 79 70 65 20 7b 0a 09 switch $type {..
8520: 20 20 20 20 22 22 20 7b 0a 09 09 73 65 74 20 72 "" {...set r
8530: 65 74 20 5b 72 65 67 65 78 70 20 2d 73 74 61 72 et [regexp -star
8540: 74 20 24 70 6f 73 20 2d 69 6e 64 69 63 65 73 20 t $pos -indices
8550: 7b 5b 27 22 5d 7d 20 24 73 74 72 20 69 64 78 73 {['"]} $str idxs
8560: 5d 0a 09 09 69 66 20 7b 20 21 24 72 65 74 20 7d ]...if { !$ret }
8570: 20 7b 0a 09 09 20 20 20 20 6c 61 70 70 65 6e 64 {... lappend
8580: 20 73 74 72 4c 69 73 74 20 22 5c 22 5b 73 74 72 strList "\"[str
8590: 69 6e 67 20 72 61 6e 67 65 20 24 73 74 72 20 24 ing range $str $
85a0: 70 6f 73 20 65 6e 64 5d 5c 22 22 0a 09 09 20 20 pos end]\""...
85b0: 20 20 62 72 65 61 6b 0a 09 09 7d 0a 09 09 73 65 break...}...se
85c0: 74 20 69 64 78 20 5b 6c 69 6e 64 65 78 20 24 69 t idx [lindex $i
85d0: 64 78 73 20 30 5d 0a 09 09 73 77 69 74 63 68 20 dxs 0]...switch
85e0: 2d 2d 20 5b 73 74 72 69 6e 67 20 69 6e 64 65 78 -- [string index
85f0: 20 24 73 74 72 20 24 69 64 78 5d 20 7b 0a 09 09 $str $idx] {...
8600: 20 20 20 20 27 20 7b 20 73 65 74 20 74 79 70 65 ' { set type
8610: 20 61 70 6f 73 74 72 6f 70 68 65 20 7d 0a 09 09 apostrophe }...
8620: 20 20 20 20 5c 22 20 7b 20 73 65 74 20 74 79 70 \" { set typ
8630: 65 20 71 75 6f 74 65 20 7d 0a 09 09 7d 0a 09 20 e quote }...}..
8640: 20 20 20 7d 0a 09 20 20 20 20 61 70 6f 73 74 72 }.. apostr
8650: 6f 70 68 65 20 7b 0a 09 09 73 65 74 20 72 65 74 ophe {...set ret
8660: 20 5b 72 65 67 65 78 70 20 2d 73 74 61 72 74 20 [regexp -start
8670: 24 70 6f 73 20 2d 69 6e 64 69 63 65 73 20 7b 5b $pos -indices {[
8680: 22 5d 7d 20 24 73 74 72 20 69 64 78 73 5d 0a 09 "]} $str idxs]..
8690: 09 69 66 20 7b 20 21 24 72 65 74 20 7d 20 7b 0a .if { !$ret } {.
86a0: 09 09 20 20 20 20 6c 61 70 70 65 6e 64 20 73 74 .. lappend st
86b0: 72 4c 69 73 74 20 22 5c 22 5b 73 74 72 69 6e 67 rList "\"[string
86c0: 20 72 61 6e 67 65 20 24 73 74 72 20 24 70 6f 73 range $str $pos
86d0: 20 65 6e 64 5d 5c 22 22 0a 09 09 20 20 20 20 62 end]\""... b
86e0: 72 65 61 6b 0a 09 09 7d 0a 09 09 73 65 74 20 69 reak...}...set i
86f0: 64 78 20 5b 6c 69 6e 64 65 78 20 24 69 64 78 73 dx [lindex $idxs
8700: 20 30 5d 0a 09 09 6c 61 70 70 65 6e 64 20 73 74 0]...lappend st
8710: 72 4c 69 73 74 20 22 5c 22 5b 73 74 72 69 6e 67 rList "\"[string
8720: 20 72 61 6e 67 65 20 24 73 74 72 20 24 70 6f 73 range $str $pos
8730: 20 5b 65 78 70 72 20 7b 24 69 64 78 2d 31 7d 5d [expr {$idx-1}]
8740: 5d 5c 22 22 0a 09 09 73 65 74 20 74 79 70 65 20 ]\""...set type
8750: 71 75 6f 74 65 0a 09 09 73 65 74 20 70 6f 73 20 quote...set pos
8760: 24 69 64 78 0a 09 20 20 20 20 7d 0a 09 20 20 20 $idx.. }..
8770: 20 71 75 6f 74 65 20 7b 0a 09 09 73 65 74 20 72 quote {...set r
8780: 65 74 20 5b 72 65 67 65 78 70 20 2d 73 74 61 72 et [regexp -star
8790: 74 20 24 70 6f 73 20 2d 69 6e 64 69 63 65 73 20 t $pos -indices
87a0: 7b 5b 27 5d 7d 20 24 73 74 72 20 69 64 78 73 5d {[']} $str idxs]
87b0: 0a 09 09 69 66 20 7b 20 21 24 72 65 74 20 7d 20 ...if { !$ret }
87c0: 7b 0a 09 09 20 20 20 20 6c 61 70 70 65 6e 64 20 {... lappend
87d0: 73 74 72 4c 69 73 74 20 22 27 5b 73 74 72 69 6e strList "'[strin
87e0: 67 20 72 61 6e 67 65 20 24 73 74 72 20 24 70 6f g range $str $po
87f0: 73 20 65 6e 64 5d 27 22 0a 09 09 20 20 20 20 62 s end]'"... b
8800: 72 65 61 6b 0a 09 09 7d 0a 09 09 73 65 74 20 69 reak...}...set i
8810: 64 78 20 5b 6c 69 6e 64 65 78 20 24 69 64 78 73 dx [lindex $idxs
8820: 20 30 5d 0a 09 09 6c 61 70 70 65 6e 64 20 73 74 0]...lappend st
8830: 72 4c 69 73 74 20 22 27 5b 73 74 72 69 6e 67 20 rList "'[string
8840: 72 61 6e 67 65 20 24 73 74 72 20 24 70 6f 73 20 range $str $pos
8850: 5b 65 78 70 72 20 7b 24 69 64 78 2d 31 7d 5d 5d [expr {$idx-1}]]
8860: 27 22 0a 09 09 73 65 74 20 74 79 70 65 20 61 70 '"...set type ap
8870: 6f 73 74 72 6f 70 68 65 0a 09 09 73 65 74 20 70 ostrophe...set p
8880: 6f 73 20 24 69 64 78 0a 09 20 20 20 20 7d 0a 09 os $idx.. }..
8890: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b }. }. if {
88a0: 20 5b 6c 6c 65 6e 67 74 68 20 24 73 74 72 4c 69 [llength $strLi
88b0: 73 74 5d 20 3e 20 31 20 7d 20 7b 0a 09 72 65 74 st] > 1 } {..ret
88c0: 75 72 6e 20 22 63 6f 6e 63 61 74 28 5b 6a 6f 69 urn "concat([joi
88d0: 6e 20 24 73 74 72 4c 69 73 74 20 2c 5d 29 22 0a n $strList ,])".
88e0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 72 65 } else {..re
88f0: 74 75 72 6e 20 5b 6c 69 6e 64 65 78 20 24 73 74 turn [lindex $st
8900: 72 4c 69 73 74 20 30 5d 0a 20 20 20 20 7d 0a 7d rList 0]. }.}
8910: 0a 0a 70 72 6f 63 20 66 6f 72 6d 61 74 5f 78 70 ..proc format_xp
8920: 61 74 68 20 7b 20 73 74 72 69 6e 67 20 61 72 67 ath { string arg
8930: 73 20 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 6d s } {. set cm
8940: 64 20 5b 6c 69 73 74 20 66 6f 72 6d 61 74 20 24 d [list format $
8950: 73 74 72 69 6e 67 5d 0a 20 20 20 20 66 6f 72 65 string]. fore
8960: 61 63 68 20 69 20 24 61 72 67 73 20 7b 0a 09 6c ach i $args {..l
8970: 61 70 70 65 6e 64 20 63 6d 64 20 5b 78 70 61 74 append cmd [xpat
8980: 68 5f 73 74 72 20 24 69 5d 0a 20 20 20 20 7d 0a h_str $i]. }.
8990: 20 20 20 20 72 65 74 75 72 6e 20 5b 65 76 61 6c return [eval
89a0: 20 24 63 6d 64 5d 0a 7d 0a 0a 6e 61 6d 65 73 70 $cmd].}..namesp
89b0: 61 63 65 20 65 76 61 6c 20 3a 3a 64 6f 6d 3a 3a ace eval ::dom::
89c0: 64 6f 6d 4e 6f 64 65 20 7b 7d 0a 0a 23 20 61 72 domNode {}..# ar
89d0: 67 73 20 63 61 6e 20 62 65 20 6f 6e 65 20 6f 72 gs can be one or
89e0: 20 6d 6f 72 65 20 74 61 67 73 0a 70 72 6f 63 20 more tags.proc
89f0: 3a 3a 64 6f 6d 3a 3a 64 6f 6d 4e 6f 64 65 3a 3a ::dom::domNode::
8a00: 61 70 70 65 6e 64 43 68 69 6c 64 54 61 67 20 7b appendChildTag {
8a10: 20 6e 6f 64 65 20 61 72 67 73 20 7d 20 7b 0a 20 node args } {.
8a20: 20 20 20 69 66 20 7b 20 5b 3a 3a 6c 6c 65 6e 67 if { [::lleng
8a30: 74 68 20 24 61 72 67 73 5d 20 3d 3d 20 30 20 7d th $args] == 0 }
8a40: 20 7b 0a 09 65 72 72 6f 72 20 22 65 72 72 6f 72 {..error "error
8a50: 20 69 6e 20 61 70 70 65 6e 64 43 68 69 6c 64 54 in appendChildT
8a60: 61 67 2e 20 41 74 20 6c 69 73 74 20 6f 6e 65 20 ag. At list one
8a70: 74 61 67 22 0a 20 20 20 20 7d 0a 20 20 20 20 3a tag". }. :
8a80: 3a 73 65 74 20 64 6f 63 20 5b 24 6e 6f 64 65 20 :set doc [$node
8a90: 6f 77 6e 65 72 44 6f 63 75 6d 65 6e 74 5d 0a 20 ownerDocument].
8aa0: 20 20 20 66 6f 72 65 61 63 68 20 74 61 67 20 24 foreach tag $
8ab0: 61 72 67 73 20 7b 0a 09 69 66 20 7b 20 5b 73 74 args {..if { [st
8ac0: 72 69 6e 67 20 6d 61 74 63 68 20 22 74 65 78 74 ring match "text
8ad0: 28 29 20 2a 22 20 24 74 61 67 5d 20 7d 20 7b 0a () *" $tag] } {.
8ae0: 09 20 20 20 20 3a 3a 73 65 74 20 6e 65 77 6e 6f . ::set newno
8af0: 64 65 20 5b 24 64 6f 63 20 63 72 65 61 74 65 54 de [$doc createT
8b00: 65 78 74 4e 6f 64 65 20 5b 6c 69 6e 64 65 78 20 extNode [lindex
8b10: 24 74 61 67 20 31 5d 5d 0a 09 20 20 20 20 24 6e $tag 1]].. $n
8b20: 6f 64 65 20 61 70 70 65 6e 64 43 68 69 6c 64 20 ode appendChild
8b30: 24 6e 65 77 6e 6f 64 65 0a 09 20 20 20 20 3a 3a $newnode.. ::
8b40: 73 65 74 20 6e 6f 64 65 20 24 6e 65 77 6e 6f 64 set node $newnod
8b50: 65 0a 09 7d 20 65 6c 73 65 69 66 20 7b 20 5b 73 e..} elseif { [s
8b60: 74 72 69 6e 67 20 6d 61 74 63 68 20 22 61 74 74 tring match "att
8b70: 72 69 62 75 74 65 73 28 29 20 2a 22 20 24 74 61 ributes() *" $ta
8b80: 67 5d 20 7d 20 7b 0a 09 20 20 20 20 66 6f 72 65 g] } {.. fore
8b90: 61 63 68 20 22 6e 20 76 22 20 5b 6c 72 61 6e 67 ach "n v" [lrang
8ba0: 65 20 24 74 61 67 20 31 20 65 6e 64 5d 20 7b 0a e $tag 1 end] {.
8bb0: 09 09 24 6e 6f 64 65 20 73 65 74 41 74 74 72 69 ..$node setAttri
8bc0: 62 75 74 65 20 24 6e 20 24 76 0a 09 20 20 20 20 bute $n $v..
8bd0: 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 }..} else {..
8be0: 20 3a 3a 73 65 74 20 6e 65 77 6e 6f 64 65 20 5b ::set newnode [
8bf0: 24 64 6f 63 20 63 72 65 61 74 65 45 6c 65 6d 65 $doc createEleme
8c00: 6e 74 20 24 74 61 67 5d 0a 09 20 20 20 20 24 6e nt $tag].. $n
8c10: 6f 64 65 20 61 70 70 65 6e 64 43 68 69 6c 64 20 ode appendChild
8c20: 24 6e 65 77 6e 6f 64 65 0a 09 20 20 20 20 3a 3a $newnode.. ::
8c30: 73 65 74 20 6e 6f 64 65 20 24 6e 65 77 6e 6f 64 set node $newnod
8c40: 65 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 72 e..}. }. r
8c50: 65 74 75 72 6e 20 24 6e 65 77 6e 6f 64 65 0a 7d eturn $newnode.}
8c60: 0a 0a 70 72 6f 63 20 3a 3a 64 6f 6d 3a 3a 64 6f ..proc ::dom::do
8c70: 6d 4e 6f 64 65 3a 3a 61 70 70 65 6e 64 43 68 69 mNode::appendChi
8c80: 6c 64 54 65 78 74 20 7b 20 6e 6f 64 65 20 74 65 ldText { node te
8c90: 78 74 20 7d 20 7b 0a 20 20 20 20 3a 3a 73 65 74 xt } {. ::set
8ca0: 20 64 6f 63 20 5b 24 6e 6f 64 65 20 6f 77 6e 65 doc [$node owne
8cb0: 72 44 6f 63 75 6d 65 6e 74 5d 0a 20 20 20 20 66 rDocument]. f
8cc0: 6f 72 65 61 63 68 20 63 68 69 6c 64 20 5b 24 6e oreach child [$n
8cd0: 6f 64 65 20 73 65 6c 65 63 74 4e 6f 64 65 73 20 ode selectNodes
8ce0: 74 65 78 74 28 29 5d 20 7b 20 24 63 68 69 6c 64 text()] { $child
8cf0: 20 64 65 6c 65 74 65 20 7d 0a 20 20 20 20 3a 3a delete }. ::
8d00: 73 65 74 20 6e 65 77 6e 6f 64 65 20 5b 24 64 6f set newnode [$do
8d10: 63 20 63 72 65 61 74 65 54 65 78 74 4e 6f 64 65 c createTextNode
8d20: 20 24 74 65 78 74 5d 0a 20 20 20 20 24 6e 6f 64 $text]. $nod
8d30: 65 20 61 70 70 65 6e 64 43 68 69 6c 64 20 24 6e e appendChild $n
8d40: 65 77 6e 6f 64 65 0a 20 20 20 20 72 65 74 75 72 ewnode. retur
8d50: 6e 20 24 6e 65 77 6e 6f 64 65 0a 7d 0a 0a 70 72 n $newnode.}..pr
8d60: 6f 63 20 64 69 63 74 5f 67 65 74 64 20 7b 20 61 oc dict_getd { a
8d70: 72 67 73 20 7d 20 7b 0a 20 20 20 20 0a 20 20 20 rgs } {. .
8d80: 20 73 65 74 20 64 69 63 74 69 6f 6e 61 72 79 56 set dictionaryV
8d90: 61 6c 75 65 20 5b 6c 69 6e 64 65 78 20 24 61 72 alue [lindex $ar
8da0: 67 73 20 30 5d 0a 20 20 20 20 73 65 74 20 6b 65 gs 0]. set ke
8db0: 79 73 20 5b 6c 72 61 6e 67 65 20 24 61 72 67 73 ys [lrange $args
8dc0: 20 31 20 65 6e 64 2d 31 5d 0a 20 20 20 20 73 65 1 end-1]. se
8dd0: 74 20 64 65 66 61 75 6c 74 20 5b 6c 69 6e 64 65 t default [linde
8de0: 78 20 24 61 72 67 73 20 65 6e 64 5d 0a 20 20 20 x $args end].
8df0: 20 69 66 20 7b 20 5b 64 69 63 74 20 65 78 69 73 if { [dict exis
8e00: 74 73 20 24 64 69 63 74 69 6f 6e 61 72 79 56 61 ts $dictionaryVa
8e10: 6c 75 65 20 7b 2a 7d 24 6b 65 79 73 5d 20 7d 20 lue {*}$keys] }
8e20: 7b 0a 09 72 65 74 75 72 6e 20 5b 64 69 63 74 20 {..return [dict
8e30: 67 65 74 20 24 64 69 63 74 69 6f 6e 61 72 79 56 get $dictionaryV
8e40: 61 6c 75 65 20 7b 2a 7d 24 6b 65 79 73 5d 0a 20 alue {*}$keys].
8e50: 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 6e 20 }. return
8e60: 24 64 65 66 61 75 6c 74 0a 7d 0a 0a 70 72 6f 63 $default.}..proc
8e70: 20 6c 69 6e 73 65 72 74 30 20 7b 20 61 72 67 73 linsert0 { args
8e80: 20 7d 20 7b 0a 20 20 20 20 73 65 74 20 6f 70 74 } {. set opt
8e90: 69 6f 6e 61 6c 20 7b 0a 09 7b 20 2d 6d 61 78 5f ional {..{ -max_
8ea0: 6c 65 6e 20 6c 65 6e 20 22 22 20 7d 0a 09 7b 20 len len "" }..{
8eb0: 2d 72 65 6d 6f 76 65 5f 70 72 65 66 69 78 65 73 -remove_prefixes
8ec0: 20 22 22 20 30 20 7d 0a 20 20 20 20 7d 0a 20 20 "" 0 }. }.
8ed0: 20 20 73 65 74 20 63 6f 6d 70 75 6c 73 6f 72 79 set compulsory
8ee0: 20 22 6c 69 73 74 20 65 6c 65 6d 65 6e 74 22 0a "list element".
8ef0: 20 20 20 20 70 61 72 73 65 5f 61 72 67 73 20 24 parse_args $
8f00: 6f 70 74 69 6f 6e 61 6c 20 24 63 6f 6d 70 75 6c optional $compul
8f10: 73 6f 72 79 20 24 61 72 67 73 0a 0a 20 20 20 20 sory $args..
8f20: 73 65 74 20 69 70 6f 73 20 5b 6c 73 65 61 72 63 set ipos [lsearc
8f30: 68 20 2d 65 78 61 63 74 20 24 6c 69 73 74 20 24 h -exact $list $
8f40: 65 6c 65 6d 65 6e 74 5d 0a 20 20 20 20 69 66 20 element]. if
8f50: 7b 20 24 69 70 6f 73 20 21 3d 20 2d 31 20 7d 20 { $ipos != -1 }
8f60: 7b 0a 09 73 65 74 20 6c 69 73 74 20 5b 6c 72 65 {..set list [lre
8f70: 70 6c 61 63 65 20 24 6c 69 73 74 20 24 69 70 6f place $list $ipo
8f80: 73 20 24 69 70 6f 73 5d 0a 20 20 20 20 7d 0a 20 s $ipos]. }.
8f90: 20 20 20 69 66 20 7b 20 24 72 65 6d 6f 76 65 5f if { $remove_
8fa0: 70 72 65 66 69 78 65 73 20 7d 20 7b 0a 09 66 6f prefixes } {..fo
8fb0: 72 20 7b 20 73 65 74 20 69 20 30 20 7d 20 7b 20 r { set i 0 } {
8fc0: 24 69 20 3c 20 5b 6c 6c 65 6e 67 74 68 20 24 6c $i < [llength $l
8fd0: 69 73 74 5d 20 7d 20 7b 20 69 6e 63 72 20 69 20 ist] } { incr i
8fe0: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 5b 73 } {.. if { [s
8ff0: 74 72 69 6e 67 20 6d 61 74 63 68 20 22 5b 6c 69 tring match "[li
9000: 6e 64 65 78 20 24 6c 69 73 74 20 24 69 5d 2a 22 ndex $list $i]*"
9010: 20 24 65 6c 65 6d 65 6e 74 5d 20 7d 20 7b 0a 09 $element] } {..
9020: 09 73 65 74 20 6c 69 73 74 20 5b 6c 72 65 70 6c .set list [lrepl
9030: 61 63 65 20 24 6c 69 73 74 20 24 69 20 24 69 5d ace $list $i $i]
9040: 0a 09 09 69 6e 63 72 20 69 20 2d 31 0a 09 20 20 ...incr i -1..
9050: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 }..}. }.
9060: 20 73 65 74 20 6c 69 73 74 20 5b 6c 69 6e 73 65 set list [linse
9070: 72 74 20 24 6c 69 73 74 20 30 20 24 65 6c 65 6d rt $list 0 $elem
9080: 65 6e 74 5d 0a 20 20 20 20 69 66 20 7b 20 24 6d ent]. if { $m
9090: 61 78 5f 6c 65 6e 20 6e 65 20 22 22 20 7d 20 7b ax_len ne "" } {
90a0: 0a 09 73 65 74 20 6c 69 73 74 20 5b 6c 72 61 6e ..set list [lran
90b0: 67 65 20 24 6c 69 73 74 20 30 20 24 6d 61 78 5f ge $list 0 $max_
90c0: 6c 65 6e 2d 31 5d 0a 20 20 20 20 7d 0a 20 20 20 len-1]. }.
90d0: 20 72 65 74 75 72 6e 20 24 6c 69 73 74 0a 7d 0a return $list.}.
90e0: 0a 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 .###############
90f0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
9100: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
9110: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
9120: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
9130: 23 0a 23 20 20 20 20 20 63 75 3a 3a 66 69 6c 65 #.# cu::file
9140: 3a 3a 65 78 65 63 75 74 65 2c 20 63 75 3a 3a 6b ::execute, cu::k
9150: 69 6c 6c 20 61 6e 64 20 63 75 3a 3a 70 73 0a 23 ill and cu::ps.#
9160: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
9170: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
9180: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
9190: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
91a0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 0a ###############.
91b0: 0a 70 72 6f 63 20 63 75 3a 3a 6b 69 6c 6c 20 7b .proc cu::kill {
91c0: 20 70 69 64 20 7d 20 7b 0a 0a 20 20 20 20 69 66 pid } {.. if
91d0: 20 7b 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 6f { $::tcl_platfo
91e0: 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 65 71 20 rm(platform) eq
91f0: 22 77 69 6e 64 6f 77 73 22 20 7d 20 7b 0a 09 70 "windows" } {..p
9200: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 63 ackage require c
9210: 6f 6d 70 61 73 73 5f 75 74 69 6c 73 3a 3a 63 0a ompass_utils::c.
9220: 09 72 65 74 75 72 6e 20 5b 63 75 3a 3a 5f 6b 69 .return [cu::_ki
9230: 6c 6c 5f 77 69 6e 20 24 70 69 64 5d 0a 20 20 20 ll_win $pid].
9240: 20 7d 20 65 6c 73 65 20 7b 0a 09 65 78 65 63 20 } else {..exec
9250: 6b 69 6c 6c 20 24 70 69 64 20 0a 20 20 20 20 7d kill $pid . }
9260: 0a 7d 0a 0a 70 72 6f 63 20 63 75 3a 3a 70 73 20 .}..proc cu::ps
9270: 7b 20 61 72 67 73 20 7d 20 7b 0a 0a 20 20 20 20 { args } {..
9280: 69 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 if { $::tcl_plat
9290: 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 65 form(platform) e
92a0: 71 20 22 77 69 6e 64 6f 77 73 22 20 7d 20 7b 0a q "windows" } {.
92b0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
92c0: 20 63 6f 6d 70 61 73 73 5f 75 74 69 6c 73 3a 3a compass_utils::
92d0: 63 0a 09 73 65 74 20 70 73 5f 61 72 67 73 20 22 c..set ps_args "
92e0: 22 0a 09 66 6f 72 65 61 63 68 20 69 20 24 61 72 "..foreach i $ar
92f0: 67 73 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 24 gs {.. if { $
9300: 69 20 65 71 20 22 22 20 7d 20 7b 20 63 6f 6e 74 i eq "" } { cont
9310: 69 6e 75 65 20 7d 0a 09 20 20 20 20 69 66 20 7b inue }.. if {
9320: 20 21 5b 73 74 72 69 6e 67 20 69 73 20 69 6e 74 ![string is int
9330: 65 67 65 72 20 2d 73 74 72 69 63 74 20 24 69 5d eger -strict $i]
9340: 20 7d 20 7b 0a 09 09 69 66 20 7b 20 21 5b 72 65 } {...if { ![re
9350: 67 65 78 70 20 7b 5e 5c 2a 7d 20 24 69 5d 20 7d gexp {^\*} $i] }
9360: 20 7b 0a 09 09 20 20 20 20 73 65 74 20 69 20 22 {... set i "
9370: 2a 24 69 22 0a 09 09 7d 0a 09 09 69 66 20 7b 20 *$i"...}...if {
9380: 21 5b 72 65 67 65 78 70 20 7b 5c 2a 24 7d 20 24 ![regexp {\*$} $
9390: 69 5d 20 7d 20 7b 0a 09 09 20 20 20 20 73 65 74 i] } {... set
93a0: 20 69 20 22 24 69 2a 22 0a 09 09 7d 0a 09 20 20 i "$i*"...}..
93b0: 20 20 7d 0a 09 20 20 20 20 6c 61 70 70 65 6e 64 }.. lappend
93c0: 20 70 73 5f 61 72 67 73 20 24 69 0a 09 7d 0a 09 ps_args $i..}..
93d0: 73 65 74 20 72 65 74 20 5b 63 75 3a 3a 5f 70 73 set ret [cu::_ps
93e0: 5f 77 69 6e 20 7b 2a 7d 24 70 73 5f 61 72 67 73 _win {*}$ps_args
93f0: 5d 0a 09 63 61 74 63 68 20 7b 20 70 61 63 6b 61 ]..catch { packa
9400: 67 65 20 72 65 71 75 69 72 65 20 74 77 61 70 69 ge require twapi
9410: 20 7d 0a 09 73 65 74 20 72 65 74 72 65 74 20 22 }..set retret "
9420: 22 0a 09 66 6f 72 65 61 63 68 20 69 20 24 72 65 "..foreach i $re
9430: 74 20 7b 0a 09 20 20 20 20 6c 61 73 73 69 67 6e t {.. lassign
9440: 20 24 69 20 63 6d 64 20 70 69 64 0a 09 20 20 20 $i cmd pid..
9450: 20 69 66 20 7b 20 5b 69 6e 66 6f 20 63 6f 6d 6d if { [info comm
9460: 61 6e 64 20 3a 3a 74 77 61 70 69 3a 3a 67 65 74 and ::twapi::get
9470: 5f 70 72 6f 63 65 73 73 5f 69 6e 66 6f 5d 20 6e _process_info] n
9480: 65 20 22 22 20 7d 20 7b 0a 09 09 73 65 74 20 64 e "" } {...set d
9490: 20 5b 74 77 61 70 69 3a 3a 67 65 74 5f 70 72 6f [twapi::get_pro
94a0: 63 65 73 73 5f 69 6e 66 6f 20 24 70 69 64 20 2d cess_info $pid -
94b0: 63 72 65 61 74 65 74 69 6d 65 20 2d 70 72 69 76 createtime -priv
94c0: 69 6c 65 67 65 64 74 69 6d 65 20 2d 77 6f 72 6b ilegedtime -work
94d0: 69 6e 67 73 65 74 5d 0a 09 09 69 66 20 7b 20 5b ingset]...if { [
94e0: 73 74 72 69 6e 67 20 69 73 20 64 69 67 69 74 20 string is digit
94f0: 2d 73 74 72 69 63 74 20 5b 64 69 63 74 20 67 65 -strict [dict ge
9500: 74 20 24 64 20 2d 63 72 65 61 74 65 74 69 6d 65 t $d -createtime
9510: 5d 5d 20 7d 20 7b 0a 09 09 20 20 20 20 73 65 74 ]] } {... set
9520: 20 73 74 61 72 74 20 5b 63 6c 6f 63 6b 20 66 6f start [clock fo
9530: 72 6d 61 74 20 5b 74 77 61 70 69 3a 3a 6c 61 72 rmat [twapi::lar
9540: 67 65 5f 73 79 73 74 65 6d 5f 74 69 6d 65 5f 74 ge_system_time_t
9550: 6f 5f 73 65 63 73 20 5b 64 69 63 74 20 67 65 74 o_secs [dict get
9560: 20 24 64 20 2d 63 72 65 61 74 65 74 69 6d 65 5d $d -createtime]
9570: 5d 20 5c 0a 09 09 20 20 20 20 20 20 20 20 20 20 ] \...
9580: 20 20 2d 66 6f 72 6d 61 74 20 22 25 48 3a 25 4d -format "%H:%M
9590: 3a 25 53 22 5d 0a 09 09 20 20 20 20 73 65 74 20 :%S"]... set
95a0: 63 70 75 74 69 6d 65 20 5b 63 6c 6f 63 6b 20 66 cputime [clock f
95b0: 6f 72 6d 61 74 20 5b 74 77 61 70 69 3a 3a 6c 61 ormat [twapi::la
95c0: 72 67 65 5f 73 79 73 74 65 6d 5f 74 69 6d 65 5f rge_system_time_
95d0: 74 6f 5f 73 65 63 73 20 5c 0a 09 09 20 20 20 20 to_secs \...
95e0: 20 20 20 20 20 20 20 20 20 20 20 20 5b 64 69 63 [dic
95f0: 74 20 67 65 74 20 24 64 20 2d 70 72 69 76 69 6c t get $d -privil
9600: 65 67 65 64 74 69 6d 65 5d 5d 20 2d 66 6f 72 6d egedtime]] -form
9610: 61 74 20 22 25 48 3a 25 4d 3a 25 53 22 20 2d 74 at "%H:%M:%S" -t
9620: 69 6d 65 7a 6f 6e 65 20 3a 55 54 43 5d 0a 09 09 imezone :UTC]...
9630: 20 20 20 20 73 65 74 20 73 69 7a 65 20 5b 65 78 set size [ex
9640: 70 72 20 7b 5b 64 69 63 74 20 67 65 74 20 24 64 pr {[dict get $d
9650: 20 2d 77 6f 72 6b 69 6e 67 73 65 74 5d 2f 31 30 -workingset]/10
9660: 32 34 7d 5d 0a 09 09 20 20 20 20 73 65 74 20 69 24}]... set i
9670: 20 5b 6c 69 73 74 20 24 63 6d 64 20 24 70 69 64 [list $cmd $pid
9680: 20 24 73 74 61 72 74 20 24 63 70 75 74 69 6d 65 $start $cputime
9690: 20 24 73 69 7a 65 5d 0a 09 09 7d 0a 09 20 20 20 $size]...}..
96a0: 20 7d 0a 09 20 20 20 20 6c 61 70 70 65 6e 64 20 }.. lappend
96b0: 72 65 74 72 65 74 20 24 69 0a 09 7d 0a 09 72 65 retret $i..}..re
96c0: 74 75 72 6e 20 24 72 65 74 72 65 74 0a 20 20 20 turn $retret.
96d0: 20 7d 20 65 6c 73 65 20 7b 0a 09 23 20 64 6f 65 } else {..# doe
96e0: 73 20 6e 6f 74 20 64 6f 20 65 78 61 63 74 6c 79 s not do exactly
96f0: 20 74 68 65 20 73 61 6d 65 20 74 68 61 6e 20 69 the same than i
9700: 6e 20 57 69 6e 64 6f 77 73 0a 09 23 73 65 74 20 n Windows..#set
9710: 65 72 72 20 5b 63 61 74 63 68 20 7b 20 65 78 65 err [catch { exe
9720: 63 20 70 67 72 65 70 20 2d 6c 20 2d 66 20 5b 6c c pgrep -l -f [l
9730: 69 6e 64 65 78 20 24 61 72 67 73 20 30 5d 20 7d index $args 0] }
9740: 20 72 65 74 5d 0a 09 23 73 65 74 20 72 65 74 4c ret]..#set retL
9750: 69 73 74 20 20 5b 73 70 6c 69 74 20 24 72 65 74 ist [split $ret
9760: 20 5c 6e 5d 0a 09 6c 61 73 73 69 67 6e 20 24 61 \n]..lassign $a
9770: 72 67 73 20 70 61 74 74 65 72 6e 0a 09 69 66 20 rgs pattern..if
9780: 7b 20 24 70 61 74 74 65 72 6e 20 65 71 20 22 22 { $pattern eq ""
9790: 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 65 72 } {.. set er
97a0: 72 20 5b 63 61 74 63 68 20 7b 20 65 78 65 63 20 r [catch { exec
97b0: 70 73 20 2d 75 20 24 3a 3a 65 6e 76 28 55 53 45 ps -u $::env(USE
97c0: 52 29 20 2d 2d 6e 6f 2d 68 65 61 64 65 72 73 20 R) --no-headers
97d0: 2d 6f 20 70 69 64 2c 73 74 61 72 74 2c 74 69 6d -o pid,start,tim
97e0: 65 2c 70 63 70 75 2c 73 69 7a 65 2c 63 6d 64 20 e,pcpu,size,cmd
97f0: 7d 20 72 65 74 5d 0a 09 7d 20 65 6c 73 65 69 66 } ret]..} elseif
9800: 20 7b 20 5b 73 74 72 69 6e 67 20 69 73 20 69 6e { [string is in
9810: 74 65 67 65 72 20 2d 73 74 72 69 63 74 20 24 70 teger -strict $p
9820: 61 74 74 65 72 6e 5d 20 7d 20 7b 0a 09 20 20 20 attern] } {..
9830: 20 73 65 74 20 65 72 72 20 5b 63 61 74 63 68 20 set err [catch
9840: 7b 20 65 78 65 63 20 70 73 20 2d 2d 70 69 64 20 { exec ps --pid
9850: 24 70 61 74 74 65 72 6e 20 2d 2d 6e 6f 2d 68 65 $pattern --no-he
9860: 61 64 65 72 73 20 2d 6f 20 70 69 64 2c 73 74 61 aders -o pid,sta
9870: 72 74 2c 74 69 6d 65 2c 70 63 70 75 2c 73 69 7a rt,time,pcpu,siz
9880: 65 2c 63 6d 64 20 7d 20 72 65 74 5d 0a 09 7d 20 e,cmd } ret]..}
9890: 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 else {.. set
98a0: 65 72 72 20 5b 63 61 74 63 68 20 7b 20 65 78 65 err [catch { exe
98b0: 63 20 70 73 20 2d 75 20 24 3a 3a 65 6e 76 28 55 c ps -u $::env(U
98c0: 53 45 52 29 20 2d 2d 6e 6f 2d 68 65 61 64 65 72 SER) --no-header
98d0: 73 20 2d 6f 20 70 69 64 2c 73 74 61 72 74 2c 74 s -o pid,start,t
98e0: 69 6d 65 2c 70 63 70 75 2c 73 69 7a 65 2c 63 6d ime,pcpu,size,cm
98f0: 64 20 7c 20 67 72 65 70 20 2d 69 20 24 70 61 74 d | grep -i $pat
9900: 74 65 72 6e 20 7d 20 72 65 74 5d 0a 09 7d 20 20 tern } ret]..}
9910: 20 20 20 20 20 20 0a 09 69 66 20 7b 20 24 65 72 ..if { $er
9920: 72 20 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 r } {.. retur
9930: 6e 20 22 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 n ""..} else {..
9940: 20 20 20 20 73 65 74 20 72 65 74 4c 69 73 74 20 set retList
9950: 22 22 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 "".. foreach
9960: 6c 69 6e 65 20 5b 73 70 6c 69 74 20 24 72 65 74 line [split $ret
9970: 20 5c 6e 5d 20 7b 0a 09 09 72 65 67 65 78 70 20 \n] {...regexp
9980: 7b 28 5c 53 2b 29 5c 73 2b 28 5c 53 2b 29 5c 73 {(\S+)\s+(\S+)\s
9990: 2b 28 5c 53 2b 29 5c 73 2b 28 5c 53 2b 29 5c 73 +(\S+)\s+(\S+)\s
99a0: 2b 28 5c 53 2b 29 5c 73 2b 28 2e 2a 29 7d 20 24 +(\S+)\s+(.*)} $
99b0: 6c 69 6e 65 20 7b 7d 20 70 69 64 20 73 74 61 72 line {} pid star
99c0: 74 20 63 70 75 74 69 6d 65 20 5c 0a 09 09 20 20 t cputime \...
99d0: 20 20 70 63 70 75 20 73 69 7a 65 20 63 6d 64 0a pcpu size cmd.
99e0: 09 09 63 61 74 63 68 20 7b 20 66 6f 72 6d 61 74 ..catch { format
99f0: 20 22 25 30 32 2e 30 66 25 25 22 20 24 70 63 70 "%02.0f%%" $pcp
9a00: 75 20 7d 20 70 63 70 75 0a 09 09 69 66 20 7b 20 u } pcpu...if {
9a10: 24 70 61 74 74 65 72 6e 20 6e 65 20 22 22 20 26 $pattern ne "" &
9a20: 26 20 24 63 6d 64 20 65 71 20 22 67 72 65 70 20 & $cmd eq "grep
9a30: 2d 69 20 24 70 61 74 74 65 72 6e 22 20 7d 20 7b -i $pattern" } {
9a40: 20 63 6f 6e 74 69 6e 75 65 20 7d 0a 0a 09 09 73 continue }....s
9a50: 65 74 20 65 72 72 20 5b 63 61 74 63 68 20 7b 20 et err [catch {
9a60: 63 6c 6f 63 6b 20 73 63 61 6e 20 24 73 74 61 72 clock scan $star
9a70: 74 20 2d 66 6f 72 6d 61 74 20 22 25 48 3a 25 4d t -format "%H:%M
9a80: 3a 25 53 22 20 7d 20 73 65 63 73 5d 0a 09 09 69 :%S" } secs]...i
9a90: 66 20 7b 20 24 65 72 72 20 7d 20 7b 0a 09 09 20 f { $err } {...
9aa0: 20 20 20 73 65 74 20 73 65 63 73 20 5b 63 6c 6f set secs [clo
9ab0: 63 6b 20 73 63 61 6e 20 24 73 74 61 72 74 20 2d ck scan $start -
9ac0: 66 6f 72 6d 61 74 20 22 25 62 22 5d 0a 09 09 7d format "%b"]...}
9ad0: 0a 09 09 73 65 74 20 73 74 61 72 74 20 5b 63 6c ...set start [cl
9ae0: 6f 63 6b 20 66 6f 72 6d 61 74 20 24 73 65 63 73 ock format $secs
9af0: 20 2d 66 6f 72 6d 61 74 20 22 25 59 2d 25 6d 2d -format "%Y-%m-
9b00: 25 64 20 25 48 3a 25 4d 3a 25 53 22 5d 0a 09 09 %d %H:%M:%S"]...
9b10: 6c 61 70 70 65 6e 64 20 72 65 74 4c 69 73 74 20 lappend retList
9b20: 5b 6c 69 73 74 20 24 63 6d 64 20 24 70 69 64 20 [list $cmd $pid
9b30: 24 73 74 61 72 74 20 22 24 63 70 75 74 69 6d 65 $start "$cputime
9b40: 20 28 24 70 63 70 75 29 22 20 24 73 69 7a 65 5d ($pcpu)" $size]
9b50: 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 72 65 74 .. }.. ret
9b60: 75 72 6e 20 24 72 65 74 4c 69 73 74 0a 09 7d 0a urn $retList..}.
9b70: 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 63 75 }.}..proc cu
9b80: 3a 3a 66 69 6c 65 3a 3a 63 6f 72 72 65 63 74 5f ::file::correct_
9b90: 6e 61 6d 65 20 7b 20 66 69 6c 65 20 7d 20 7b 0a name { file } {.
9ba0: 20 20 20 20 69 66 20 7b 20 24 3a 3a 74 63 6c 5f if { $::tcl_
9bb0: 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 platform(platfor
9bc0: 6d 29 20 65 71 20 22 77 69 6e 64 6f 77 73 22 20 m) eq "windows"
9bd0: 7d 20 7b 0a 09 72 65 67 73 75 62 20 2d 61 6c 6c } {..regsub -all
9be0: 20 7b 5b 3a 2a 3f 22 22 3c 3e 7c 5d 7d 20 24 66 {[:*?""<>|]} $f
9bf0: 69 6c 65 20 7b 5f 7d 20 66 69 6c 65 0a 20 20 20 ile {_} file.
9c00: 20 7d 0a 20 20 20 20 72 65 74 75 72 6e 20 5b 73 }. return [s
9c10: 74 72 69 6e 67 20 74 72 69 6d 20 24 66 69 6c 65 tring trim $file
9c20: 5d 0a 7d 0a 0a 70 72 6f 63 20 63 75 3a 3a 66 69 ].}..proc cu::fi
9c30: 6c 65 3a 3a 65 78 65 63 75 74 65 20 7b 20 61 72 le::execute { ar
9c40: 67 73 20 7d 20 7b 0a 20 20 20 20 0a 20 20 20 20 gs } {. .
9c50: 73 65 74 20 6f 70 74 69 6f 6e 61 6c 20 7b 0a 09 set optional {..
9c60: 7b 20 2d 77 6f 72 6b 64 69 72 20 64 69 72 65 63 { -workdir direc
9c70: 74 6f 72 79 20 22 22 20 7d 0a 09 7b 20 2d 77 61 tory "" }..{ -wa
9c80: 69 74 20 62 6f 6f 6c 65 61 6e 20 30 20 7d 0a 09 it boolean 0 }..
9c90: 7b 20 2d 68 69 64 65 5f 77 69 6e 64 6f 77 20 62 { -hide_window b
9ca0: 6f 6f 6c 65 61 6e 20 30 20 7d 0a 20 20 20 20 7d oolean 0 }. }
9cb0: 0a 20 20 20 20 73 65 74 20 63 6f 6d 70 75 6c 73 . set compuls
9cc0: 6f 72 79 20 22 77 68 61 74 20 66 69 6c 65 22 0a ory "what file".
9cd0: 0a 20 20 20 20 73 65 74 20 61 72 67 73 20 5b 70 . set args [p
9ce0: 61 72 73 65 5f 61 72 67 73 20 2d 72 61 69 73 65 arse_args -raise
9cf0: 5f 63 6f 6d 70 75 6c 73 6f 72 79 5f 65 72 72 6f _compulsory_erro
9d00: 72 20 30 20 24 6f 70 74 69 6f 6e 61 6c 20 24 63 r 0 $optional $c
9d10: 6f 6d 70 75 6c 73 6f 72 79 20 24 61 72 67 73 5d ompulsory $args]
9d20: 0a 0a 20 20 20 20 73 77 69 74 63 68 20 2d 2d 20 .. switch --
9d30: 24 77 68 61 74 20 7b 0a 09 67 69 64 20 7b 0a 09 $what {..gid {..
9d40: 20 20 20 20 73 65 74 20 65 78 65 20 5b 67 65 74 set exe [get
9d50: 5f 65 78 65 63 75 74 61 62 6c 65 5f 70 61 74 68 _executable_path
9d60: 20 67 69 64 5d 0a 09 20 20 20 20 69 66 20 7b 20 gid].. if {
9d70: 24 65 78 65 20 65 71 20 22 22 20 7d 20 7b 20 72 $exe eq "" } { r
9d80: 65 74 75 72 6e 20 7d 0a 09 20 20 20 20 69 66 20 eturn }.. if
9d90: 7b 20 24 77 61 69 74 20 7c 7c 20 24 68 69 64 65 { $wait || $hide
9da0: 5f 77 69 6e 64 6f 77 20 7d 20 7b 0a 09 09 73 65 _window } {...se
9db0: 74 20 65 72 72 20 5b 63 61 74 63 68 20 7b 20 70 t err [catch { p
9dc0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
9dd0: 77 61 70 69 20 7d 5d 0a 09 09 69 66 20 7b 20 24 wapi }]...if { $
9de0: 65 72 72 20 7d 20 7b 20 73 65 74 20 68 61 73 5f err } { set has_
9df0: 74 77 61 70 69 20 30 20 7d 20 65 6c 73 65 20 7b twapi 0 } else {
9e00: 20 73 65 74 20 68 61 73 5f 74 77 61 70 69 20 31 set has_twapi 1
9e10: 20 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 }.. }.. i
9e20: 66 20 7b 20 21 24 77 61 69 74 20 7c 7c 20 24 68 f { !$wait || $h
9e30: 61 73 5f 74 77 61 70 69 20 7d 20 7b 20 6c 61 70 as_twapi } { lap
9e40: 70 65 6e 64 20 61 72 67 73 20 26 20 7d 0a 09 20 pend args & }..
9e50: 20 20 20 73 65 74 20 70 69 64 20 5b 65 78 65 63 set pid [exec
9e60: 20 24 65 78 65 20 24 66 69 6c 65 20 7b 2a 7d 24 $exe $file {*}$
9e70: 61 72 67 73 5d 0a 09 20 20 20 0a 09 20 20 20 20 args].. ..
9e80: 69 66 20 7b 20 21 24 77 61 69 74 20 26 26 20 21 if { !$wait && !
9e90: 24 68 69 64 65 5f 77 69 6e 64 6f 77 20 7d 20 7b $hide_window } {
9ea0: 20 72 65 74 75 72 6e 20 7d 0a 09 20 20 20 20 69 return }.. i
9eb0: 66 20 7b 20 21 24 68 61 73 5f 74 77 61 70 69 20 f { !$has_twapi
9ec0: 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a 0a 09 20 } { return }...
9ed0: 20 20 20 69 66 20 7b 20 24 68 69 64 65 5f 77 69 if { $hide_wi
9ee0: 6e 64 6f 77 20 7d 20 7b 0a 09 09 66 6f 72 65 61 ndow } {...forea
9ef0: 63 68 20 68 77 69 6e 20 5b 74 77 61 70 69 3a 3a ch hwin [twapi::
9f00: 66 69 6e 64 5f 77 69 6e 64 6f 77 73 20 2d 70 69 find_windows -pi
9f10: 64 73 20 24 70 69 64 20 2d 76 69 73 69 62 6c 65 ds $pid -visible
9f20: 20 74 72 75 65 5d 20 7b 0a 09 09 20 20 20 20 74 true] {... t
9f30: 77 61 70 69 3a 3a 68 69 64 65 5f 77 69 6e 64 6f wapi::hide_windo
9f40: 77 20 24 68 77 69 6e 0a 09 09 7d 0a 09 20 20 20 w $hwin...}..
9f50: 20 7d 0a 09 20 20 20 20 69 66 20 7b 20 24 77 61 }.. if { $wa
9f60: 69 74 20 7d 20 7b 0a 09 09 77 68 69 6c 65 20 7b it } {...while {
9f70: 20 5b 74 77 61 70 69 3a 3a 70 72 6f 63 65 73 73 [twapi::process
9f80: 5f 65 78 69 73 74 73 20 24 70 69 64 5d 20 7d 20 _exists $pid] }
9f90: 7b 0a 09 09 20 20 20 20 61 66 74 65 72 20 32 30 {... after 20
9fa0: 30 0a 09 09 7d 0a 09 20 20 20 20 7d 0a 09 7d 0a 0...}.. }..}.
9fb0: 09 65 6d 61 63 73 20 7b 0a 09 20 20 20 20 65 78 .emacs {.. ex
9fc0: 65 63 20 72 75 6e 65 6d 61 63 73 20 2d 67 20 31 ec runemacs -g 1
9fd0: 30 30 78 37 32 20 26 0a 09 7d 0a 09 77 69 73 68 00x72 &..}..wish
9fe0: 20 7b 0a 09 20 20 20 20 73 65 74 20 70 77 64 20 {.. set pwd
9ff0: 5b 70 77 64 5d 0a 09 20 20 20 20 63 64 20 5b 66 [pwd].. cd [f
a000: 69 6c 65 20 64 69 72 6e 61 6d 65 20 24 66 69 6c ile dirname $fil
a010: 65 5d 0a 09 20 20 20 20 65 76 61 6c 20 65 78 65 e].. eval exe
a020: 63 20 77 69 73 68 20 5b 6c 69 73 74 20 5b 66 69 c wish [list [fi
a030: 6c 65 20 6e 6f 72 6d 61 6c 69 7a 65 20 24 66 69 le normalize $fi
a040: 6c 65 5d 5d 20 24 61 72 67 73 20 26 0a 09 20 20 le]] $args &..
a050: 20 20 63 64 20 24 70 77 64 0a 09 7d 0a 09 74 6b cd $pwd..}..tk
a060: 64 69 66 66 20 7b 0a 09 20 20 20 20 73 65 74 20 diff {.. set
a070: 70 77 64 20 5b 70 77 64 5d 0a 09 20 20 20 20 63 pwd [pwd].. c
a080: 64 20 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 d [file dirname
a090: 24 66 69 6c 65 5d 0a 09 20 20 20 20 65 78 65 63 $file].. exec
a0a0: 20 77 69 73 68 20 7e 2f 6d 79 54 63 6c 54 6b 2f wish ~/myTclTk/
a0b0: 74 6b 63 76 73 2f 62 69 6e 2f 74 6b 64 69 66 66 tkcvs/bin/tkdiff
a0c0: 2e 74 63 6c 20 2d 72 20 5b 66 69 6c 65 20 74 61 .tcl -r [file ta
a0d0: 69 6c 20 24 66 69 6c 65 5d 20 26 0a 09 20 20 20 il $file] &..
a0e0: 20 63 64 20 24 70 77 64 0a 09 7d 0a 09 73 74 61 cd $pwd..}..sta
a0f0: 72 74 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 24 rt {.. if { $
a100: 3a 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 ::tcl_platform(p
a110: 6c 61 74 66 6f 72 6d 29 20 65 71 20 22 75 6e 69 latform) eq "uni
a120: 78 22 20 7d 20 7b 0a 09 09 73 65 74 20 70 72 6f x" } {...set pro
a130: 67 72 61 6d 73 20 5b 6c 69 73 74 20 78 64 67 2d grams [list xdg-
a140: 6f 70 65 6e 20 67 6e 6f 6d 65 2d 6f 70 65 6e 5d open gnome-open]
a150: 0a 09 09 69 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 ...if { $::tcl_p
a160: 6c 61 74 66 6f 72 6d 28 6f 73 29 20 65 71 20 22 latform(os) eq "
a170: 44 61 72 77 69 6e 22 20 7d 20 7b 0a 09 09 20 20 Darwin" } {...
a180: 20 20 73 65 74 20 70 72 6f 67 72 61 6d 73 20 5b set programs [
a190: 6c 69 6e 73 65 72 74 20 24 70 72 6f 67 72 61 6d linsert $program
a1a0: 73 20 30 20 6f 70 65 6e 5d 0a 09 09 7d 0a 09 09 s 0 open]...}...
a1b0: 66 6f 72 65 61 63 68 20 69 20 24 70 72 6f 67 72 foreach i $progr
a1c0: 61 6d 73 20 7b 0a 09 09 20 20 20 20 69 66 20 7b ams {... if {
a1d0: 20 5b 61 75 74 6f 5f 65 78 65 63 6f 6b 20 24 69 [auto_execok $i
a1e0: 5d 20 6e 65 20 22 22 20 7d 20 7b 0a 09 09 20 20 ] ne "" } {...
a1f0: 20 20 20 20 20 20 65 78 65 63 20 24 69 20 24 66 exec $i $f
a200: 69 6c 65 20 26 0a 09 09 20 20 20 20 20 20 20 20 ile &...
a210: 72 65 74 75 72 6e 0a 09 09 20 20 20 20 7d 0a 09 return... }..
a220: 09 7d 0a 09 09 65 72 72 6f 72 20 22 63 6f 75 6c .}...error "coul
a230: 64 20 6e 6f 74 20 6f 70 65 6e 20 66 69 6c 65 20 d not open file
a240: 27 24 66 69 6c 65 27 22 0a 09 20 20 20 20 7d 20 '$file'".. }
a250: 65 6c 73 65 69 66 20 7b 20 5b 72 65 67 65 78 70 elseif { [regexp
a260: 20 7b 5b 26 5d 7d 20 24 66 69 6c 65 5d 20 7d 20 {[&]} $file] }
a270: 7b 0a 09 09 73 65 74 20 62 61 74 20 5b 66 69 6c {...set bat [fil
a280: 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 72 e join [file dir
a290: 6e 61 6d 65 20 24 66 69 6c 65 5d 20 61 2e 62 61 name $file] a.ba
a2a0: 74 5d 0a 09 09 73 65 74 20 66 6f 75 74 20 5b 6f t]...set fout [o
a2b0: 70 65 6e 20 24 62 61 74 20 77 5d 0a 09 09 70 75 pen $bat w]...pu
a2c0: 74 73 20 24 66 6f 75 74 20 22 73 74 61 72 74 20 ts $fout "start
a2d0: 5c 22 5c 22 20 5c 22 24 66 69 6c 65 5c 22 22 0a \"\" \"$file\"".
a2e0: 09 09 63 6c 6f 73 65 20 24 66 6f 75 74 0a 09 09 ..close $fout...
a2f0: 65 78 65 63 20 24 62 61 74 20 0a 09 09 66 69 6c exec $bat ...fil
a300: 65 20 64 65 6c 65 74 65 20 24 62 61 74 0a 09 20 e delete $bat..
a310: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 65 76 } else {...ev
a320: 61 6c 20 65 78 65 63 20 5b 61 75 74 6f 5f 65 78 al exec [auto_ex
a330: 65 63 6f 6b 20 73 74 61 72 74 5d 20 5c 22 5c 22 ecok start] \"\"
a340: 20 5b 6c 69 73 74 20 24 66 69 6c 65 5d 20 7b 2a [list $file] {*
a350: 7d 24 61 72 67 73 20 26 0a 09 20 20 20 20 7d 0a }$args &.. }.
a360: 09 7d 0a 09 75 72 6c 20 7b 0a 09 20 20 20 20 69 .}..url {.. i
a370: 66 20 7b 20 5b 72 65 67 65 78 70 20 7b 5e 5b 2d f { [regexp {^[-
a380: 5c 77 2e 5d 2b 24 7d 20 24 66 69 6c 65 5d 20 7d \w.]+$} $file] }
a390: 20 7b 0a 09 09 73 65 74 20 66 69 6c 65 20 68 74 {...set file ht
a3a0: 74 70 3a 2f 2f 24 66 69 6c 65 0a 09 20 20 20 20 tp://$file..
a3b0: 7d 0a 09 20 20 20 20 69 66 20 7b 20 21 5b 72 65 }.. if { ![re
a3c0: 67 65 78 70 20 7b 28 3f 69 29 5e 5c 77 2b 3a 2f gexp {(?i)^\w+:/
a3d0: 2f 7d 20 24 66 69 6c 65 5d 20 26 26 20 21 5b 72 /} $file] && ![r
a3e0: 65 67 65 78 70 20 7b 28 3f 69 29 5e 6d 61 69 6c egexp {(?i)^mail
a3f0: 74 6f 3a 7d 20 24 66 69 6c 65 5d 20 7d 20 7b 0a to:} $file] } {.
a400: 09 09 73 65 74 20 74 78 74 20 5b 5f 20 22 75 72 ..set txt [_ "ur
a410: 6c 20 64 6f 65 73 20 6e 6f 74 20 62 65 67 69 6e l does not begin
a420: 20 77 69 74 68 20 61 20 6b 6e 6f 77 6e 20 68 61 with a known ha
a430: 6e 64 6c 65 72 20 6c 69 6b 65 3a 20 25 73 2e 20 ndler like: %s.
a440: 50 72 6f 63 65 65 64 3f 22 20 5c 0a 09 09 20 20 Proceed?" \...
a450: 20 20 20 20 20 20 22 68 74 74 70 3a 2f 2f 20 66 "http:// f
a460: 74 70 3a 2f 2f 20 6d 61 69 6c 74 6f 3a 22 5d 0a tp:// mailto:"].
a470: 09 09 73 65 74 20 72 65 74 76 61 6c 20 5b 74 6b ..set retval [tk
a480: 5f 6d 65 73 73 61 67 65 42 6f 78 20 2d 64 65 66 _messageBox -def
a490: 61 75 6c 74 20 6f 6b 20 2d 69 63 6f 6e 20 71 75 ault ok -icon qu
a4a0: 65 73 74 69 6f 6e 20 2d 6d 65 73 73 61 67 65 20 estion -message
a4b0: 24 74 78 74 20 5c 0a 09 09 20 20 20 20 20 20 20 $txt \...
a4c0: 20 2d 74 79 70 65 20 6f 6b 63 61 6e 63 65 6c 5d -type okcancel]
a4d0: 0a 09 09 69 66 20 7b 20 24 72 65 74 76 61 6c 20 ...if { $retval
a4e0: 3d 3d 20 22 63 61 6e 63 65 6c 22 20 7d 20 7b 20 == "cancel" } {
a4f0: 72 65 74 75 72 6e 20 7d 0a 09 20 20 20 20 7d 0a return }.. }.
a500: 09 20 20 20 20 69 66 20 7b 20 24 3a 3a 74 63 6c . if { $::tcl
a510: 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f _platform(platfo
a520: 72 6d 29 20 65 71 20 22 77 69 6e 64 6f 77 73 22 rm) eq "windows"
a530: 20 7d 20 7b 0a 09 09 65 78 65 63 20 72 75 6e 64 } {...exec rund
a540: 6c 6c 33 32 20 75 72 6c 2e 64 6c 6c 2c 46 69 6c ll32 url.dll,Fil
a550: 65 50 72 6f 74 6f 63 6f 6c 48 61 6e 64 6c 65 72 eProtocolHandler
a560: 20 24 66 69 6c 65 20 26 0a 09 20 20 20 20 7d 20 $file &.. }
a570: 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 70 72 6f else {...set pro
a580: 67 72 61 6d 73 20 5b 6c 69 73 74 20 78 64 67 2d grams [list xdg-
a590: 6f 70 65 6e 20 67 6e 6f 6d 65 2d 6f 70 65 6e 5d open gnome-open]
a5a0: 0a 09 09 69 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 ...if { $::tcl_p
a5b0: 6c 61 74 66 6f 72 6d 28 6f 73 29 20 65 71 20 22 latform(os) eq "
a5c0: 44 61 72 77 69 6e 22 20 7d 20 7b 0a 09 09 20 20 Darwin" } {...
a5d0: 20 20 73 65 74 20 70 72 6f 67 72 61 6d 73 20 5b set programs [
a5e0: 6c 69 6e 73 65 72 74 20 24 70 72 6f 67 72 61 6d linsert $program
a5f0: 73 20 30 20 6f 70 65 6e 5d 0a 09 09 7d 0a 09 09 s 0 open]...}...
a600: 66 6f 72 65 61 63 68 20 69 20 24 70 72 6f 67 72 foreach i $progr
a610: 61 6d 73 20 7b 0a 09 09 20 20 20 20 69 66 20 7b ams {... if {
a620: 20 5b 61 75 74 6f 5f 65 78 65 63 6f 6b 20 24 69 [auto_execok $i
a630: 5d 20 6e 65 20 22 22 20 7d 20 7b 0a 09 09 20 20 ] ne "" } {...
a640: 20 20 20 20 20 20 65 78 65 63 20 24 69 20 24 66 exec $i $f
a650: 69 6c 65 20 26 0a 09 09 20 20 20 20 20 20 20 20 ile &...
a660: 72 65 74 75 72 6e 0a 09 09 20 20 20 20 7d 0a 09 return... }..
a670: 09 7d 0a 09 09 73 65 74 20 63 6d 64 4c 69 73 74 .}...set cmdList
a680: 20 22 22 0a 09 09 66 6f 72 65 61 63 68 20 69 20 ""...foreach i
a690: 5b 6c 69 73 74 20 66 69 72 65 66 6f 78 20 6b 6f [list firefox ko
a6a0: 6e 71 75 65 72 6f 72 20 6d 6f 7a 69 6c 6c 61 20 nqueror mozilla
a6b0: 6f 70 65 72 61 20 6e 65 74 73 63 61 70 65 5d 20 opera netscape]
a6c0: 7b 0a 09 09 20 20 20 20 6c 61 70 70 65 6e 64 20 {... lappend
a6d0: 63 6d 64 4c 69 73 74 20 22 24 69 20 5c 22 24 66 cmdList "$i \"$f
a6e0: 69 6c 65 5c 22 22 0a 09 09 7d 0a 09 09 65 78 65 ile\""...}...exe
a6f0: 63 20 73 68 20 2d 63 20 5b 6a 6f 69 6e 20 24 63 c sh -c [join $c
a700: 6d 64 4c 69 73 74 20 22 7c 7c 22 5d 20 26 20 0a mdList "||"] & .
a710: 09 20 20 20 20 7d 0a 09 7d 0a 09 65 78 65 63 20 . }..}..exec
a720: 7b 0a 09 20 20 20 20 69 66 20 7b 20 24 77 6f 72 {.. if { $wor
a730: 6b 64 69 72 20 6e 65 20 22 22 20 7d 20 7b 0a 09 kdir ne "" } {..
a740: 09 73 65 74 20 70 77 64 20 5b 70 77 64 5d 0a 09 .set pwd [pwd]..
a750: 09 63 64 20 24 77 6f 72 6b 64 69 72 0a 09 20 20 .cd $workdir..
a760: 20 20 7d 0a 09 20 20 20 20 73 65 74 20 65 72 72 }.. set err
a770: 20 5b 63 61 74 63 68 20 7b 20 65 78 65 63 20 24 [catch { exec $
a780: 66 69 6c 65 20 7b 2a 7d 24 61 72 67 73 20 7d 20 file {*}$args }
a790: 65 72 72 73 74 72 69 6e 67 20 6f 70 74 73 5d 0a errstring opts].
a7a0: 09 20 20 20 20 0a 09 20 20 20 20 69 66 20 7b 20 . .. if {
a7b0: 24 65 72 72 20 26 26 20 24 3a 3a 74 63 6c 5f 70 $err && $::tcl_p
a7c0: 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d latform(platform
a7d0: 29 20 65 71 20 22 77 69 6e 64 6f 77 73 22 20 7d ) eq "windows" }
a7e0: 20 7b 0a 09 09 70 61 63 6b 61 67 65 20 72 65 71 {...package req
a7f0: 75 69 72 65 20 72 65 67 69 73 74 72 79 0a 09 09 uire registry...
a800: 73 65 74 20 6b 65 79 30 20 7b 48 4b 45 59 5f 43 set key0 {HKEY_C
a810: 4c 41 53 53 45 53 5f 52 4f 4f 54 5c 41 70 70 6c LASSES_ROOT\Appl
a820: 69 63 61 74 69 6f 6e 73 5c 25 73 5c 73 68 65 6c ications\%s\shel
a830: 6c 5c 6f 70 65 6e 5c 63 6f 6d 6d 61 6e 64 7d 0a l\open\command}.
a840: 09 09 73 65 74 20 66 69 6c 65 20 5b 66 69 6c 65 ..set file [file
a850: 20 72 6f 6f 74 20 5b 66 69 6c 65 20 74 61 69 6c root [file tail
a860: 20 24 66 69 6c 65 5d 5d 2e 65 78 65 0a 09 09 73 $file]].exe...s
a870: 65 74 20 6b 65 79 20 5b 66 6f 72 6d 61 74 20 24 et key [format $
a880: 6b 65 79 30 20 24 66 69 6c 65 5d 0a 09 09 73 65 key0 $file]...se
a890: 74 20 65 72 72 20 5b 63 61 74 63 68 20 7b 20 72 t err [catch { r
a8a0: 65 67 69 73 74 72 79 20 67 65 74 20 24 6b 65 79 egistry get $key
a8b0: 20 22 22 20 7d 20 76 61 6c 75 65 5d 0a 09 09 69 "" } value]...i
a8c0: 66 20 7b 20 21 24 65 72 72 20 7d 20 7b 0a 09 09 f { !$err } {...
a8d0: 20 20 20 20 73 65 74 20 63 6d 64 20 5b 73 74 72 set cmd [str
a8e0: 69 6e 67 20 6d 61 70 20 5b 6c 69 73 74 20 25 31 ing map [list %1
a8f0: 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 20 30 [lindex $args 0
a900: 5d 5d 20 24 76 61 6c 75 65 5d 0a 09 09 20 20 20 ]] $value]...
a910: 20 72 65 67 73 75 62 20 2d 61 6c 6c 20 7b 5c 5c regsub -all {\\
a920: 7d 20 24 63 6d 64 20 2f 20 63 6d 64 0a 09 09 20 } $cmd / cmd...
a930: 20 20 20 73 65 74 20 65 72 72 20 5b 63 61 74 63 set err [catc
a940: 68 20 7b 20 65 78 65 63 20 7b 2a 7d 24 63 6d 64 h { exec {*}$cmd
a950: 20 7d 20 65 72 72 73 74 72 69 6e 67 20 6f 70 74 } errstring opt
a960: 73 5d 0a 09 09 7d 0a 09 20 20 20 20 7d 0a 09 20 s]...}.. }..
a970: 20 20 20 0a 09 20 20 20 20 69 66 20 7b 20 24 77 .. if { $w
a980: 6f 72 6b 64 69 72 20 6e 65 20 22 22 20 7d 20 7b orkdir ne "" } {
a990: 20 63 64 20 24 70 77 64 20 7d 0a 09 20 20 20 20 cd $pwd }..
a9a0: 69 66 20 7b 20 24 65 72 72 20 7d 20 7b 0a 09 09 if { $err } {...
a9b0: 65 72 72 6f 72 20 24 65 72 72 73 74 72 69 6e 67 error $errstring
a9c0: 20 5b 64 69 63 74 20 67 65 74 20 24 6f 70 74 73 [dict get $opts
a9d0: 20 2d 65 72 72 6f 72 69 6e 66 6f 5d 0a 09 20 20 -errorinfo]..
a9e0: 20 20 7d 0a 09 7d 0a 09 65 78 65 63 4c 69 73 74 }..}..execList
a9f0: 20 7b 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 {.. foreach
aa00: 69 20 24 66 69 6c 65 20 7b 0a 09 09 69 66 20 7b i $file {...if {
aa10: 20 5b 61 75 74 6f 5f 65 78 65 63 6f 6b 20 5b 6c [auto_execok [l
aa20: 69 6e 64 65 78 20 24 69 20 30 5d 5d 20 6e 65 20 index $i 0]] ne
aa30: 22 22 20 7d 20 7b 0a 09 09 20 20 20 20 65 78 65 "" } {... exe
aa40: 63 20 7b 2a 7d 24 69 20 26 0a 09 09 20 20 20 20 c {*}$i &...
aa50: 72 65 74 75 72 6e 0a 09 09 7d 0a 09 20 20 20 20 return...}..
aa60: 7d 0a 09 20 20 65 72 72 6f 72 20 22 43 6f 75 6c }.. error "Coul
aa70: 64 20 6e 6f 74 20 65 78 65 63 75 74 65 20 66 69 d not execute fi
aa80: 6c 65 73 22 0a 09 7d 0a 09 64 65 66 61 75 6c 74 les"..}..default
aa90: 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 24 77 6f {.. if { $wo
aaa0: 72 6b 64 69 72 20 6e 65 20 22 22 20 7d 20 7b 0a rkdir ne "" } {.
aab0: 09 09 73 65 74 20 70 77 64 20 5b 70 77 64 5d 0a ..set pwd [pwd].
aac0: 09 09 63 64 20 24 77 6f 72 6b 64 69 72 0a 09 20 ..cd $workdir..
aad0: 20 20 20 7d 0a 09 20 20 20 20 73 65 74 20 65 72 }.. set er
aae0: 72 20 5b 63 61 74 63 68 20 7b 20 65 78 65 63 20 r [catch { exec
aaf0: 24 66 69 6c 65 20 7b 2a 7d 24 61 72 67 73 20 26 $file {*}$args &
ab00: 20 7d 20 65 72 72 73 74 72 69 6e 67 5d 0a 09 20 } errstring]..
ab10: 20 20 20 69 66 20 7b 20 24 77 6f 72 6b 64 69 72 if { $workdir
ab20: 20 6e 65 20 22 22 20 7d 20 7b 20 63 64 20 24 70 ne "" } { cd $p
ab30: 77 64 20 7d 0a 09 20 20 20 20 69 66 20 7b 20 24 wd }.. if { $
ab40: 65 72 72 20 7d 20 7b 0a 09 09 65 72 72 6f 72 20 err } {...error
ab50: 24 65 72 72 73 74 72 69 6e 67 20 24 3a 3a 65 72 $errstring $::er
ab60: 72 6f 72 49 6e 66 6f 0a 09 20 20 20 20 7d 0a 09 rorInfo.. }..
ab70: 7d 0a 20 20 20 20 7d 20 20 0a 7d }. } .}