Artifact
f26230e30acdb13d3a1eaf8dfe737c24014359d8:
- File
scripts/mini_compass_utils.tcl
— part of check-in
[42ba5817d2]
at
2010-12-23 13:25:04
on branch trunk
— * Corrections in cu::set_window_geometry
* Corrections in cu::combobox_tree and error when closing popup
(user:
ramsan
size: 25465)
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 69 6e 66 6f snit..proc info
0020: 5f 66 75 6c 6c 61 72 67 73 20 7b 20 70 72 6f 63 _fullargs { proc
0030: 6e 61 6d 65 20 7d 20 7b 0a 20 20 20 20 73 65 74 name } {. set
0040: 20 72 65 74 20 22 22 0a 20 20 20 20 66 6f 72 65 ret "". fore
0050: 61 63 68 20 61 72 67 20 5b 75 70 6c 65 76 65 6c ach arg [uplevel
0060: 20 31 20 5b 6c 69 73 74 20 69 6e 66 6f 20 61 72 1 [list info ar
0070: 67 73 20 24 70 72 6f 63 6e 61 6d 65 5d 5d 20 7b gs $procname]] {
0080: 0a 09 69 66 20 7b 20 5b 75 70 6c 65 76 65 6c 20 ..if { [uplevel
0090: 31 20 5b 6c 69 73 74 20 69 6e 66 6f 20 64 65 66 1 [list info def
00a0: 61 75 6c 74 20 24 70 72 6f 63 6e 61 6d 65 20 24 ault $procname $
00b0: 61 72 67 20 76 61 6c 75 65 5d 5d 20 7d 20 7b 0a arg value]] } {.
00c0: 09 20 20 20 20 75 70 76 61 72 20 31 20 76 61 6c . upvar 1 val
00d0: 75 65 20 76 61 6c 75 65 0a 09 20 20 20 20 6c 61 ue value.. la
00e0: 70 70 65 6e 64 20 72 65 74 20 5b 6c 69 73 74 20 ppend ret [list
00f0: 24 61 72 67 20 24 76 61 6c 75 65 5d 0a 09 7d 20 $arg $value]..}
0100: 65 6c 73 65 20 7b 0a 09 20 20 20 20 6c 61 70 70 else {.. lapp
0110: 65 6e 64 20 72 65 74 20 24 61 72 67 0a 09 7d 0a end ret $arg..}.
0120: 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 6e }. return
0130: 20 24 72 65 74 0a 7d 0a 0a 6e 61 6d 65 73 70 61 $ret.}..namespa
0140: 63 65 20 65 76 61 6c 20 63 75 20 7b 7d 0a 6e 61 ce eval cu {}.na
0150: 6d 65 73 70 61 63 65 20 65 76 61 6c 20 63 75 3a mespace eval cu:
0160: 3a 66 69 6c 65 20 7b 7d 0a 0a 23 20 66 6f 72 20 :file {}..# for
0170: 74 63 6c 49 6e 64 65 78 20 74 6f 20 77 6f 72 6b tclIndex to work
0180: 20 0a 70 72 6f 63 20 63 75 3a 3a 6d 65 6e 75 62 .proc cu::menub
0190: 75 74 74 6f 6e 5f 62 75 74 74 6f 6e 20 7b 20 61 utton_button { a
01a0: 72 67 73 20 7d 20 7b 7d 0a 0a 0a 73 6e 69 74 3a rgs } {}...snit:
01b0: 3a 77 69 64 67 65 74 61 64 61 70 74 6f 72 20 63 :widgetadaptor c
01c0: 75 3a 3a 6d 65 6e 75 62 75 74 74 6f 6e 5f 62 75 u::menubutton_bu
01d0: 74 74 6f 6e 20 7b 0a 20 20 20 20 6f 70 74 69 6f tton {. optio
01e0: 6e 20 2d 63 6f 6d 6d 61 6e 64 20 22 22 0a 20 20 n -command "".
01f0: 20 20 6f 70 74 69 6f 6e 20 2d 69 6d 61 67 65 20 option -image
0200: 22 22 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d 74 "". option -t
0210: 65 78 74 20 22 22 0a 0a 20 20 20 20 64 65 6c 65 ext "".. dele
0220: 67 61 74 65 20 6d 65 74 68 6f 64 20 2a 20 74 6f gate method * to
0230: 20 68 75 6c 6c 0a 20 20 20 20 64 65 6c 65 67 61 hull. delega
0240: 74 65 20 6f 70 74 69 6f 6e 20 2a 20 74 6f 20 68 te option * to h
0250: 75 6c 6c 0a 20 20 20 20 64 65 6c 65 67 61 74 65 ull. delegate
0260: 20 6f 70 74 69 6f 6e 20 2d 5f 69 6d 61 67 65 20 option -_image
0270: 74 6f 20 68 75 6c 6c 20 61 73 20 2d 69 6d 61 67 to hull as -imag
0280: 65 0a 20 20 20 20 64 65 6c 65 67 61 74 65 20 6f e. delegate o
0290: 70 74 69 6f 6e 20 2d 5f 74 65 78 74 20 74 6f 20 ption -_text to
02a0: 68 75 6c 6c 20 61 73 20 2d 74 65 78 74 0a 0a 20 hull as -text..
02b0: 20 20 20 76 61 72 69 61 62 6c 65 20 69 73 5f 62 variable is_b
02c0: 75 74 74 6f 6e 5f 61 63 74 69 76 65 20 31 0a 20 utton_active 1.
02d0: 20 20 20 0a 20 20 20 20 63 6f 6e 73 74 72 75 63 . construc
02e0: 74 6f 72 20 61 72 67 73 20 7b 0a 09 69 6e 73 74 tor args {..inst
02f0: 61 6c 6c 68 75 6c 6c 20 75 73 69 6e 67 20 74 74 allhull using tt
0300: 6b 3a 3a 6d 65 6e 75 62 75 74 74 6f 6e 20 2d 73 k::menubutton -s
0310: 74 79 6c 65 20 54 6f 6f 6c 62 75 74 74 6f 6e 0a tyle Toolbutton.
0320: 09 62 69 6e 64 20 24 77 69 6e 20 3c 42 75 74 74 .bind $win <Butt
0330: 6f 6e 50 72 65 73 73 2d 31 3e 20 5b 6d 79 6d 65 onPress-1> [myme
0340: 74 68 6f 64 20 42 50 31 20 25 78 20 25 79 5d 0a thod BP1 %x %y].
0350: 09 62 69 6e 64 20 24 77 69 6e 20 3c 42 75 74 74 .bind $win <Butt
0360: 6f 6e 52 65 6c 65 61 73 65 2d 31 3e 20 5b 6d 79 onRelease-1> [my
0370: 6d 65 74 68 6f 64 20 42 52 31 20 25 78 20 25 79 method BR1 %x %y
0380: 5d 0a 0a 09 24 73 65 6c 66 20 63 6f 6e 66 69 67 ]...$self config
0390: 75 72 65 6c 69 73 74 20 24 61 72 67 73 0a 20 20 urelist $args.
03a0: 20 20 7d 0a 20 20 20 20 6f 6e 63 6f 6e 66 69 67 }. onconfig
03b0: 75 72 65 20 2d 69 6d 61 67 65 20 7b 69 6d 67 7d ure -image {img}
03c0: 20 7b 0a 09 73 65 74 20 6f 70 74 69 6f 6e 73 28 {..set options(
03d0: 2d 69 6d 61 67 65 29 20 24 69 6d 67 0a 0a 09 69 -image) $img...i
03e0: 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 74 65 f { $options(-te
03f0: 78 74 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 20 xt) ne "" } {..
0400: 20 20 20 24 73 65 6c 66 20 63 6f 6e 66 69 67 75 $self configu
0410: 72 65 20 2d 5f 69 6d 61 67 65 20 24 69 6d 67 0a re -_image $img.
0420: 09 20 20 20 20 72 65 74 75 72 6e 0a 09 7d 20 65 . return..} e
0430: 6c 73 65 69 66 20 7b 20 24 69 6d 67 20 6e 65 20 lseif { $img ne
0440: 22 22 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 "" } {.. set
0450: 77 69 64 74 68 20 5b 69 6d 61 67 65 20 77 69 64 width [image wid
0460: 74 68 20 24 69 6d 67 5d 0a 09 20 20 20 20 73 65 th $img].. se
0470: 74 20 68 65 69 67 68 74 20 5b 69 6d 61 67 65 20 t height [image
0480: 68 65 69 67 68 74 20 24 69 6d 67 5d 0a 09 7d 20 height $img]..}
0490: 65 6c 73 65 20 7b 20 66 6f 72 65 61 63 68 20 22 else { foreach "
04a0: 77 69 64 74 68 20 68 65 69 67 68 74 22 20 5b 6c width height" [l
04b0: 69 73 74 20 30 20 31 36 5d 20 62 72 65 61 6b 20 ist 0 16] break
04c0: 7d 0a 0a 09 73 65 74 20 6e 65 77 5f 69 6d 67 20 }...set new_img
04d0: 5b 69 6d 61 67 65 20 63 72 65 61 74 65 20 70 68 [image create ph
04e0: 6f 74 6f 20 2d 77 69 64 74 68 20 5b 65 78 70 72 oto -width [expr
04f0: 20 7b 24 77 69 64 74 68 2b 37 7d 5d 20 2d 68 65 {$width+7}] -he
0500: 69 67 68 74 20 24 68 65 69 67 68 74 5d 0a 09 69 ight $height]..i
0510: 66 20 7b 20 24 69 6d 67 20 6e 65 20 22 22 20 7d f { $img ne "" }
0520: 20 7b 20 24 6e 65 77 5f 69 6d 67 20 63 6f 70 79 { $new_img copy
0530: 20 24 69 6d 67 20 2d 74 6f 20 30 20 30 20 7d 0a $img -to 0 0 }.
0540: 09 73 65 74 20 63 6f 6f 72 64 73 20 7b 0a 09 20 .set coords {..
0550: 20 20 20 2d 33 20 2d 31 0a 09 20 20 20 20 2d 34 -3 -1.. -4
0560: 20 2d 32 20 2d 33 20 2d 32 20 2d 32 20 2d 32 0a -2 -3 -2 -2 -2.
0570: 09 20 20 20 20 2d 35 20 2d 33 20 2d 34 20 2d 33 . -5 -3 -4 -3
0580: 20 2d 33 20 2d 33 20 2d 32 20 2d 33 20 2d 31 20 -3 -3 -2 -3 -1
0590: 2d 33 0a 09 7d 0a 09 66 6f 72 65 61 63 68 20 22 -3..}..foreach "
05a0: 78 20 79 22 20 24 63 6f 6f 72 64 73 20 7b 0a 09 x y" $coords {..
05b0: 20 20 20 20 24 6e 65 77 5f 69 6d 67 20 70 75 74 $new_img put
05c0: 20 62 6c 61 63 6b 20 2d 74 6f 20 5b 65 78 70 72 black -to [expr
05d0: 20 7b 24 77 69 64 74 68 2b 37 2b 24 78 7d 5d 20 {$width+7+$x}]
05e0: 5b 65 78 70 72 20 7b 24 68 65 69 67 68 74 2b 24 [expr {$height+$
05f0: 79 7d 5d 0a 09 7d 0a 09 24 73 65 6c 66 20 63 6f y}]..}..$self co
0600: 6e 66 69 67 75 72 65 20 2d 5f 69 6d 61 67 65 20 nfigure -_image
0610: 24 6e 65 77 5f 69 6d 67 0a 09 62 69 6e 64 20 24 $new_img..bind $
0620: 77 69 6e 20 3c 44 65 73 74 72 6f 79 3e 20 2b 5b win <Destroy> +[
0630: 6c 69 73 74 20 69 6d 61 67 65 20 64 65 6c 65 74 list image delet
0640: 65 20 24 6e 65 77 5f 69 6d 67 5d 0a 20 20 20 20 e $new_img].
0650: 7d 0a 20 20 20 20 6f 6e 63 6f 6e 66 69 67 75 72 }. onconfigur
0660: 65 20 2d 74 65 78 74 20 7b 76 61 6c 75 65 7d 20 e -text {value}
0670: 7b 0a 09 73 65 74 20 6f 70 74 69 6f 6e 73 28 2d {..set options(-
0680: 74 65 78 74 29 20 24 76 61 6c 75 65 0a 0a 09 69 text) $value...i
0690: 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 74 65 f { $options(-te
06a0: 78 74 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 20 xt) ne "" } {..
06b0: 20 20 20 24 73 65 6c 66 20 63 6f 6e 66 69 67 75 $self configu
06c0: 72 65 20 2d 73 74 79 6c 65 20 22 22 0a 09 20 20 re -style ""..
06d0: 20 20 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 if { $options(
06e0: 2d 69 6d 61 67 65 29 20 6e 65 20 22 22 20 7d 20 -image) ne "" }
06f0: 7b 0a 09 09 24 73 65 6c 66 20 63 6f 6e 66 69 67 {...$self config
0700: 75 72 65 20 2d 5f 69 6d 61 67 65 20 24 6f 70 74 ure -_image $opt
0710: 69 6f 6e 73 28 2d 69 6d 61 67 65 29 0a 09 20 20 ions(-image)..
0720: 20 20 7d 0a 09 7d 0a 09 24 73 65 6c 66 20 63 6f }..}..$self co
0730: 6e 66 69 67 75 72 65 20 2d 5f 74 65 78 74 20 24 nfigure -_text $
0740: 76 61 6c 75 65 0a 20 20 20 20 7d 0a 20 20 20 20 value. }.
0750: 6d 65 74 68 6f 64 20 67 69 76 65 5f 69 73 5f 62 method give_is_b
0760: 75 74 74 6f 6e 5f 61 63 74 69 76 65 5f 76 61 72 utton_active_var
0770: 20 7b 7d 20 7b 0a 09 72 65 74 75 72 6e 20 5b 6d {} {..return [m
0780: 79 76 61 72 20 69 73 5f 62 75 74 74 6f 6e 5f 61 yvar is_button_a
0790: 63 74 69 76 65 5d 0a 20 20 20 20 7d 0a 20 20 20 ctive]. }.
07a0: 20 6d 65 74 68 6f 64 20 42 50 31 20 7b 20 78 20 method BP1 { x
07b0: 79 20 7d 20 7b 0a 09 69 66 20 7b 20 21 24 69 73 y } {..if { !$is
07c0: 5f 62 75 74 74 6f 6e 5f 61 63 74 69 76 65 20 7d _button_active }
07d0: 20 7b 20 72 65 74 75 72 6e 20 7d 0a 09 69 66 20 { return }..if
07e0: 7b 20 24 78 20 3c 20 5b 77 69 6e 66 6f 20 77 69 { $x < [winfo wi
07f0: 64 74 68 20 24 77 69 6e 5d 2d 31 30 20 26 26 20 dth $win]-10 &&
0800: 24 6f 70 74 69 6f 6e 73 28 2d 63 6f 6d 6d 61 6e $options(-comman
0810: 64 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 20 20 d) ne "" } {..
0820: 20 20 24 77 69 6e 20 69 6e 73 74 61 74 65 20 21 $win instate !
0830: 64 69 73 61 62 6c 65 64 20 7b 0a 09 09 63 61 74 disabled {...cat
0840: 63 68 20 7b 20 74 69 6c 65 3a 3a 63 6c 69 63 6b ch { tile::click
0850: 54 6f 46 6f 63 75 73 20 24 77 69 6e 20 7d 0a 09 ToFocus $win }..
0860: 09 63 61 74 63 68 20 7b 20 74 74 6b 3a 3a 63 6c .catch { ttk::cl
0870: 69 63 6b 54 6f 46 6f 63 75 73 20 24 77 69 6e 20 ickToFocus $win
0880: 7d 0a 09 09 24 77 69 6e 20 73 74 61 74 65 20 70 }...$win state p
0890: 72 65 73 73 65 64 0a 09 20 20 20 20 7d 0a 09 20 ressed.. }..
08a0: 20 20 20 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 return -code
08b0: 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 break..}. }.
08c0: 20 20 20 6d 65 74 68 6f 64 20 42 52 31 20 7b 20 method BR1 {
08d0: 78 20 79 20 7d 20 7b 0a 09 69 66 20 7b 20 21 24 x y } {..if { !$
08e0: 69 73 5f 62 75 74 74 6f 6e 5f 61 63 74 69 76 65 is_button_active
08f0: 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a 09 69 } { return }..i
0900: 66 20 7b 20 24 78 20 3c 20 5b 77 69 6e 66 6f 20 f { $x < [winfo
0910: 77 69 64 74 68 20 24 77 69 6e 5d 2d 31 30 20 26 width $win]-10 &
0920: 26 20 24 6f 70 74 69 6f 6e 73 28 2d 63 6f 6d 6d & $options(-comm
0930: 61 6e 64 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 and) ne "" } {..
0940: 20 20 20 20 24 77 69 6e 20 69 6e 73 74 61 74 65 $win instate
0950: 20 7b 70 72 65 73 73 65 64 20 21 64 69 73 61 62 {pressed !disab
0960: 6c 65 64 7d 20 7b 0a 09 09 24 77 69 6e 20 73 74 led} {...$win st
0970: 61 74 65 20 21 70 72 65 73 73 65 64 0a 09 09 75 ate !pressed...u
0980: 70 6c 65 76 65 6c 20 23 30 20 24 6f 70 74 69 6f plevel #0 $optio
0990: 6e 73 28 2d 63 6f 6d 6d 61 6e 64 29 0a 09 20 20 ns(-command)..
09a0: 20 20 7d 20 0a 09 20 20 20 20 72 65 74 75 72 6e } .. return
09b0: 20 2d 63 6f 64 65 20 62 72 65 61 6b 0a 09 7d 0a -code break..}.
09c0: 20 20 20 20 7d 0a 7d 0a 0a 73 6e 69 74 3a 3a 77 }.}..snit::w
09d0: 69 64 67 65 74 61 64 61 70 74 6f 72 20 63 75 3a idgetadaptor cu:
09e0: 3a 63 6f 6d 62 6f 62 6f 78 20 7b 0a 20 20 20 20 :combobox {.
09f0: 6f 70 74 69 6f 6e 20 2d 76 61 6c 75 65 73 76 61 option -valuesva
0a00: 72 69 61 62 6c 65 20 22 22 0a 20 20 20 20 6f 70 riable "". op
0a10: 74 69 6f 6e 20 2d 74 65 78 74 76 61 72 69 61 62 tion -textvariab
0a20: 6c 65 20 22 22 0a 20 20 20 20 6f 70 74 69 6f 6e le "". option
0a30: 20 2d 73 74 61 74 65 76 61 72 69 61 62 6c 65 20 -statevariable
0a40: 22 22 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d 76 "". option -v
0a50: 61 6c 75 65 73 20 22 22 0a 20 20 20 20 6f 70 74 alues "". opt
0a60: 69 6f 6e 20 2d 64 69 63 74 20 22 22 0a 20 20 20 ion -dict "".
0a70: 20 6f 70 74 69 6f 6e 20 2d 64 69 63 74 76 61 72 option -dictvar
0a80: 69 61 62 6c 65 20 22 22 0a 0a 20 20 20 20 76 61 iable "".. va
0a90: 72 69 61 62 6c 65 20 5f 74 72 61 6e 73 6c 61 74 riable _translat
0aa0: 65 64 5f 74 65 78 74 76 61 72 69 61 62 6c 65 20 ed_textvariable
0ab0: 22 22 0a 0a 20 20 20 20 64 65 6c 65 67 61 74 65 "".. delegate
0ac0: 20 6d 65 74 68 6f 64 20 2a 20 74 6f 20 68 75 6c method * to hul
0ad0: 6c 0a 20 20 20 20 64 65 6c 65 67 61 74 65 20 6f l. delegate o
0ae0: 70 74 69 6f 6e 20 2a 20 74 6f 20 68 75 6c 6c 0a ption * to hull.
0af0: 20 20 20 20 64 65 6c 65 67 61 74 65 20 6f 70 74 delegate opt
0b00: 69 6f 6e 20 2d 5f 76 61 6c 75 65 73 20 74 6f 20 ion -_values to
0b10: 68 75 6c 6c 20 61 73 20 2d 76 61 6c 75 65 73 0a hull as -values.
0b20: 20 20 20 20 64 65 6c 65 67 61 74 65 20 6f 70 74 delegate opt
0b30: 69 6f 6e 20 2d 5f 74 65 78 74 76 61 72 69 61 62 ion -_textvariab
0b40: 6c 65 20 74 6f 20 68 75 6c 6c 20 61 73 20 2d 74 le to hull as -t
0b50: 65 78 74 76 61 72 69 61 62 6c 65 0a 0a 20 20 20 extvariable..
0b60: 20 63 6f 6e 73 74 72 75 63 74 6f 72 20 61 72 67 constructor arg
0b70: 73 20 7b 0a 09 69 6e 73 74 61 6c 6c 68 75 6c 6c s {..installhull
0b80: 20 75 73 69 6e 67 20 74 74 6b 3a 3a 63 6f 6d 62 using ttk::comb
0b90: 6f 62 6f 78 0a 0a 09 63 75 3a 3a 61 64 64 5f 63 obox...cu::add_c
0ba0: 6f 6e 74 65 78 74 75 61 6c 5f 6d 65 6e 75 5f 74 ontextual_menu_t
0bb0: 6f 5f 65 6e 74 72 79 20 24 77 69 6e 20 69 6e 69 o_entry $win ini
0bc0: 74 0a 09 62 69 6e 64 20 24 77 69 6e 20 3c 3c 43 t..bind $win <<C
0bd0: 6f 6d 62 6f 62 6f 78 53 65 6c 65 63 74 65 64 3e omboboxSelected>
0be0: 3e 20 5b 6d 79 6d 65 74 68 6f 64 20 63 6f 6d 62 > [mymethod comb
0bf0: 6f 62 6f 78 5f 73 65 6c 65 63 74 65 64 5d 0a 09 obox_selected]..
0c00: 24 73 65 6c 66 20 63 6f 6e 66 69 67 75 72 65 6c $self configurel
0c10: 69 73 74 20 24 61 72 67 73 0a 20 20 20 20 7d 0a ist $args. }.
0c20: 20 20 20 20 64 65 73 74 72 75 63 74 6f 72 20 7b destructor {
0c30: 0a 09 63 61 74 63 68 20 7b 0a 09 20 20 20 20 69 ..catch {.. i
0c40: 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 76 61 f { $options(-va
0c50: 6c 75 65 73 76 61 72 69 61 62 6c 65 29 20 6e 65 luesvariable) ne
0c60: 20 22 22 20 7d 20 7b 0a 09 09 75 70 76 61 72 20 "" } {...upvar
0c70: 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d 76 61 6c #0 $options(-val
0c80: 75 65 73 76 61 72 69 61 62 6c 65 29 20 76 0a 09 uesvariable) v..
0c90: 09 74 72 61 63 65 20 72 65 6d 6f 76 65 20 76 61 .trace remove va
0ca0: 72 69 61 62 6c 65 20 76 20 77 72 69 74 65 20 22 riable v write "
0cb0: 5b 6d 79 6d 65 74 68 6f 64 20 5f 63 68 61 6e 67 [mymethod _chang
0cc0: 65 64 5f 76 61 6c 75 65 73 5f 76 61 72 5d 3b 23 ed_values_var];#
0cd0: 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 ".. }.. if
0ce0: 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 64 69 63 { $options(-dic
0cf0: 74 76 61 72 69 61 62 6c 65 29 20 6e 65 20 22 22 tvariable) ne ""
0d00: 20 7d 20 7b 0a 09 09 75 70 76 61 72 20 23 30 20 } {...upvar #0
0d10: 24 6f 70 74 69 6f 6e 73 28 2d 64 69 63 74 76 61 $options(-dictva
0d20: 72 69 61 62 6c 65 29 20 76 0a 09 09 74 72 61 63 riable) v...trac
0d30: 65 20 72 65 6d 6f 76 65 20 76 61 72 69 61 62 6c e remove variabl
0d40: 65 20 76 20 77 72 69 74 65 20 22 5b 6d 79 6d 65 e v write "[myme
0d50: 74 68 6f 64 20 5f 63 68 61 6e 67 65 64 5f 76 61 thod _changed_va
0d60: 6c 75 65 73 5f 76 61 72 5d 3b 23 22 0a 09 20 20 lues_var];#"..
0d70: 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 20 24 6f }.. if { $o
0d80: 70 74 69 6f 6e 73 28 2d 74 65 78 74 76 61 72 69 ptions(-textvari
0d90: 61 62 6c 65 29 20 6e 65 20 22 22 20 7d 20 7b 0a able) ne "" } {.
0da0: 09 09 75 70 76 61 72 20 23 30 20 24 6f 70 74 69 ..upvar #0 $opti
0db0: 6f 6e 73 28 2d 74 65 78 74 76 61 72 69 61 62 6c ons(-textvariabl
0dc0: 65 29 20 76 0a 09 09 74 72 61 63 65 20 72 65 6d e) v...trace rem
0dd0: 6f 76 65 20 76 61 72 69 61 62 6c 65 20 76 20 77 ove variable v w
0de0: 72 69 74 65 20 22 5b 6d 79 6d 65 74 68 6f 64 20 rite "[mymethod
0df0: 5f 77 72 69 74 74 65 6e 5f 74 65 78 74 76 61 72 _written_textvar
0e00: 69 61 62 6c 65 5d 3b 23 22 0a 09 20 20 20 20 7d iable];#".. }
0e10: 0a 09 20 20 20 20 69 66 20 7b 20 24 6f 70 74 69 .. if { $opti
0e20: 6f 6e 73 28 2d 73 74 61 74 65 76 61 72 69 61 62 ons(-statevariab
0e30: 6c 65 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 09 le) ne "" } {...
0e40: 75 70 76 61 72 20 23 30 20 24 6f 70 74 69 6f 6e upvar #0 $option
0e50: 73 28 2d 73 74 61 74 65 76 61 72 69 61 62 6c 65 s(-statevariable
0e60: 29 20 76 0a 09 09 74 72 61 63 65 20 72 65 6d 6f ) v...trace remo
0e70: 76 65 20 76 61 72 69 61 62 6c 65 20 76 20 77 72 ve variable v wr
0e80: 69 74 65 20 22 5b 6d 79 6d 65 74 68 6f 64 20 5f ite "[mymethod _
0e90: 77 72 69 74 74 65 6e 5f 73 74 61 74 65 76 61 72 written_statevar
0ea0: 69 61 62 6c 65 5d 3b 23 22 0a 09 09 74 72 61 63 iable];#"...trac
0eb0: 65 20 72 65 6d 6f 76 65 20 76 61 72 69 61 62 6c e remove variabl
0ec0: 65 20 76 20 72 65 61 64 20 22 5b 6d 79 6d 65 74 e v read "[mymet
0ed0: 68 6f 64 20 5f 72 65 61 64 5f 73 74 61 74 65 76 hod _read_statev
0ee0: 61 72 69 61 62 6c 65 5d 3b 23 22 0a 09 20 20 20 ariable];#"..
0ef0: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
0f00: 6f 6e 63 6f 6e 66 69 67 75 72 65 20 2d 74 65 78 onconfigure -tex
0f10: 74 76 61 72 69 61 62 6c 65 20 7b 76 61 6c 75 65 tvariable {value
0f20: 7d 20 7b 0a 09 73 65 74 20 6f 70 74 69 6f 6e 73 } {..set options
0f30: 28 2d 74 65 78 74 76 61 72 69 61 62 6c 65 29 20 (-textvariable)
0f40: 24 76 61 6c 75 65 0a 09 24 73 65 6c 66 20 63 6f $value..$self co
0f50: 6e 66 69 67 75 72 65 20 2d 5f 74 65 78 74 76 61 nfigure -_textva
0f60: 72 69 61 62 6c 65 20 5b 6d 79 76 61 72 20 5f 74 riable [myvar _t
0f70: 72 61 6e 73 6c 61 74 65 64 5f 74 65 78 74 76 61 ranslated_textva
0f80: 72 69 61 62 6c 65 5d 0a 0a 09 75 70 76 61 72 20 riable]...upvar
0f90: 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d 74 65 78 #0 $options(-tex
0fa0: 74 76 61 72 69 61 62 6c 65 29 20 76 0a 09 74 72 tvariable) v..tr
0fb0: 61 63 65 20 61 64 64 20 76 61 72 69 61 62 6c 65 ace add variable
0fc0: 20 76 20 77 72 69 74 65 20 22 5b 6d 79 6d 65 74 v write "[mymet
0fd0: 68 6f 64 20 5f 77 72 69 74 74 65 6e 5f 74 65 78 hod _written_tex
0fe0: 74 76 61 72 69 61 62 6c 65 5d 3b 23 22 0a 09 74 tvariable];#"..t
0ff0: 72 61 63 65 20 61 64 64 20 76 61 72 69 61 62 6c race add variabl
1000: 65 20 5b 6d 79 76 61 72 20 5f 74 72 61 6e 73 6c e [myvar _transl
1010: 61 74 65 64 5f 74 65 78 74 76 61 72 69 61 62 6c ated_textvariabl
1020: 65 5d 20 77 72 69 74 65 20 5c 0a 09 20 20 20 20 e] write \..
1030: 22 5b 6d 79 6d 65 74 68 6f 64 20 5f 72 65 61 64 "[mymethod _read
1040: 5f 74 65 78 74 76 61 72 69 61 62 6c 65 5d 3b 23 _textvariable];#
1050: 22 0a 09 69 66 20 7b 20 5b 69 6e 66 6f 20 65 78 "..if { [info ex
1060: 69 73 74 73 20 76 5d 20 7d 20 7b 0a 09 20 20 20 ists v] } {..
1070: 20 24 73 65 6c 66 20 5f 77 72 69 74 74 65 6e 5f $self _written_
1080: 74 65 78 74 76 61 72 69 61 62 6c 65 0a 09 7d 0a textvariable..}.
1090: 20 20 20 20 7d 0a 20 20 20 20 6f 6e 63 6f 6e 66 }. onconf
10a0: 69 67 75 72 65 20 2d 64 69 63 74 76 61 72 69 61 igure -dictvaria
10b0: 62 6c 65 20 7b 76 61 6c 75 65 7d 20 7b 0a 09 73 ble {value} {..s
10c0: 65 74 20 6f 70 74 69 6f 6e 73 28 2d 64 69 63 74 et options(-dict
10d0: 76 61 72 69 61 62 6c 65 29 20 24 76 61 6c 75 65 variable) $value
10e0: 0a 09 24 73 65 6c 66 20 5f 63 68 61 6e 67 65 64 ..$self _changed
10f0: 5f 76 61 6c 75 65 73 5f 76 61 72 0a 09 75 70 76 _values_var..upv
1100: 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d ar #0 $options(-
1110: 64 69 63 74 76 61 72 69 61 62 6c 65 29 20 76 0a dictvariable) v.
1120: 09 74 72 61 63 65 20 61 64 64 20 76 61 72 69 61 .trace add varia
1130: 62 6c 65 20 76 20 77 72 69 74 65 20 22 5b 6d 79 ble v write "[my
1140: 6d 65 74 68 6f 64 20 5f 63 68 61 6e 67 65 64 5f method _changed_
1150: 76 61 6c 75 65 73 5f 76 61 72 5d 3b 23 22 0a 20 values_var];#".
1160: 20 20 20 7d 0a 20 20 20 20 6f 6e 63 6f 6e 66 69 }. onconfi
1170: 67 75 72 65 20 2d 73 74 61 74 65 76 61 72 69 61 gure -statevaria
1180: 62 6c 65 20 7b 76 61 6c 75 65 7d 20 7b 0a 09 73 ble {value} {..s
1190: 65 74 20 6f 70 74 69 6f 6e 73 28 2d 73 74 61 74 et options(-stat
11a0: 65 76 61 72 69 61 62 6c 65 29 20 24 76 61 6c 75 evariable) $valu
11b0: 65 0a 0a 09 75 70 76 61 72 20 23 30 20 24 6f 70 e...upvar #0 $op
11c0: 74 69 6f 6e 73 28 2d 73 74 61 74 65 76 61 72 69 tions(-statevari
11d0: 61 62 6c 65 29 20 76 0a 09 74 72 61 63 65 20 61 able) v..trace a
11e0: 64 64 20 76 61 72 69 61 62 6c 65 20 76 20 77 72 dd variable v wr
11f0: 69 74 65 20 22 5b 6d 79 6d 65 74 68 6f 64 20 5f ite "[mymethod _
1200: 77 72 69 74 74 65 6e 5f 73 74 61 74 65 76 61 72 written_statevar
1210: 69 61 62 6c 65 5d 3b 23 22 0a 09 74 72 61 63 65 iable];#"..trace
1220: 20 61 64 64 20 76 61 72 69 61 62 6c 65 20 76 20 add variable v
1230: 72 65 61 64 20 22 5b 6d 79 6d 65 74 68 6f 64 20 read "[mymethod
1240: 5f 72 65 61 64 5f 73 74 61 74 65 76 61 72 69 61 _read_statevaria
1250: 62 6c 65 5d 3b 23 22 0a 09 69 66 20 7b 20 5b 69 ble];#"..if { [i
1260: 6e 66 6f 20 65 78 69 73 74 73 20 76 5d 20 7d 20 nfo exists v] }
1270: 7b 0a 09 20 20 20 20 73 65 74 20 76 20 24 76 0a {.. set v $v.
1280: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6f 6e 63 .}. }. onc
1290: 6f 6e 66 69 67 75 72 65 20 2d 76 61 6c 75 65 73 onfigure -values
12a0: 76 61 72 69 61 62 6c 65 20 7b 76 61 6c 75 65 7d variable {value}
12b0: 20 7b 0a 09 73 65 74 20 6f 70 74 69 6f 6e 73 28 {..set options(
12c0: 2d 76 61 6c 75 65 73 76 61 72 69 61 62 6c 65 29 -valuesvariable)
12d0: 20 24 76 61 6c 75 65 0a 0a 09 75 70 76 61 72 20 $value...upvar
12e0: 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d 76 61 6c #0 $options(-val
12f0: 75 65 73 76 61 72 69 61 62 6c 65 29 20 76 0a 0a uesvariable) v..
1300: 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d .if { $options(-
1310: 64 69 63 74 76 61 72 69 61 62 6c 65 29 20 6e 65 dictvariable) ne
1320: 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 75 70 76 "" } {.. upv
1330: 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d ar #0 $options(-
1340: 64 69 63 74 76 61 72 69 61 62 6c 65 29 20 76 64 dictvariable) vd
1350: 0a 09 20 20 20 20 69 66 20 7b 20 5b 69 6e 66 6f .. if { [info
1360: 20 65 78 69 73 74 73 20 76 64 5d 20 7d 20 7b 0a exists vd] } {.
1370: 09 09 73 65 74 20 64 69 63 74 20 24 76 64 0a 09 ..set dict $vd..
1380: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 } else {...s
1390: 65 74 20 64 69 63 74 20 22 22 0a 09 20 20 20 20 et dict ""..
13a0: 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 }..} else {..
13b0: 20 73 65 74 20 64 69 63 74 20 24 6f 70 74 69 6f set dict $optio
13c0: 6e 73 28 2d 64 69 63 74 29 0a 09 7d 0a 09 69 66 ns(-dict)..}..if
13d0: 20 7b 20 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 { ![info exists
13e0: 20 76 5d 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 v] } {.. set
13f0: 20 76 20 22 22 0a 09 20 20 20 20 66 6f 72 65 61 v "".. forea
1400: 63 68 20 76 61 6c 75 65 20 5b 24 73 65 6c 66 20 ch value [$self
1410: 63 67 65 74 20 2d 5f 76 61 6c 75 65 73 5d 20 7b cget -_values] {
1420: 0a 09 09 63 61 74 63 68 20 7b 20 0a 09 09 20 20 ...catch { ...
1430: 20 20 73 65 74 20 76 61 6c 75 65 20 5b 64 69 63 set value [dic
1440: 74 20 67 65 74 20 5b 64 69 63 74 5f 69 6e 76 65 t get [dict_inve
1450: 72 73 65 20 24 64 69 63 74 5d 20 24 76 61 6c 75 rse $dict] $valu
1460: 65 5d 0a 09 09 7d 0a 09 09 6c 61 70 70 65 6e 64 e]...}...lappend
1470: 20 76 20 24 76 61 6c 75 65 0a 09 20 20 20 20 7d v $value.. }
1480: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
1490: 73 65 74 20 76 74 72 61 6e 73 20 22 22 0a 09 20 set vtrans ""..
14a0: 20 20 20 66 6f 72 65 61 63 68 20 76 61 6c 75 65 foreach value
14b0: 20 24 76 20 7b 0a 09 09 63 61 74 63 68 20 7b 20 $v {...catch {
14c0: 73 65 74 20 76 61 6c 75 65 20 5b 64 69 63 74 20 set value [dict
14d0: 67 65 74 20 24 64 69 63 74 20 24 76 61 6c 75 65 get $dict $value
14e0: 5d 20 7d 0a 09 09 6c 61 70 70 65 6e 64 20 76 74 ] }...lappend vt
14f0: 72 61 6e 73 20 24 76 61 6c 75 65 0a 09 20 20 20 rans $value..
1500: 20 7d 0a 09 20 20 20 20 24 73 65 6c 66 20 63 6f }.. $self co
1510: 6e 66 69 67 75 72 65 20 2d 5f 76 61 6c 75 65 73 nfigure -_values
1520: 20 24 76 74 72 61 6e 73 0a 09 7d 0a 09 74 72 61 $vtrans..}..tra
1530: 63 65 20 61 64 64 20 76 61 72 69 61 62 6c 65 20 ce add variable
1540: 76 20 77 72 69 74 65 20 22 5b 6d 79 6d 65 74 68 v write "[mymeth
1550: 6f 64 20 5f 63 68 61 6e 67 65 64 5f 76 61 6c 75 od _changed_valu
1560: 65 73 5f 76 61 72 5d 3b 23 22 0a 20 20 20 20 7d es_var];#". }
1570: 0a 20 20 20 20 6f 6e 63 6f 6e 66 69 67 75 72 65 . onconfigure
1580: 20 2d 64 69 63 74 20 7b 76 61 6c 75 65 7d 20 7b -dict {value} {
1590: 0a 09 73 65 74 20 6f 70 74 69 6f 6e 73 28 2d 64 ..set options(-d
15a0: 69 63 74 29 20 24 76 61 6c 75 65 0a 09 24 73 65 ict) $value..$se
15b0: 6c 66 20 5f 63 68 61 6e 67 65 64 5f 76 61 6c 75 lf _changed_valu
15c0: 65 73 5f 76 61 72 0a 20 20 20 20 7d 0a 20 20 20 es_var. }.
15d0: 20 6f 6e 63 6f 6e 66 69 67 75 72 65 20 2d 76 61 onconfigure -va
15e0: 6c 75 65 73 20 7b 76 61 6c 75 65 73 7d 20 7b 0a lues {values} {.
15f0: 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d .if { $options(-
1600: 76 61 6c 75 65 73 76 61 72 69 61 62 6c 65 29 20 valuesvariable)
1610: 6e 65 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 75 ne "" } {.. u
1620: 70 76 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 pvar #0 $options
1630: 28 2d 76 61 6c 75 65 73 76 61 72 69 61 62 6c 65 (-valuesvariable
1640: 29 20 76 0a 09 20 20 20 20 73 65 74 20 76 20 24 ) v.. set v $
1650: 76 61 6c 75 65 73 0a 09 7d 20 65 6c 73 65 20 7b values..} else {
1660: 0a 09 20 20 20 20 69 66 20 7b 20 24 6f 70 74 69 .. if { $opti
1670: 6f 6e 73 28 2d 64 69 63 74 76 61 72 69 61 62 6c ons(-dictvariabl
1680: 65 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 09 75 e) ne "" } {...u
1690: 70 76 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 pvar #0 $options
16a0: 28 2d 64 69 63 74 76 61 72 69 61 62 6c 65 29 20 (-dictvariable)
16b0: 76 64 0a 09 09 69 66 20 7b 20 5b 69 6e 66 6f 20 vd...if { [info
16c0: 65 78 69 73 74 73 20 76 64 5d 20 7d 20 7b 0a 09 exists vd] } {..
16d0: 09 20 20 20 20 73 65 74 20 64 69 63 74 20 24 76 . set dict $v
16e0: 64 0a 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 d...} else {...
16f0: 20 20 20 73 65 74 20 64 69 63 74 20 22 22 0a 09 set dict ""..
1700: 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b .}.. } else {
1710: 0a 09 09 73 65 74 20 64 69 63 74 20 24 6f 70 74 ...set dict $opt
1720: 69 6f 6e 73 28 2d 64 69 63 74 29 0a 09 20 20 20 ions(-dict)..
1730: 20 7d 0a 09 20 20 20 20 73 65 74 20 76 74 72 61 }.. set vtra
1740: 6e 73 20 22 22 0a 09 20 20 20 20 66 6f 72 65 61 ns "".. forea
1750: 63 68 20 76 61 6c 75 65 20 24 76 61 6c 75 65 73 ch value $values
1760: 20 7b 0a 09 09 63 61 74 63 68 20 7b 20 73 65 74 {...catch { set
1770: 20 76 61 6c 75 65 20 5b 64 69 63 74 20 67 65 74 value [dict get
1780: 20 24 64 69 63 74 20 24 76 61 6c 75 65 5d 20 7d $dict $value] }
1790: 0a 09 09 6c 61 70 70 65 6e 64 20 76 74 72 61 6e ...lappend vtran
17a0: 73 20 24 76 61 6c 75 65 0a 09 20 20 20 20 7d 0a s $value.. }.
17b0: 09 20 20 20 20 24 73 65 6c 66 20 63 6f 6e 66 69 . $self confi
17c0: 67 75 72 65 20 2d 5f 76 61 6c 75 65 73 20 24 76 gure -_values $v
17d0: 74 72 61 6e 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 trans..}. }.
17e0: 20 20 20 6f 6e 63 67 65 74 20 2d 76 61 6c 75 65 oncget -value
17f0: 73 20 7b 0a 09 73 65 74 20 76 20 22 22 0a 09 66 s {..set v ""..f
1800: 6f 72 65 61 63 68 20 76 61 6c 75 65 20 5b 24 73 oreach value [$s
1810: 65 6c 66 20 63 67 65 74 20 2d 5f 76 61 6c 75 65 elf cget -_value
1820: 73 5d 20 7b 0a 23 20 20 20 20 20 20 20 20 20 20 s] {.#
1830: 20 20 20 63 61 74 63 68 20 7b 0a 23 20 20 20 20 catch {.#
1840: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
1850: 20 76 61 6c 75 65 20 5b 64 69 63 74 20 67 65 74 value [dict get
1860: 20 5b 64 69 63 74 5f 69 6e 76 65 72 73 65 20 24 [dict_inverse $
1870: 6f 70 74 69 6f 6e 73 28 2d 64 69 63 74 29 5d 20 options(-dict)]
1880: 24 76 61 6c 75 65 5d 0a 23 20 20 20 20 20 20 20 $value].#
1890: 20 20 20 20 20 20 7d 0a 09 20 20 20 20 6c 61 70 }.. lap
18a0: 70 65 6e 64 20 76 20 24 76 61 6c 75 65 0a 09 7d pend v $value..}
18b0: 0a 09 72 65 74 75 72 6e 20 24 76 0a 20 20 20 20 ..return $v.
18c0: 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 5f 63 68 }. method _ch
18d0: 61 6e 67 65 64 5f 76 61 6c 75 65 73 5f 76 61 72 anged_values_var
18e0: 20 7b 7d 20 7b 0a 09 69 66 20 7b 20 24 6f 70 74 {} {..if { $opt
18f0: 69 6f 6e 73 28 2d 76 61 6c 75 65 73 76 61 72 69 ions(-valuesvari
1900: 61 62 6c 65 29 20 6e 65 20 22 22 20 7d 20 7b 0a able) ne "" } {.
1910: 09 20 20 20 20 75 70 76 61 72 20 23 30 20 24 6f . upvar #0 $o
1920: 70 74 69 6f 6e 73 28 2d 76 61 6c 75 65 73 76 61 ptions(-valuesva
1930: 72 69 61 62 6c 65 29 20 76 0a 09 7d 20 65 6c 73 riable) v..} els
1940: 65 20 7b 0a 09 20 20 20 20 73 65 74 20 76 20 5b e {.. set v [
1950: 24 73 65 6c 66 20 63 67 65 74 20 2d 76 61 6c 75 $self cget -valu
1960: 65 73 5d 0a 09 7d 0a 09 69 66 20 7b 20 24 6f 70 es]..}..if { $op
1970: 74 69 6f 6e 73 28 2d 64 69 63 74 76 61 72 69 61 tions(-dictvaria
1980: 62 6c 65 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 ble) ne "" } {..
1990: 20 20 20 20 75 70 76 61 72 20 23 30 20 24 6f 70 upvar #0 $op
19a0: 74 69 6f 6e 73 28 2d 64 69 63 74 76 61 72 69 61 tions(-dictvaria
19b0: 62 6c 65 29 20 76 64 0a 09 20 20 20 20 69 66 20 ble) vd.. if
19c0: 7b 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 76 { [info exists v
19d0: 64 5d 20 7d 20 7b 0a 09 09 73 65 74 20 64 69 63 d] } {...set dic
19e0: 74 20 24 76 64 0a 09 20 20 20 20 7d 20 65 6c 73 t $vd.. } els
19f0: 65 20 7b 0a 09 09 73 65 74 20 64 69 63 74 20 22 e {...set dict "
1a00: 22 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 ".. }..} else
1a10: 20 7b 0a 09 20 20 20 20 73 65 74 20 64 69 63 74 {.. set dict
1a20: 20 24 6f 70 74 69 6f 6e 73 28 2d 64 69 63 74 29 $options(-dict)
1a30: 0a 09 7d 0a 09 73 65 74 20 76 74 72 61 6e 73 20 ..}..set vtrans
1a40: 22 22 0a 09 66 6f 72 65 61 63 68 20 76 61 6c 75 ""..foreach valu
1a50: 65 20 24 76 20 7b 0a 09 20 20 20 20 63 61 74 63 e $v {.. catc
1a60: 68 20 7b 20 73 65 74 20 76 61 6c 75 65 20 5b 64 h { set value [d
1a70: 69 63 74 20 67 65 74 20 24 64 69 63 74 20 24 76 ict get $dict $v
1a80: 61 6c 75 65 5d 20 7d 0a 09 20 20 20 20 6c 61 70 alue] }.. lap
1a90: 70 65 6e 64 20 76 74 72 61 6e 73 20 24 76 61 6c pend vtrans $val
1aa0: 75 65 0a 09 7d 0a 09 24 73 65 6c 66 20 63 6f 6e ue..}..$self con
1ab0: 66 69 67 75 72 65 20 2d 5f 76 61 6c 75 65 73 20 figure -_values
1ac0: 24 76 74 72 61 6e 73 0a 09 24 73 65 6c 66 20 5f $vtrans..$self _
1ad0: 77 72 69 74 74 65 6e 5f 74 65 78 74 76 61 72 69 written_textvari
1ae0: 61 62 6c 65 0a 20 20 20 20 7d 0a 20 20 20 20 6d able. }. m
1af0: 65 74 68 6f 64 20 5f 77 72 69 74 74 65 6e 5f 74 ethod _written_t
1b00: 65 78 74 76 61 72 69 61 62 6c 65 20 7b 20 61 72 extvariable { ar
1b10: 67 73 20 7d 20 7b 0a 0a 09 73 65 74 20 6f 70 74 gs } {...set opt
1b20: 69 6f 6e 61 6c 20 7b 0a 09 20 20 20 20 7b 20 2d ional {.. { -
1b30: 66 6f 72 63 65 5f 64 69 63 74 20 22 22 20 30 20 force_dict "" 0
1b40: 7d 0a 09 7d 0a 09 73 65 74 20 63 6f 6d 70 75 6c }..}..set compul
1b50: 73 6f 72 79 20 22 22 0a 09 70 61 72 73 65 5f 61 sory ""..parse_a
1b60: 72 67 73 20 24 6f 70 74 69 6f 6e 61 6c 20 24 63 rgs $optional $c
1b70: 6f 6d 70 75 6c 73 6f 72 79 20 24 61 72 67 73 0a ompulsory $args.
1b80: 0a 09 75 70 76 61 72 20 23 30 20 24 6f 70 74 69 ..upvar #0 $opti
1b90: 6f 6e 73 28 2d 74 65 78 74 76 61 72 69 61 62 6c ons(-textvariabl
1ba0: 65 29 20 76 0a 09 69 66 20 7b 20 21 5b 69 6e 66 e) v..if { ![inf
1bb0: 6f 20 65 78 69 73 74 73 20 76 5d 20 7d 20 7b 20 o exists v] } {
1bc0: 72 65 74 75 72 6e 20 7d 0a 09 73 65 74 20 76 61 return }..set va
1bd0: 6c 75 65 20 24 76 0a 09 69 66 20 7b 20 24 6f 70 lue $v..if { $op
1be0: 74 69 6f 6e 73 28 2d 64 69 63 74 76 61 72 69 61 tions(-dictvaria
1bf0: 62 6c 65 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 ble) ne "" } {..
1c00: 20 20 20 20 75 70 76 61 72 20 23 30 20 24 6f 70 upvar #0 $op
1c10: 74 69 6f 6e 73 28 2d 64 69 63 74 76 61 72 69 61 tions(-dictvaria
1c20: 62 6c 65 29 20 76 64 0a 09 20 20 20 20 69 66 20 ble) vd.. if
1c30: 7b 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 76 { [info exists v
1c40: 64 5d 20 7d 20 7b 0a 09 09 73 65 74 20 64 69 63 d] } {...set dic
1c50: 74 20 24 76 64 0a 09 20 20 20 20 7d 20 65 6c 73 t $vd.. } els
1c60: 65 20 7b 0a 09 09 73 65 74 20 64 69 63 74 20 22 e {...set dict "
1c70: 22 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 ".. }..} else
1c80: 20 7b 0a 09 20 20 20 20 73 65 74 20 64 69 63 74 {.. set dict
1c90: 20 24 6f 70 74 69 6f 6e 73 28 2d 64 69 63 74 29 $options(-dict)
1ca0: 0a 09 7d 0a 09 69 66 20 7b 20 24 66 6f 72 63 65 ..}..if { $force
1cb0: 5f 64 69 63 74 20 7c 7c 20 5b 24 73 65 6c 66 20 _dict || [$self
1cc0: 69 6e 73 74 61 74 65 20 72 65 61 64 6f 6e 6c 79 instate readonly
1cd0: 5d 20 7d 20 7b 0a 09 20 20 20 20 63 61 74 63 68 ] } {.. catch
1ce0: 20 7b 20 73 65 74 20 76 61 6c 75 65 20 5b 64 69 { set value [di
1cf0: 63 74 20 67 65 74 20 24 64 69 63 74 20 24 76 61 ct get $dict $va
1d00: 6c 75 65 5d 20 7d 0a 09 7d 0a 09 69 66 20 7b 20 lue] }..}..if {
1d10: 24 5f 74 72 61 6e 73 6c 61 74 65 64 5f 74 65 78 $_translated_tex
1d20: 74 76 61 72 69 61 62 6c 65 20 6e 65 20 24 76 61 tvariable ne $va
1d30: 6c 75 65 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 lue } {.. set
1d40: 20 5f 74 72 61 6e 73 6c 61 74 65 64 5f 74 65 78 _translated_tex
1d50: 74 76 61 72 69 61 62 6c 65 20 24 76 61 6c 75 65 tvariable $value
1d60: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 ..}. }. me
1d70: 74 68 6f 64 20 5f 72 65 61 64 5f 74 65 78 74 76 thod _read_textv
1d80: 61 72 69 61 62 6c 65 20 7b 7d 20 7b 0a 09 75 70 ariable {} {..up
1d90: 76 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 var #0 $options(
1da0: 2d 74 65 78 74 76 61 72 69 61 62 6c 65 29 20 76 -textvariable) v
1db0: 0a 09 73 65 74 20 76 61 6c 75 65 20 24 5f 74 72 ..set value $_tr
1dc0: 61 6e 73 6c 61 74 65 64 5f 74 65 78 74 76 61 72 anslated_textvar
1dd0: 69 61 62 6c 65 0a 09 69 66 20 7b 20 24 6f 70 74 iable..if { $opt
1de0: 69 6f 6e 73 28 2d 64 69 63 74 76 61 72 69 61 62 ions(-dictvariab
1df0: 6c 65 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 20 le) ne "" } {..
1e00: 20 20 20 75 70 76 61 72 20 23 30 20 24 6f 70 74 upvar #0 $opt
1e10: 69 6f 6e 73 28 2d 64 69 63 74 76 61 72 69 61 62 ions(-dictvariab
1e20: 6c 65 29 20 76 64 0a 09 20 20 20 20 69 66 20 7b le) vd.. if {
1e30: 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 76 64 [info exists vd
1e40: 5d 20 7d 20 7b 0a 09 09 73 65 74 20 64 69 63 74 ] } {...set dict
1e50: 20 24 76 64 0a 09 20 20 20 20 7d 20 65 6c 73 65 $vd.. } else
1e60: 20 7b 0a 09 09 73 65 74 20 64 69 63 74 20 22 22 {...set dict ""
1e70: 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 .. }..} else
1e80: 7b 0a 09 20 20 20 20 73 65 74 20 64 69 63 74 20 {.. set dict
1e90: 24 6f 70 74 69 6f 6e 73 28 2d 64 69 63 74 29 0a $options(-dict).
1ea0: 09 7d 0a 09 63 61 74 63 68 20 7b 0a 09 20 20 20 .}..catch {..
1eb0: 20 73 65 74 20 76 61 6c 75 65 20 5b 64 69 63 74 set value [dict
1ec0: 20 67 65 74 20 5b 64 69 63 74 5f 69 6e 76 65 72 get [dict_inver
1ed0: 73 65 20 24 64 69 63 74 5d 20 24 76 61 6c 75 65 se $dict] $value
1ee0: 5d 0a 09 7d 0a 09 69 66 20 7b 20 21 5b 69 6e 66 ]..}..if { ![inf
1ef0: 6f 20 65 78 69 73 74 73 20 76 5d 20 7c 7c 20 24 o exists v] || $
1f00: 76 20 6e 65 20 24 76 61 6c 75 65 20 7d 20 7b 0a v ne $value } {.
1f10: 09 20 20 20 20 73 65 74 20 76 20 24 76 61 6c 75 . set v $valu
1f20: 65 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6d e..}. }. m
1f30: 65 74 68 6f 64 20 5f 77 72 69 74 74 65 6e 5f 73 ethod _written_s
1f40: 74 61 74 65 76 61 72 69 61 62 6c 65 20 7b 7d 20 tatevariable {}
1f50: 7b 0a 09 75 70 76 61 72 20 23 30 20 24 6f 70 74 {..upvar #0 $opt
1f60: 69 6f 6e 73 28 2d 73 74 61 74 65 76 61 72 69 61 ions(-statevaria
1f70: 62 6c 65 29 20 76 0a 09 24 73 65 6c 66 20 73 74 ble) v..$self st
1f80: 61 74 65 20 24 76 0a 20 20 20 20 7d 0a 20 20 20 ate $v. }.
1f90: 20 6d 65 74 68 6f 64 20 5f 72 65 61 64 5f 73 74 method _read_st
1fa0: 61 74 65 76 61 72 69 61 62 6c 65 20 7b 7d 20 7b atevariable {} {
1fb0: 0a 09 75 70 76 61 72 20 23 30 20 24 6f 70 74 69 ..upvar #0 $opti
1fc0: 6f 6e 73 28 2d 73 74 61 74 65 76 61 72 69 61 62 ons(-statevariab
1fd0: 6c 65 29 20 76 0a 09 73 65 74 20 76 20 5b 24 73 le) v..set v [$s
1fe0: 65 6c 66 20 73 74 61 74 65 5d 0a 20 20 20 20 7d elf state]. }
1ff0: 0a 20 20 20 20 6d 65 74 68 6f 64 20 63 6f 6d 62 . method comb
2000: 6f 62 6f 78 5f 73 65 6c 65 63 74 65 64 20 7b 7d obox_selected {}
2010: 20 7b 0a 09 69 66 20 7b 20 21 5b 24 73 65 6c 66 {..if { ![$self
2020: 20 69 6e 73 74 61 74 65 20 72 65 61 64 6f 6e 6c instate readonl
2030: 79 5d 20 7d 20 7b 0a 09 20 20 20 20 24 73 65 6c y] } {.. $sel
2040: 66 20 5f 77 72 69 74 74 65 6e 5f 74 65 78 74 76 f _written_textv
2050: 61 72 69 61 62 6c 65 20 2d 66 6f 72 63 65 5f 64 ariable -force_d
2060: 69 63 74 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a ict..}. }.}..
2070: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2080: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2090: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
20a0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
20b0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
20c0: 0a 23 20 63 75 3a 3a 6d 75 6c 74 69 6c 69 6e 65 .# cu::multiline
20d0: 5f 65 6e 74 72 79 0a 23 23 23 23 23 23 23 23 23 _entry.#########
20e0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
20f0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2100: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2110: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2120: 23 23 23 23 23 23 23 0a 0a 73 6e 69 74 3a 3a 77 #######..snit::w
2130: 69 64 67 65 74 20 63 75 3a 3a 6d 75 6c 74 69 6c idget cu::multil
2140: 69 6e 65 5f 65 6e 74 72 79 20 7b 0a 20 20 20 20 ine_entry {.
2150: 6f 70 74 69 6f 6e 20 2d 74 65 78 74 76 61 72 69 option -textvari
2160: 61 62 6c 65 20 22 22 0a 20 20 20 20 6f 70 74 69 able "". opti
2170: 6f 6e 20 2d 74 61 6b 65 66 6f 63 75 73 20 30 20 on -takefocus 0
2180: 3b 23 20 6f 70 74 69 6f 6e 20 75 73 65 64 20 62 ;# option used b
2190: 79 20 74 68 65 20 74 61 62 20 73 74 61 6e 64 61 y the tab standa
21a0: 72 64 20 62 69 6e 64 69 6e 67 73 0a 20 20 20 20 rd bindings.
21b0: 6f 70 74 69 6f 6e 20 2d 76 61 6c 75 65 73 20 22 option -values "
21c0: 22 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d 76 61 ". option -va
21d0: 6c 75 65 73 76 61 72 69 61 62 6c 65 20 22 22 0a luesvariable "".
21e0: 0a 20 20 20 20 68 75 6c 6c 74 79 70 65 20 66 72 . hulltype fr
21f0: 61 6d 65 0a 0a 20 20 20 20 76 61 72 69 61 62 6c ame.. variabl
2200: 65 20 74 65 78 74 0a 0a 20 20 20 20 64 65 6c 65 e text.. dele
2210: 67 61 74 65 20 6d 65 74 68 6f 64 20 2a 20 74 6f gate method * to
2220: 20 74 65 78 74 0a 20 20 20 20 64 65 6c 65 67 61 text. delega
2230: 74 65 20 6f 70 74 69 6f 6e 20 2a 20 74 6f 20 74 te option * to t
2240: 65 78 74 0a 0a 20 20 20 20 63 6f 6e 73 74 72 75 ext.. constru
2250: 63 74 6f 72 20 61 72 67 73 20 7b 0a 0a 09 24 68 ctor args {...$h
2260: 75 6c 6c 20 63 6f 6e 66 69 67 75 72 65 20 2d 62 ull configure -b
2270: 61 63 6b 67 72 6f 75 6e 64 20 23 61 34 62 39 37 ackground #a4b97
2280: 66 20 2d 62 64 20 30 0a 09 69 6e 73 74 61 6c 6c f -bd 0..install
2290: 20 74 65 78 74 20 75 73 69 6e 67 20 74 65 78 74 text using text
22a0: 20 24 77 69 6e 2e 74 20 2d 77 72 61 70 20 77 6f $win.t -wrap wo
22b0: 72 64 20 2d 62 64 20 30 20 2d 77 69 64 74 68 20 rd -bd 0 -width
22c0: 34 30 20 2d 68 65 69 67 68 74 20 33 0a 09 0a 09 40 -height 3....
22d0: 63 75 3a 3a 61 64 64 5f 63 6f 6e 74 65 78 74 75 cu::add_contextu
22e0: 61 6c 5f 6d 65 6e 75 5f 74 6f 5f 65 6e 74 72 79 al_menu_to_entry
22f0: 20 24 74 65 78 74 20 69 6e 69 74 0a 0a 09 67 72 $text init...gr
2300: 69 64 20 24 74 65 78 74 20 2d 70 61 64 78 20 31 id $text -padx 1
2310: 20 2d 70 61 64 79 20 31 20 2d 73 74 69 63 6b 79 -pady 1 -sticky
2320: 20 6e 73 65 77 0a 09 67 72 69 64 20 63 6f 6c 75 nsew..grid colu
2330: 6d 6e 63 6f 6e 66 69 67 75 72 65 20 24 77 69 6e mnconfigure $win
2340: 20 30 20 2d 77 65 69 67 68 74 20 31 0a 09 67 72 0 -weight 1..gr
2350: 69 64 20 72 6f 77 63 6f 6e 66 69 67 75 72 65 20 id rowconfigure
2360: 24 77 69 6e 20 30 20 2d 77 65 69 67 68 74 20 31 $win 0 -weight 1
2370: 0a 0a 09 62 69 6e 64 20 24 74 65 78 74 20 3c 54 ...bind $text <T
2380: 61 62 3e 20 22 5b 62 69 6e 64 20 61 6c 6c 20 3c ab> "[bind all <
2390: 54 61 62 3e 5d 20 3b 20 62 72 65 61 6b 22 0a 09 Tab>] ; break"..
23a0: 62 69 6e 64 20 24 74 65 78 74 20 3c 3c 50 72 65 bind $text <<Pre
23b0: 76 57 69 6e 64 6f 77 3e 3e 20 22 5b 62 69 6e 64 vWindow>> "[bind
23c0: 20 61 6c 6c 20 3c 3c 50 72 65 76 57 69 6e 64 6f all <<PrevWindo
23d0: 77 3e 3e 5d 20 3b 20 62 72 65 61 6b 22 0a 09 62 w>>] ; break"..b
23e0: 69 6e 64 74 61 67 73 20 24 74 65 78 74 20 5b 6c indtags $text [l
23f0: 69 73 74 20 24 77 69 6e 20 24 74 65 78 74 20 5b ist $win $text [
2400: 77 69 6e 66 6f 20 63 6c 61 73 73 20 24 77 69 6e winfo class $win
2410: 5d 20 5b 77 69 6e 66 6f 20 63 6c 61 73 73 20 24 ] [winfo class $
2420: 74 65 78 74 5d 20 5b 77 69 6e 66 6f 20 74 6f 70 text] [winfo top
2430: 6c 65 76 65 6c 20 24 74 65 78 74 5d 20 61 6c 6c level $text] all
2440: 5d 0a 09 62 69 6e 64 20 24 77 69 6e 20 3c 46 6f ]..bind $win <Fo
2450: 63 75 73 49 6e 3e 20 5b 6c 69 73 74 20 66 6f 63 cusIn> [list foc
2460: 75 73 20 24 74 65 78 74 5d 0a 09 24 73 65 6c 66 us $text]..$self
2470: 20 63 6f 6e 66 69 67 75 72 65 6c 69 73 74 20 24 configurelist $
2480: 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 64 args. }. d
2490: 65 73 74 72 75 63 74 6f 72 20 7b 0a 09 24 73 65 estructor {..$se
24a0: 6c 66 20 5f 63 6c 65 61 6e 5f 74 72 61 63 65 73 lf _clean_traces
24b0: 0a 20 20 20 20 7d 0a 20 20 20 20 6f 6e 63 6f 6e . }. oncon
24c0: 66 69 67 75 72 65 20 2d 74 65 78 74 76 61 72 69 figure -textvari
24d0: 61 62 6c 65 20 7b 76 61 6c 75 65 7d 20 7b 0a 09 able {value} {..
24e0: 24 73 65 6c 66 20 5f 63 6c 65 61 6e 5f 74 72 61 $self _clean_tra
24f0: 63 65 73 0a 09 73 65 74 20 6f 70 74 69 6f 6e 73 ces..set options
2500: 28 2d 74 65 78 74 76 61 72 69 61 62 6c 65 29 20 (-textvariable)
2510: 24 76 61 6c 75 65 0a 0a 09 73 65 74 20 63 6d 64 $value...set cmd
2520: 20 22 5b 6d 79 6d 65 74 68 6f 64 20 5f 63 68 65 "[mymethod _che
2530: 63 6b 5f 74 65 78 74 76 61 72 69 61 62 6c 65 5f ck_textvariable_
2540: 72 65 61 64 5d 20 3b 23 22 0a 09 74 72 61 63 65 read] ;#"..trace
2550: 20 61 64 64 20 76 61 72 69 61 62 6c 65 20 24 6f add variable $o
2560: 70 74 69 6f 6e 73 28 2d 74 65 78 74 76 61 72 69 ptions(-textvari
2570: 61 62 6c 65 29 20 72 65 61 64 20 24 63 6d 64 0a able) read $cmd.
2580: 09 73 65 74 20 63 6d 64 20 22 5b 6d 79 6d 65 74 .set cmd "[mymet
2590: 68 6f 64 20 5f 63 68 65 63 6b 5f 74 65 78 74 76 hod _check_textv
25a0: 61 72 69 61 62 6c 65 5f 77 72 69 74 65 5d 20 3b ariable_write] ;
25b0: 23 22 0a 09 74 72 61 63 65 20 61 64 64 20 76 61 #"..trace add va
25c0: 72 69 61 62 6c 65 20 24 6f 70 74 69 6f 6e 73 28 riable $options(
25d0: 2d 74 65 78 74 76 61 72 69 61 62 6c 65 29 20 77 -textvariable) w
25e0: 72 69 74 65 20 24 63 6d 64 0a 20 20 20 20 7d 0a rite $cmd. }.
25f0: 20 20 20 20 6f 6e 63 6f 6e 66 69 67 75 72 65 20 onconfigure
2600: 2d 76 61 6c 75 65 73 20 7b 76 61 6c 75 65 7d 20 -values {value}
2610: 7b 0a 09 73 65 74 20 6f 70 74 69 6f 6e 73 28 2d {..set options(-
2620: 76 61 6c 75 65 73 29 20 24 76 61 6c 75 65 0a 09 values) $value..
2630: 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 ..if { $options(
2640: 2d 76 61 6c 75 65 73 29 20 6e 65 20 22 22 20 7c -values) ne "" |
2650: 7c 20 24 6f 70 74 69 6f 6e 73 28 2d 76 61 6c 75 | $options(-valu
2660: 65 73 76 61 72 69 61 62 6c 65 29 20 6e 65 20 22 esvariable) ne "
2670: 22 20 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 " } {.. if {
2680: 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 24 ![winfo exists $
2690: 77 69 6e 2e 62 5d 20 7d 20 7b 0a 09 09 69 6d 61 win.b] } {...ima
26a0: 67 65 20 63 72 65 61 74 65 20 70 68 6f 74 6f 20 ge create photo
26b0: 63 75 3a 3a 6d 75 6c 74 69 6c 69 6e 65 5f 65 6e cu::multiline_en
26c0: 74 72 79 3a 3a 6e 61 76 31 64 6f 77 6e 61 72 72 try::nav1downarr
26d0: 6f 77 31 36 20 2d 64 61 74 61 20 7b 0a 09 09 20 ow16 -data {...
26e0: 20 20 20 52 30 6c 47 4f 44 6c 68 45 41 41 51 41 R0lGODlhEAAQA
26f0: 49 41 41 41 50 77 43 42 41 51 43 42 43 48 35 42 IAAAPwCBAQCBCH5B
2700: 41 45 41 41 41 41 41 4c 41 41 41 41 41 41 51 41 AEAAAAALAAAAAAQA
2710: 42 41 41 41 41 49 59 68 49 2b 70 79 2b 30 50 55 BAAAAIYhI+py+0PU
2720: 5a 69 30 7a 6d 54 74 79 70 66 6c 56 30 56 64 0a Zi0zmTtypflV0Vd.
2730: 09 09 20 20 20 20 52 4a 62 6d 36 66 67 46 41 43 .. RJbm6fgFAC
2740: 48 2b 61 45 4e 79 5a 57 46 30 5a 57 51 67 59 6e H+aENyZWF0ZWQgYn
2750: 6b 67 51 6b 31 51 56 47 39 48 53 55 59 67 55 48 kgQk1QVG9HSUYgUH
2760: 4a 76 49 48 5a 6c 63 6e 4e 70 62 32 34 67 4d 69 JvIHZlcnNpb24gMi
2770: 34 31 44 51 71 70 49 45 52 6c 64 6d 56 73 51 32 41DQqpIERldmVsQ2
2780: 39 79 0a 09 09 20 20 20 20 49 44 45 35 4f 54 63 9y... IDE5OTc
2790: 73 4d 54 6b 35 4f 43 34 67 51 57 78 73 49 48 4a sMTk5OC4gQWxsIHJ
27a0: 70 5a 32 68 30 63 79 42 79 5a 58 4e 6c 63 6e 5a pZ2h0cyByZXNlcnZ
27b0: 6c 5a 43 34 4e 43 6d 68 30 64 48 41 36 4c 79 39 lZC4NCmh0dHA6Ly9
27c0: 33 64 33 63 75 5a 47 56 32 5a 57 78 6a 62 33 49 3d3cuZGV2ZWxjb3I
27d0: 75 59 32 39 74 0a 09 09 20 20 20 20 41 44 73 3d uY29t... ADs=
27e0: 0a 09 09 7d 0a 09 09 74 74 6b 3a 3a 6d 65 6e 75 ...}...ttk::menu
27f0: 62 75 74 74 6f 6e 20 24 77 69 6e 2e 62 20 2d 69 button $win.b -i
2800: 6d 61 67 65 20 63 75 3a 3a 6d 75 6c 74 69 6c 69 mage cu::multili
2810: 6e 65 5f 65 6e 74 72 79 3a 3a 6e 61 76 31 64 6f ne_entry::nav1do
2820: 77 6e 61 72 72 6f 77 31 36 20 2d 73 74 79 6c 65 wnarrow16 -style
2830: 20 54 6f 6f 6c 62 75 74 74 6f 6e 20 2d 6d 65 6e Toolbutton -men
2840: 75 20 24 77 69 6e 2e 62 2e 6d 0a 09 09 6d 65 6e u $win.b.m...men
2850: 75 20 24 77 69 6e 2e 62 2e 6d 20 2d 74 65 61 72 u $win.b.m -tear
2860: 6f 66 66 20 30 0a 09 09 67 72 69 64 20 24 77 69 off 0...grid $wi
2870: 6e 2e 62 20 2d 72 6f 77 20 30 20 2d 63 6f 6c 75 n.b -row 0 -colu
2880: 6d 6e 20 31 20 2d 70 61 64 78 20 22 30 20 31 22 mn 1 -padx "0 1"
2890: 20 2d 70 61 64 79 20 31 20 2d 73 74 69 63 6b 79 -pady 1 -sticky
28a0: 20 77 6e 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 wns.. } else
28b0: 20 7b 0a 09 09 24 77 69 6e 2e 62 2e 6d 20 64 65 {...$win.b.m de
28c0: 6c 65 74 65 20 30 20 65 6e 64 0a 09 20 20 20 20 lete 0 end..
28d0: 7d 0a 09 20 20 20 20 24 77 69 6e 2e 62 2e 6d 20 }.. $win.b.m
28e0: 61 64 64 20 63 6f 6d 6d 61 6e 64 20 2d 6c 61 62 add command -lab
28f0: 65 6c 20 5b 5f 20 22 28 43 6c 65 61 72 29 22 5d el [_ "(Clear)"]
2900: 20 2d 63 6f 6d 6d 61 6e 64 20 5b 6d 79 6d 65 74 -command [mymet
2910: 68 6f 64 20 73 65 74 5f 74 65 78 74 20 22 22 5d hod set_text ""]
2920: 0a 09 20 20 20 20 24 77 69 6e 2e 62 2e 6d 20 61 .. $win.b.m a
2930: 64 64 20 73 65 70 61 72 61 74 6f 72 0a 09 20 20 dd separator..
2940: 20 20 66 6f 72 65 61 63 68 20 76 20 24 76 61 6c foreach v $val
2950: 75 65 20 7b 0a 09 09 69 66 20 7b 20 5b 73 74 72 ue {...if { [str
2960: 69 6e 67 20 6c 65 6e 67 74 68 20 24 76 5d 20 3e ing length $v] >
2970: 20 36 30 20 7d 20 7b 0a 09 09 20 20 20 20 73 65 60 } {... se
2980: 74 20 6c 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 t l [string rang
2990: 65 20 24 76 20 30 20 35 36 5d 2e 2e 2e 0a 09 09 e $v 0 56]......
29a0: 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 73 } else {... s
29b0: 65 74 20 6c 20 24 76 0a 09 09 7d 0a 09 09 24 77 et l $v...}...$w
29c0: 69 6e 2e 62 2e 6d 20 61 64 64 20 63 6f 6d 6d 61 in.b.m add comma
29d0: 6e 64 20 2d 6c 61 62 65 6c 20 24 6c 20 2d 63 6f nd -label $l -co
29e0: 6d 6d 61 6e 64 20 5b 6d 79 6d 65 74 68 6f 64 20 mmand [mymethod
29f0: 73 65 74 5f 74 65 78 74 20 24 76 5d 0a 09 20 20 set_text $v]..
2a00: 20 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 20 }..} elseif {
2a10: 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 24 ![winfo exists $
2a20: 77 69 6e 2e 62 5d 20 7d 20 7b 0a 09 20 20 20 20 win.b] } {..
2a30: 64 65 73 74 72 6f 79 20 24 77 69 6e 2e 62 0a 09 destroy $win.b..
2a40: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6f 6e 63 6f }. }. onco
2a50: 6e 66 69 67 75 72 65 20 2d 76 61 6c 75 65 73 76 nfigure -valuesv
2a60: 61 72 69 61 62 6c 65 20 7b 76 61 6c 75 65 7d 20 ariable {value}
2a70: 7b 0a 09 73 65 74 20 6f 70 74 69 6f 6e 73 28 2d {..set options(-
2a80: 76 61 6c 75 65 73 76 61 72 69 61 62 6c 65 29 20 valuesvariable)
2a90: 24 76 61 6c 75 65 0a 0a 09 75 70 76 61 72 20 23 $value...upvar #
2aa0: 30 20 24 6f 70 74 69 6f 6e 73 28 2d 76 61 6c 75 0 $options(-valu
2ab0: 65 73 76 61 72 69 61 62 6c 65 29 20 76 0a 0a 09 esvariable) v...
2ac0: 69 66 20 7b 20 5b 69 6e 66 6f 20 65 78 69 73 74 if { [info exist
2ad0: 73 20 76 5d 20 7d 20 7b 0a 09 20 20 20 20 24 73 s v] } {.. $s
2ae0: 65 6c 66 20 63 6f 6e 66 69 67 75 72 65 20 2d 76 elf configure -v
2af0: 61 6c 75 65 73 20 24 76 0a 09 7d 0a 09 74 72 61 alues $v..}..tra
2b00: 63 65 20 61 64 64 20 76 61 72 69 61 62 6c 65 20 ce add variable
2b10: 76 20 77 72 69 74 65 20 22 5b 6d 79 6d 65 74 68 v write "[mymeth
2b20: 6f 64 20 5f 63 68 61 6e 67 65 64 5f 76 61 6c 75 od _changed_valu
2b30: 65 73 5f 76 61 72 5d 3b 23 22 0a 20 20 20 20 7d es_var];#". }
2b40: 0a 20 20 20 20 6d 65 74 68 6f 64 20 73 65 74 5f . method set_
2b50: 74 65 78 74 20 7b 20 74 78 74 20 7d 20 7b 0a 09 text { txt } {..
2b60: 24 74 65 78 74 20 64 65 6c 65 74 65 20 31 2e 30 $text delete 1.0
2b70: 20 65 6e 64 0a 09 24 74 65 78 74 20 69 6e 73 65 end..$text inse
2b80: 72 74 20 65 6e 64 20 24 74 78 74 0a 09 24 74 65 rt end $txt..$te
2b90: 78 74 20 74 61 67 20 61 64 64 20 73 65 6c 20 31 xt tag add sel 1
2ba0: 2e 30 20 65 6e 64 2d 31 63 0a 09 66 6f 63 75 73 .0 end-1c..focus
2bb0: 20 24 74 65 78 74 0a 20 20 20 20 7d 0a 20 20 20 $text. }.
2bc0: 20 6d 65 74 68 6f 64 20 5f 63 6c 65 61 6e 5f 74 method _clean_t
2bd0: 72 61 63 65 73 20 7b 7d 20 7b 0a 09 69 66 20 7b races {} {..if {
2be0: 20 24 6f 70 74 69 6f 6e 73 28 2d 74 65 78 74 76 $options(-textv
2bf0: 61 72 69 61 62 6c 65 29 20 6e 65 20 22 22 20 7d ariable) ne "" }
2c00: 20 7b 0a 09 20 20 20 20 73 65 74 20 63 6d 64 20 {.. set cmd
2c10: 22 5b 6d 79 6d 65 74 68 6f 64 20 5f 63 68 65 63 "[mymethod _chec
2c20: 6b 5f 74 65 78 74 76 61 72 69 61 62 6c 65 5f 72 k_textvariable_r
2c30: 65 61 64 5d 20 3b 23 22 0a 09 20 20 20 20 74 72 ead] ;#".. tr
2c40: 61 63 65 20 72 65 6d 6f 76 65 20 76 61 72 69 61 ace remove varia
2c50: 62 6c 65 20 24 6f 70 74 69 6f 6e 73 28 2d 74 65 ble $options(-te
2c60: 78 74 76 61 72 69 61 62 6c 65 29 20 72 65 61 64 xtvariable) read
2c70: 20 24 63 6d 64 0a 09 20 20 20 20 73 65 74 20 63 $cmd.. set c
2c80: 6d 64 20 22 5b 6d 79 6d 65 74 68 6f 64 20 5f 63 md "[mymethod _c
2c90: 68 65 63 6b 5f 74 65 78 74 76 61 72 69 61 62 6c heck_textvariabl
2ca0: 65 5f 77 72 69 74 65 5d 20 3b 23 22 0a 09 20 20 e_write] ;#"..
2cb0: 20 20 74 72 61 63 65 20 72 65 6d 6f 76 65 20 76 trace remove v
2cc0: 61 72 69 61 62 6c 65 20 24 6f 70 74 69 6f 6e 73 ariable $options
2cd0: 28 2d 74 65 78 74 76 61 72 69 61 62 6c 65 29 20 (-textvariable)
2ce0: 77 72 69 74 65 20 24 63 6d 64 0a 09 7d 0a 09 69 write $cmd..}..i
2cf0: 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 76 61 f { $options(-va
2d00: 6c 75 65 73 76 61 72 69 61 62 6c 65 29 20 6e 65 luesvariable) ne
2d10: 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 75 70 76 "" } {.. upv
2d20: 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d ar #0 $options(-
2d30: 76 61 6c 75 65 73 76 61 72 69 61 62 6c 65 29 20 valuesvariable)
2d40: 76 0a 09 20 20 20 20 74 72 61 63 65 20 72 65 6d v.. trace rem
2d50: 6f 76 65 20 76 61 72 69 61 62 6c 65 20 76 20 77 ove variable v w
2d60: 72 69 74 65 20 22 5b 6d 79 6d 65 74 68 6f 64 20 rite "[mymethod
2d70: 5f 63 68 61 6e 67 65 64 5f 76 61 6c 75 65 73 5f _changed_values_
2d80: 76 61 72 5d 3b 23 22 0a 09 7d 0a 20 20 20 20 7d var];#"..}. }
2d90: 0a 20 20 20 20 6d 65 74 68 6f 64 20 5f 63 68 65 . method _che
2da0: 63 6b 5f 74 65 78 74 76 61 72 69 61 62 6c 65 5f ck_textvariable_
2db0: 72 65 61 64 20 7b 7d 20 7b 0a 09 75 70 76 61 72 read {} {..upvar
2dc0: 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d 74 65 #0 $options(-te
2dd0: 78 74 76 61 72 69 61 62 6c 65 29 20 76 0a 09 73 xtvariable) v..s
2de0: 65 74 20 76 20 5b 24 74 65 78 74 20 67 65 74 20 et v [$text get
2df0: 31 2e 30 20 65 6e 64 2d 31 63 5d 0a 20 20 20 20 1.0 end-1c].
2e00: 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 5f 63 68 }. method _ch
2e10: 65 63 6b 5f 74 65 78 74 76 61 72 69 61 62 6c 65 eck_textvariable
2e20: 5f 77 72 69 74 65 20 7b 7d 20 7b 0a 09 75 70 76 _write {} {..upv
2e30: 61 72 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 2d ar #0 $options(-
2e40: 74 65 78 74 76 61 72 69 61 62 6c 65 29 20 76 0a textvariable) v.
2e50: 09 24 74 65 78 74 20 64 65 6c 65 74 65 20 31 2e .$text delete 1.
2e60: 30 20 65 6e 64 0a 09 24 74 65 78 74 20 69 6e 73 0 end..$text ins
2e70: 65 72 74 20 65 6e 64 20 24 76 0a 20 20 20 20 7d ert end $v. }
2e80: 0a 20 20 20 20 6d 65 74 68 6f 64 20 5f 63 68 61 . method _cha
2e90: 6e 67 65 64 5f 76 61 6c 75 65 73 5f 76 61 72 20 nged_values_var
2ea0: 7b 7d 20 7b 0a 09 69 66 20 7b 20 24 6f 70 74 69 {} {..if { $opti
2eb0: 6f 6e 73 28 2d 76 61 6c 75 65 73 76 61 72 69 61 ons(-valuesvaria
2ec0: 62 6c 65 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 ble) ne "" } {..
2ed0: 20 20 20 20 75 70 76 61 72 20 23 30 20 24 6f 70 upvar #0 $op
2ee0: 74 69 6f 6e 73 28 2d 76 61 6c 75 65 73 76 61 72 tions(-valuesvar
2ef0: 69 61 62 6c 65 29 20 76 0a 09 20 20 20 20 24 73 iable) v.. $s
2f00: 65 6c 66 20 63 6f 6e 66 69 67 75 72 65 20 2d 76 elf configure -v
2f10: 61 6c 75 65 73 20 24 76 0a 09 7d 0a 20 20 20 20 alues $v..}.
2f20: 7d 0a 7d 0a 0a 23 23 23 23 23 23 23 23 23 23 23 }.}..###########
2f30: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2f40: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2f50: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2f60: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2f70: 23 23 23 23 23 0a 23 20 20 20 20 61 64 64 5f 63 #####.# add_c
2f80: 6f 6e 74 65 78 74 75 61 6c 5f 6d 65 6e 75 5f 74 ontextual_menu_t
2f90: 6f 5f 65 6e 74 72 79 0a 23 23 23 23 23 23 23 23 o_entry.########
2fa0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2fb0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2fc0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2fd0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
2fe0: 23 23 23 23 23 23 23 23 0a 0a 70 72 6f 63 20 63 ########..proc c
2ff0: 75 3a 3a 61 64 64 5f 63 6f 6e 74 65 78 74 75 61 u::add_contextua
3000: 6c 5f 6d 65 6e 75 5f 74 6f 5f 65 6e 74 72 79 20 l_menu_to_entry
3010: 7b 20 77 20 77 68 61 74 20 61 72 67 73 20 7d 20 { w what args }
3020: 7b 0a 20 20 20 20 73 77 69 74 63 68 20 24 77 68 {. switch $wh
3030: 61 74 20 7b 0a 09 69 6e 69 74 20 7b 0a 09 20 20 at {..init {..
3040: 20 20 62 69 6e 64 20 24 77 20 3c 42 75 74 74 6f bind $w <Butto
3050: 6e 52 65 6c 65 61 73 65 2d 33 3e 20 5b 6c 69 73 nRelease-3> [lis
3060: 74 20 63 75 3a 3a 61 64 64 5f 63 6f 6e 74 65 78 t cu::add_contex
3070: 74 75 61 6c 5f 6d 65 6e 75 5f 74 6f 5f 65 6e 74 tual_menu_to_ent
3080: 72 79 20 24 77 20 70 6f 73 74 20 25 58 20 25 59 ry $w post %X %Y
3090: 5d 0a 09 7d 0a 09 70 6f 73 74 20 7b 0a 09 20 20 ]..}..post {..
30a0: 20 20 6c 61 73 73 69 67 6e 20 24 61 72 67 73 20 lassign $args
30b0: 78 20 79 0a 09 20 20 20 20 73 65 74 20 6d 65 6e x y.. set men
30c0: 75 20 24 77 2e 6d 65 6e 75 0a 09 20 20 20 20 63 u $w.menu.. c
30d0: 61 74 63 68 20 7b 20 64 65 73 74 72 6f 79 20 24 atch { destroy $
30e0: 6d 65 6e 75 20 7d 0a 09 20 20 20 20 6d 65 6e 75 menu }.. menu
30f0: 20 24 6d 65 6e 75 20 2d 74 65 61 72 6f 66 66 20 $menu -tearoff
3100: 30 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 69 0.. foreach i
3110: 20 5b 6c 69 73 74 20 63 75 74 20 63 6f 70 79 20 [list cut copy
3120: 70 61 73 74 65 20 2d 2d 2d 20 73 65 6c 65 63 74 paste --- select
3130: 5f 61 6c 6c 20 2d 2d 2d 20 63 6c 65 61 72 5d 20 _all --- clear]
3140: 5c 0a 09 09 74 78 74 20 5b 6c 69 73 74 20 5b 5f \...txt [list [_
3150: 20 22 43 75 74 22 5d 20 5b 5f 20 22 43 6f 70 79 "Cut"] [_ "Copy
3160: 22 5d 20 5b 5f 20 22 50 61 73 74 65 22 5d 20 2d "] [_ "Paste"] -
3170: 2d 2d 20 5b 5f 20 22 53 65 6c 65 63 74 20 61 6c -- [_ "Select al
3180: 6c 22 5d 20 2d 2d 2d 20 5b 5f 20 22 43 6c 65 61 l"] --- [_ "Clea
3190: 72 22 5d 5d 20 7b 0a 09 09 69 66 20 7b 20 24 69 r"]] {...if { $i
31a0: 20 65 71 20 22 2d 2d 2d 22 20 7d 20 7b 0a 09 09 eq "---" } {...
31b0: 20 20 20 20 24 6d 65 6e 75 20 61 64 64 20 73 65 $menu add se
31c0: 70 61 72 61 74 6f 72 0a 09 09 7d 20 65 6c 73 65 parator...} else
31d0: 20 7b 0a 09 09 20 20 20 20 24 6d 65 6e 75 20 61 {... $menu a
31e0: 64 64 20 63 6f 6d 6d 61 6e 64 20 2d 6c 61 62 65 dd command -labe
31f0: 6c 20 24 74 78 74 20 2d 63 6f 6d 6d 61 6e 64 20 l $txt -command
3200: 5b 6c 69 73 74 20 63 75 3a 3a 61 64 64 5f 63 6f [list cu::add_co
3210: 6e 74 65 78 74 75 61 6c 5f 6d 65 6e 75 5f 74 6f ntextual_menu_to
3220: 5f 65 6e 74 72 79 20 24 77 20 24 69 5d 0a 09 09 _entry $w $i]...
3230: 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 74 6b }.. }.. tk
3240: 5f 70 6f 70 75 70 20 24 6d 65 6e 75 20 24 78 20 _popup $menu $x
3250: 24 79 0a 09 7d 0a 09 63 6c 65 61 72 20 7b 0a 09 $y..}..clear {..
3260: 20 20 20 20 69 66 20 7b 20 5b 77 69 6e 66 6f 20 if { [winfo
3270: 63 6c 61 73 73 20 24 77 5d 20 65 71 20 22 54 65 class $w] eq "Te
3280: 78 74 22 20 7d 20 7b 0a 09 09 24 77 20 64 65 6c xt" } {...$w del
3290: 65 74 65 20 31 2e 30 20 65 6e 64 0a 09 20 20 20 ete 1.0 end..
32a0: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 24 77 20 64 } else {...$w d
32b0: 65 6c 65 74 65 20 30 20 65 6e 64 0a 09 20 20 20 elete 0 end..
32c0: 20 7d 0a 09 7d 0a 09 63 75 74 20 7b 0a 09 20 20 }..}..cut {..
32d0: 20 20 65 76 65 6e 74 20 67 65 6e 65 72 61 74 65 event generate
32e0: 20 24 77 20 3c 3c 43 75 74 3e 3e 0a 09 7d 0a 09 $w <<Cut>>..}..
32f0: 63 6f 70 79 20 7b 0a 09 20 20 20 20 65 76 65 6e copy {.. even
3300: 74 20 67 65 6e 65 72 61 74 65 20 24 77 20 3c 3c t generate $w <<
3310: 43 6f 70 79 3e 3e 0a 09 7d 0a 09 70 61 73 74 65 Copy>>..}..paste
3320: 20 7b 0a 09 20 20 20 20 65 76 65 6e 74 20 67 65 {.. event ge
3330: 6e 65 72 61 74 65 20 24 77 20 3c 3c 50 61 73 74 nerate $w <<Past
3340: 65 3e 3e 0a 09 7d 0a 09 73 65 6c 65 63 74 5f 61 e>>..}..select_a
3350: 6c 6c 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 5b ll {.. if { [
3360: 77 69 6e 66 6f 20 63 6c 61 73 73 20 24 77 5d 20 winfo class $w]
3370: 65 71 20 22 54 65 78 74 22 20 7d 20 7b 0a 09 09 eq "Text" } {...
3380: 24 77 20 74 61 67 20 61 64 64 20 73 65 6c 20 31 $w tag add sel 1
3390: 2e 30 20 65 6e 64 2d 31 63 0a 09 20 20 20 20 7d .0 end-1c.. }
33a0: 20 65 6c 73 65 20 7b 0a 09 09 24 77 20 73 65 6c else {...$w sel
33b0: 65 63 74 69 6f 6e 20 72 61 6e 67 65 20 30 20 65 ection range 0 e
33c0: 6e 64 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 nd.. }..}.
33d0: 20 7d 0a 7d 0a 0a 23 23 23 23 23 23 23 23 23 23 }.}..##########
33e0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
33f0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3400: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3410: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3420: 23 23 23 23 23 23 0a 23 20 20 20 20 73 74 6f 72 ######.# stor
3430: 65 20 70 72 65 66 65 72 65 6e 63 65 73 0a 23 23 e preferences.##
3440: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3450: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3460: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3470: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3480: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 0a 0a ##############..
3490: 70 72 6f 63 20 63 75 3a 3a 73 74 6f 72 65 5f 70 proc cu::store_p
34a0: 72 6f 67 72 61 6d 5f 70 72 65 66 65 72 65 6e 63 rogram_preferenc
34b0: 65 73 20 7b 20 61 72 67 73 20 7d 20 7b 0a 0a 20 es { args } {..
34c0: 20 20 20 73 65 74 20 6f 70 74 69 6f 6e 61 6c 20 set optional
34d0: 7b 0a 09 7b 20 2d 76 61 6c 75 65 4e 61 6d 65 20 {..{ -valueName
34e0: 6e 61 6d 65 20 22 22 20 7d 0a 20 20 20 20 7d 0a name "" }. }.
34f0: 20 20 20 20 73 65 74 20 63 6f 6d 70 75 6c 73 6f set compulso
3500: 72 79 20 22 70 72 6f 67 72 61 6d 5f 6e 61 6d 65 ry "program_name
3510: 20 64 61 74 61 22 0a 0a 20 20 20 20 70 61 72 73 data".. pars
3520: 65 5f 61 72 67 73 20 24 6f 70 74 69 6f 6e 61 6c e_args $optional
3530: 20 24 63 6f 6d 70 75 6c 73 6f 72 79 20 24 61 72 $compulsory $ar
3540: 67 73 0a 0a 20 20 20 20 69 66 20 7b 20 24 76 61 gs.. if { $va
3550: 6c 75 65 4e 61 6d 65 20 65 71 20 22 22 20 7d 20 lueName eq "" }
3560: 7b 0a 09 73 65 74 20 76 61 6c 75 65 4e 61 6d 65 {..set valueName
3570: 46 20 49 6e 69 44 61 74 61 0a 20 20 20 20 7d 20 F IniData. }
3580: 65 6c 73 65 20 7b 0a 09 73 65 74 20 76 61 6c 75 else {..set valu
3590: 65 4e 61 6d 65 46 20 49 6e 69 44 61 74 61 5f 24 eNameF IniData_$
35a0: 76 61 6c 75 65 4e 61 6d 65 0a 20 20 20 20 7d 0a valueName. }.
35b0: 0a 20 20 20 20 69 66 20 7b 20 24 3a 3a 74 63 6c . if { $::tcl
35c0: 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f _platform(platfo
35d0: 72 6d 29 20 65 71 20 22 77 69 6e 64 6f 77 73 22 rm) eq "windows"
35e0: 20 26 26 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 && $::tcl_platf
35f0: 6f 72 6d 28 6f 73 29 20 6e 65 20 22 57 69 6e 64 orm(os) ne "Wind
3600: 6f 77 73 20 43 45 22 20 7d 20 7b 0a 09 73 65 74 ows CE" } {..set
3610: 20 6b 65 79 20 22 48 4b 45 59 5f 43 55 52 52 45 key "HKEY_CURRE
3620: 4e 54 5f 55 53 45 52 5c 5c 53 6f 66 74 77 61 72 NT_USER\\Softwar
3630: 65 5c 5c 43 6f 6d 70 61 73 73 5c 5c 24 70 72 6f e\\Compass\\$pro
3640: 67 72 61 6d 5f 6e 61 6d 65 22 0a 09 70 61 63 6b gram_name"..pack
3650: 61 67 65 20 72 65 71 75 69 72 65 20 72 65 67 69 age require regi
3660: 73 74 72 79 0a 09 72 65 67 69 73 74 72 79 20 73 stry..registry s
3670: 65 74 20 24 6b 65 79 20 24 76 61 6c 75 65 4e 61 et $key $valueNa
3680: 6d 65 46 20 24 64 61 74 61 0a 20 20 20 20 7d 20 meF $data. }
3690: 65 6c 73 65 20 7b 0a 09 70 61 63 6b 61 67 65 20 else {..package
36a0: 72 65 71 75 69 72 65 20 74 64 6f 6d 0a 09 69 66 require tdom..if
36b0: 20 7b 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 6f { $::tcl_platfo
36c0: 72 6d 28 6f 73 29 20 65 71 20 22 57 69 6e 64 6f rm(os) eq "Windo
36d0: 77 73 20 43 45 22 20 7d 20 7b 0a 09 20 20 20 20 ws CE" } {..
36e0: 73 65 74 20 64 69 72 20 5b 66 69 6c 65 20 6a 6f set dir [file jo
36f0: 69 6e 20 2f 20 22 41 70 70 6c 69 63 61 74 69 6f in / "Applicatio
3700: 6e 20 44 61 74 61 22 20 43 6f 6d 70 61 73 73 20 n Data" Compass
3710: 24 70 72 6f 67 72 61 6d 5f 6e 61 6d 65 5d 0a 09 $program_name]..
3720: 20 20 20 20 66 69 6c 65 20 6d 6b 64 69 72 20 24 file mkdir $
3730: 64 69 72 0a 09 20 20 20 20 73 65 74 20 66 69 6c dir.. set fil
3740: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 64 69 e [file join $di
3750: 72 20 70 72 65 66 73 5d 0a 09 7d 20 65 6c 73 65 r prefs]..} else
3760: 69 66 20 7b 20 5b 69 6e 66 6f 20 65 78 69 73 74 if { [info exist
3770: 73 20 3a 3a 65 6e 76 28 48 4f 4d 45 29 5d 20 7d s ::env(HOME)] }
3780: 20 7b 0a 09 20 20 20 20 73 65 74 20 66 69 6c 65 {.. set file
3790: 20 5b 66 69 6c 65 20 6e 6f 72 6d 61 6c 69 7a 65 [file normalize
37a0: 20 7e 2f 2e 63 6f 6d 70 61 73 73 5f 24 7b 70 72 ~/.compass_${pr
37b0: 6f 67 72 61 6d 5f 6e 61 6d 65 7d 5f 70 72 65 66 ogram_name}_pref
37c0: 73 5d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 s]..} else {..
37d0: 20 20 73 65 74 20 66 69 6c 65 20 5b 66 69 6c 65 set file [file
37e0: 20 6e 6f 72 6d 61 6c 69 7a 65 20 5b 66 69 6c 65 normalize [file
37f0: 20 6a 6f 69 6e 20 2f 74 6d 70 20 63 6f 6d 70 61 join /tmp compa
3800: 73 73 5f 24 7b 70 72 6f 67 72 61 6d 5f 6e 61 6d ss_${program_nam
3810: 65 7d 5f 70 72 65 66 73 5d 5d 0a 09 7d 0a 09 73 e}_prefs]]..}..s
3820: 65 74 20 65 72 72 20 5b 63 61 74 63 68 20 7b 20 et err [catch {
3830: 74 44 4f 4d 3a 3a 78 6d 6c 52 65 61 64 46 69 6c tDOM::xmlReadFil
3840: 65 20 24 66 69 6c 65 20 7d 20 78 6d 6c 5d 0a 09 e $file } xml]..
3850: 69 66 20 7b 20 24 65 72 72 20 7d 20 7b 20 73 65 if { $err } { se
3860: 74 20 78 6d 6c 20 22 3c 70 72 65 66 65 72 65 6e t xml "<preferen
3870: 63 65 73 2f 3e 22 20 7d 0a 09 73 65 74 20 64 6f ces/>" }..set do
3880: 63 20 5b 64 6f 6d 20 70 61 72 73 65 20 24 78 6d c [dom parse $xm
3890: 6c 5d 0a 09 73 65 74 20 72 6f 6f 74 20 5b 24 64 l]..set root [$d
38a0: 6f 63 20 64 6f 63 75 6d 65 6e 74 45 6c 65 6d 65 oc documentEleme
38b0: 6e 74 5d 0a 09 73 65 74 20 64 6f 6d 4e 6f 64 65 nt]..set domNode
38c0: 20 5b 24 72 6f 6f 74 20 73 65 6c 65 63 74 4e 6f [$root selectNo
38d0: 64 65 73 20 22 70 72 65 66 5c 5b 40 6e 3d 5b 78 des "pref\[@n=[x
38e0: 70 61 74 68 5f 73 74 72 20 24 76 61 6c 75 65 4e path_str $valueN
38f0: 61 6d 65 46 5d 5c 5d 22 5d 0a 09 69 66 20 7b 20 ameF]\]"]..if {
3900: 24 64 6f 6d 4e 6f 64 65 20 6e 65 20 22 22 20 7d $domNode ne "" }
3910: 20 7b 20 24 64 6f 6d 4e 6f 64 65 20 64 65 6c 65 { $domNode dele
3920: 74 65 20 7d 0a 09 73 65 74 20 70 20 5b 24 72 6f te }..set p [$ro
3930: 6f 74 20 61 70 70 65 6e 64 43 68 69 6c 64 54 61 ot appendChildTa
3940: 67 20 70 72 65 66 5d 0a 09 24 70 20 73 65 74 41 g pref]..$p setA
3950: 74 74 72 69 62 75 74 65 20 6e 20 24 76 61 6c 75 ttribute n $valu
3960: 65 4e 61 6d 65 46 0a 09 24 70 20 61 70 70 65 6e eNameF..$p appen
3970: 64 43 68 69 6c 64 54 65 78 74 20 24 64 61 74 61 dChildText $data
3980: 0a 0a 09 73 65 74 20 66 6f 75 74 20 5b 6f 70 65 ...set fout [ope
3990: 6e 20 24 66 69 6c 65 20 77 5d 0a 09 66 63 6f 6e n $file w]..fcon
39a0: 66 69 67 75 72 65 20 24 66 6f 75 74 20 2d 65 6e figure $fout -en
39b0: 63 6f 64 69 6e 67 20 75 74 66 2d 38 0a 09 70 75 coding utf-8..pu
39c0: 74 73 20 24 66 6f 75 74 20 5b 24 64 6f 63 20 61 ts $fout [$doc a
39d0: 73 58 4d 4c 5d 0a 09 63 6c 6f 73 65 20 24 66 6f sXML]..close $fo
39e0: 75 74 0a 20 20 20 20 7d 0a 7d 0a 70 72 6f 63 20 ut. }.}.proc
39f0: 63 75 3a 3a 67 65 74 5f 70 72 6f 67 72 61 6d 5f cu::get_program_
3a00: 70 72 65 66 65 72 65 6e 63 65 73 20 7b 20 61 72 preferences { ar
3a10: 67 73 20 7d 20 7b 0a 0a 20 20 20 20 73 65 74 20 gs } {.. set
3a20: 6f 70 74 69 6f 6e 61 6c 20 7b 0a 09 7b 20 2d 76 optional {..{ -v
3a30: 61 6c 75 65 4e 61 6d 65 20 6e 61 6d 65 20 22 22 alueName name ""
3a40: 20 7d 0a 09 7b 20 2d 64 65 66 61 75 6c 74 20 64 }..{ -default d
3a50: 65 66 61 75 6c 74 5f 76 61 6c 75 65 20 22 22 20 efault_value ""
3a60: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
3a70: 63 6f 6d 70 75 6c 73 6f 72 79 20 22 70 72 6f 67 compulsory "prog
3a80: 72 61 6d 5f 6e 61 6d 65 22 0a 0a 20 20 20 20 70 ram_name".. p
3a90: 61 72 73 65 5f 61 72 67 73 20 24 6f 70 74 69 6f arse_args $optio
3aa0: 6e 61 6c 20 24 63 6f 6d 70 75 6c 73 6f 72 79 20 nal $compulsory
3ab0: 24 61 72 67 73 0a 0a 20 20 20 20 69 66 20 7b 20 $args.. if {
3ac0: 24 76 61 6c 75 65 4e 61 6d 65 20 65 71 20 22 22 $valueName eq ""
3ad0: 20 7d 20 7b 0a 09 73 65 74 20 76 61 6c 75 65 4e } {..set valueN
3ae0: 61 6d 65 46 20 49 6e 69 44 61 74 61 0a 20 20 20 ameF IniData.
3af0: 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 76 } else {..set v
3b00: 61 6c 75 65 4e 61 6d 65 46 20 49 6e 69 44 61 74 alueNameF IniDat
3b10: 61 5f 24 76 61 6c 75 65 4e 61 6d 65 0a 20 20 20 a_$valueName.
3b20: 20 7d 0a 0a 20 20 20 20 73 65 74 20 64 61 74 61 }.. set data
3b30: 20 24 64 65 66 61 75 6c 74 0a 20 20 20 20 69 66 $default. if
3b40: 20 7b 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 6f { $::tcl_platfo
3b50: 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 65 71 20 rm(platform) eq
3b60: 22 77 69 6e 64 6f 77 73 22 20 26 26 20 24 3a 3a "windows" && $::
3b70: 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 6f 73 29 tcl_platform(os)
3b80: 20 6e 65 20 22 57 69 6e 64 6f 77 73 20 43 45 22 ne "Windows CE"
3b90: 20 7d 20 7b 0a 09 73 65 74 20 6b 65 79 20 22 48 } {..set key "H
3ba0: 4b 45 59 5f 43 55 52 52 45 4e 54 5f 55 53 45 52 KEY_CURRENT_USER
3bb0: 5c 5c 53 6f 66 74 77 61 72 65 5c 5c 43 6f 6d 70 \\Software\\Comp
3bc0: 61 73 73 5c 5c 24 70 72 6f 67 72 61 6d 5f 6e 61 ass\\$program_na
3bd0: 6d 65 22 0a 09 70 61 63 6b 61 67 65 20 72 65 71 me"..package req
3be0: 75 69 72 65 20 72 65 67 69 73 74 72 79 0a 09 73 uire registry..s
3bf0: 65 74 20 65 72 72 20 5b 63 61 74 63 68 20 7b 20 et err [catch {
3c00: 72 65 67 69 73 74 72 79 20 67 65 74 20 24 6b 65 registry get $ke
3c10: 79 20 24 76 61 6c 75 65 4e 61 6d 65 46 20 7d 20 y $valueNameF }
3c20: 64 61 74 61 5d 0a 09 69 66 20 7b 20 24 65 72 72 data]..if { $err
3c30: 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 64 61 } {.. set da
3c40: 74 61 20 24 64 65 66 61 75 6c 74 0a 09 7d 0a 20 ta $default..}.
3c50: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 70 61 63 } else {..pac
3c60: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 64 6f kage require tdo
3c70: 6d 0a 09 69 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 m..if { $::tcl_p
3c80: 6c 61 74 66 6f 72 6d 28 6f 73 29 20 65 71 20 22 latform(os) eq "
3c90: 57 69 6e 64 6f 77 73 20 43 45 22 20 7d 20 7b 0a Windows CE" } {.
3ca0: 09 20 20 20 20 73 65 74 20 64 69 72 20 5b 66 69 . set dir [fi
3cb0: 6c 65 20 6a 6f 69 6e 20 2f 20 22 41 70 70 6c 69 le join / "Appli
3cc0: 63 61 74 69 6f 6e 20 44 61 74 61 22 20 43 6f 6d cation Data" Com
3cd0: 70 61 73 73 20 24 70 72 6f 67 72 61 6d 5f 6e 61 pass $program_na
3ce0: 6d 65 5d 0a 09 20 20 20 20 66 69 6c 65 20 6d 6b me].. file mk
3cf0: 64 69 72 20 24 64 69 72 0a 09 20 20 20 20 73 65 dir $dir.. se
3d00: 74 20 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 t file [file joi
3d10: 6e 20 24 64 69 72 20 70 72 65 66 73 5d 0a 09 7d n $dir prefs]..}
3d20: 20 65 6c 73 65 69 66 20 7b 20 5b 69 6e 66 6f 20 elseif { [info
3d30: 65 78 69 73 74 73 20 3a 3a 65 6e 76 28 48 4f 4d exists ::env(HOM
3d40: 45 29 5d 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 E)] } {.. set
3d50: 20 66 69 6c 65 20 5b 66 69 6c 65 20 6e 6f 72 6d file [file norm
3d60: 61 6c 69 7a 65 20 7e 2f 2e 63 6f 6d 70 61 73 73 alize ~/.compass
3d70: 5f 24 7b 70 72 6f 67 72 61 6d 5f 6e 61 6d 65 7d _${program_name}
3d80: 5f 70 72 65 66 73 5d 0a 09 7d 20 65 6c 73 65 20 _prefs]..} else
3d90: 7b 0a 09 20 20 20 20 73 65 74 20 66 69 6c 65 20 {.. set file
3da0: 5b 66 69 6c 65 20 6e 6f 72 6d 61 6c 69 7a 65 20 [file normalize
3db0: 5b 66 69 6c 65 20 6a 6f 69 6e 20 2f 74 6d 70 20 [file join /tmp
3dc0: 63 6f 6d 70 61 73 73 5f 24 7b 70 72 6f 67 72 61 compass_${progra
3dd0: 6d 5f 6e 61 6d 65 7d 5f 70 72 65 66 73 5d 5d 0a m_name}_prefs]].
3de0: 09 7d 0a 09 73 65 74 20 65 72 72 20 5b 63 61 74 .}..set err [cat
3df0: 63 68 20 7b 20 74 44 4f 4d 3a 3a 78 6d 6c 52 65 ch { tDOM::xmlRe
3e00: 61 64 46 69 6c 65 20 24 66 69 6c 65 20 7d 20 78 adFile $file } x
3e10: 6d 6c 5d 0a 09 69 66 20 7b 20 21 24 65 72 72 20 ml]..if { !$err
3e20: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 64 6f 63 } {.. set doc
3e30: 20 5b 64 6f 6d 20 70 61 72 73 65 20 24 78 6d 6c [dom parse $xml
3e40: 5d 0a 09 20 20 20 20 73 65 74 20 72 6f 6f 74 20 ].. set root
3e50: 5b 24 64 6f 63 20 64 6f 63 75 6d 65 6e 74 45 6c [$doc documentEl
3e60: 65 6d 65 6e 74 5d 0a 09 20 20 20 20 73 65 74 20 ement].. set
3e70: 64 6f 6d 4e 6f 64 65 20 5b 24 72 6f 6f 74 20 73 domNode [$root s
3e80: 65 6c 65 63 74 4e 6f 64 65 73 20 22 70 72 65 66 electNodes "pref
3e90: 5c 5b 40 6e 3d 5b 78 70 61 74 68 5f 73 74 72 20 \[@n=[xpath_str
3ea0: 24 76 61 6c 75 65 4e 61 6d 65 46 5d 5c 5d 22 5d $valueNameF]\]"]
3eb0: 0a 09 20 20 20 20 69 66 20 7b 20 24 64 6f 6d 4e .. if { $domN
3ec0: 6f 64 65 20 6e 65 20 22 22 20 7d 20 7b 0a 09 09 ode ne "" } {...
3ed0: 73 65 74 20 64 61 74 61 20 5b 24 64 6f 6d 4e 6f set data [$domNo
3ee0: 64 65 20 74 65 78 74 5d 0a 09 20 20 20 20 7d 0a de text].. }.
3ef0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 .}. }. ret
3f00: 75 72 6e 20 24 64 61 74 61 0a 7d 0a 0a 23 23 23 urn $data.}..###
3f10: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3f20: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3f30: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3f40: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3f50: 23 23 23 23 23 23 23 23 23 23 23 23 23 0a 23 20 #############.#
3f60: 20 20 20 63 75 3a 3a 73 65 74 5f 77 69 6e 64 6f cu::set_windo
3f70: 77 5f 67 65 6f 6d 65 74 72 79 20 75 3a 3a 67 69 w_geometry u::gi
3f80: 76 65 5f 77 69 6e 64 6f 77 5f 67 65 6f 6d 65 74 ve_window_geomet
3f90: 72 79 0a 23 23 23 23 23 23 23 23 23 23 23 23 23 ry.#############
3fa0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3fb0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3fc0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3fd0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
3fe0: 23 23 23 0a 0a 70 72 6f 63 20 63 75 3a 3a 67 69 ###..proc cu::gi
3ff0: 76 65 5f 77 69 6e 64 6f 77 5f 67 65 6f 6d 65 74 ve_window_geomet
4000: 72 79 20 7b 20 77 20 7d 20 7b 0a 0a 20 20 20 20 ry { w } {..
4010: 72 65 67 65 78 70 20 7b 28 5c 64 2b 29 78 28 5c regexp {(\d+)x(\
4020: 64 2b 29 28 5b 2d 2b 5d 29 28 5b 2d 5c 64 5d 5c d+)([-+])([-\d]\
4030: 64 2a 29 28 5b 2d 2b 5d 29 28 5b 2d 5c 64 5d 2b d*)([-+])([-\d]+
4040: 29 7d 20 5b 77 6d 20 67 65 6f 6d 65 74 72 79 20 )} [wm geometry
4050: 24 77 5d 20 7b 7d 20 77 69 64 74 68 20 68 65 69 $w] {} width hei
4060: 67 68 74 20 6d 31 20 78 20 6d 32 20 79 0a 20 20 ght m1 x m2 y.
4070: 20 20 69 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 6c if { $::tcl_pl
4080: 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 atform(platform)
4090: 20 65 71 20 22 75 6e 69 78 22 20 7d 20 7b 0a 09 eq "unix" } {..
40a0: 23 20 6e 6f 74 65 3a 20 74 68 69 73 20 77 6f 72 # note: this wor
40b0: 6b 20 69 6e 20 75 62 75 6e 74 75 20 39 2e 30 34 k in ubuntu 9.04
40c0: 0a 09 69 6e 63 72 20 78 20 2d 34 0a 09 69 6e 63 ..incr x -4..inc
40d0: 72 20 79 20 2d 32 34 0a 20 20 20 20 7d 0a 20 20 r y -24. }.
40e0: 20 20 72 65 74 75 72 6e 20 24 7b 77 69 64 74 68 return ${width
40f0: 7d 78 24 68 65 69 67 68 74 24 6d 31 24 78 24 6d }x$height$m1$x$m
4100: 32 24 79 0a 7d 0a 0a 70 72 6f 63 20 63 75 3a 3a 2$y.}..proc cu::
4110: 73 65 74 5f 77 69 6e 64 6f 77 5f 67 65 6f 6d 65 set_window_geome
4120: 74 72 79 20 7b 20 77 20 67 65 6f 6d 65 74 72 79 try { w geometry
4130: 20 7d 20 7b 0a 0a 20 20 20 20 69 66 20 7b 20 21 } {.. if { !
4140: 5b 72 65 67 65 78 70 20 7b 28 5c 64 2b 29 78 28 [regexp {(\d+)x(
4150: 5c 64 2b 29 28 5b 2d 2b 5d 29 28 5b 2d 5c 64 5d \d+)([-+])([-\d]
4160: 5c 64 2a 29 28 5b 2d 2b 5d 29 28 5b 2d 5c 64 5d \d*)([-+])([-\d]
4170: 2b 29 7d 20 24 67 65 6f 6d 65 74 72 79 20 7b 7d +)} $geometry {}
4180: 20 77 69 64 74 68 20 68 65 69 67 68 74 20 6d 31 width height m1
4190: 20 78 20 6d 32 20 79 5d 20 7d 20 7b 0a 09 72 65 x m2 y] } {..re
41a0: 67 65 78 70 20 7b 28 5c 64 2b 29 78 28 5c 64 2b gexp {(\d+)x(\d+
41b0: 29 7d 20 24 67 65 6f 6d 65 74 72 79 20 7b 7d 20 )} $geometry {}
41c0: 77 69 64 74 68 20 68 65 69 67 68 74 0a 09 6c 61 width height..la
41d0: 73 73 69 67 6e 20 5b 6c 69 73 74 20 30 20 30 20 ssign [list 0 0
41e0: 2b 20 2b 5d 20 78 20 79 20 6d 31 20 6d 32 0a 20 + +] x y m1 m2.
41f0: 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 20 24 78 }. if { $x
4200: 20 3c 20 30 20 7d 20 7b 20 73 65 74 20 78 20 30 < 0 } { set x 0
4210: 20 7d 0a 20 20 20 20 69 66 20 7b 20 24 79 20 3c }. if { $y <
4220: 20 30 20 7d 20 7b 20 73 65 74 20 79 20 30 20 7d 0 } { set y 0 }
4230: 0a 20 20 20 20 69 66 20 7b 20 24 78 20 3e 20 5b . if { $x > [
4240: 77 69 6e 66 6f 20 73 63 72 65 65 6e 77 69 64 74 winfo screenwidt
4250: 68 20 24 77 5d 2d 31 30 30 20 7d 20 7b 20 73 65 h $w]-100 } { se
4260: 74 20 78 20 5b 65 78 70 72 20 7b 5b 77 69 6e 66 t x [expr {[winf
4270: 6f 20 73 63 72 65 65 6e 77 69 64 74 68 20 24 77 o screenwidth $w
4280: 5d 2d 31 30 30 7d 5d 20 7d 0a 20 20 20 20 69 66 ]-100}] }. if
4290: 20 7b 20 24 79 20 3e 20 5b 77 69 6e 66 6f 20 73 { $y > [winfo s
42a0: 63 72 65 65 6e 68 65 69 67 68 74 20 24 77 5d 2d creenheight $w]-
42b0: 31 30 30 20 7d 20 7b 20 73 65 74 20 79 20 5b 65 100 } { set y [e
42c0: 78 70 72 20 7b 5b 77 69 6e 66 6f 20 73 63 72 65 xpr {[winfo scre
42d0: 65 6e 68 65 69 67 68 74 20 24 77 5d 2d 31 30 30 enheight $w]-100
42e0: 7d 5d 20 7d 0a 0a 20 20 20 20 77 6d 20 67 65 6f }] }.. wm geo
42f0: 6d 65 74 72 79 20 24 77 20 24 7b 77 69 64 74 68 metry $w ${width
4300: 7d 78 24 68 65 69 67 68 74 24 6d 31 24 78 24 6d }x$height$m1$x$m
4310: 32 24 79 0a 7d 0a 0a 70 72 6f 63 20 63 75 3a 3a 2$y.}..proc cu::
4320: 63 72 65 61 74 65 5f 74 6f 6f 6c 74 69 70 5f 74 create_tooltip_t
4330: 6f 70 6c 65 76 65 6c 20 7b 20 62 20 7d 20 7b 0a oplevel { b } {.
4340: 0a 20 20 20 20 74 6f 70 6c 65 76 65 6c 20 24 62 . toplevel $b
4350: 20 2d 63 6c 61 73 73 20 54 6f 6f 6c 74 69 70 0a -class Tooltip.
4360: 20 20 20 20 69 66 20 7b 5b 74 6b 20 77 69 6e 64 if {[tk wind
4370: 6f 77 69 6e 67 73 79 73 74 65 6d 5d 20 65 71 20 owingsystem] eq
4380: 22 61 71 75 61 22 7d 20 7b 0a 09 3a 3a 74 6b 3a "aqua"} {..::tk:
4390: 3a 75 6e 73 75 70 70 6f 72 74 65 64 3a 3a 4d 61 :unsupported::Ma
43a0: 63 57 69 6e 64 6f 77 53 74 79 6c 65 20 73 74 79 cWindowStyle sty
43b0: 6c 65 20 24 62 20 68 65 6c 70 20 6e 6f 6e 65 0a le $b help none.
43c0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 77 6d } else {..wm
43d0: 20 6f 76 65 72 72 69 64 65 72 65 64 69 72 65 63 overrideredirec
43e0: 74 20 24 62 20 31 0a 20 20 20 20 7d 0a 20 20 20 t $b 1. }.
43f0: 20 63 61 74 63 68 20 7b 77 6d 20 61 74 74 72 69 catch {wm attri
4400: 62 75 74 65 73 20 24 62 20 2d 74 6f 70 6d 6f 73 butes $b -topmos
4410: 74 20 31 7d 0a 20 20 20 20 23 20 61 76 6f 69 64 t 1}. # avoid
4420: 20 74 68 65 20 62 6c 69 6e 6b 20 69 73 73 75 65 the blink issue
4430: 20 77 69 74 68 20 31 20 74 6f 20 3c 31 20 61 6c with 1 to <1 al
4440: 70 68 61 20 6f 6e 20 57 69 6e 64 6f 77 73 0a 20 pha on Windows.
4450: 20 20 20 63 61 74 63 68 20 7b 77 6d 20 61 74 74 catch {wm att
4460: 72 69 62 75 74 65 73 20 24 62 20 2d 61 6c 70 68 ributes $b -alph
4470: 61 20 30 2e 39 39 7d 0a 20 20 20 20 77 6d 20 70 a 0.99}. wm p
4480: 6f 73 69 74 69 6f 6e 66 72 6f 6d 20 24 62 20 70 ositionfrom $b p
4490: 72 6f 67 72 61 6d 0a 20 20 20 20 69 66 20 7b 20 rogram. if {
44a0: 5b 74 6b 20 77 69 6e 64 6f 77 69 6e 67 73 79 73 [tk windowingsys
44b0: 74 65 6d 5d 20 20 65 71 20 22 78 31 31 22 20 7d tem] eq "x11" }
44c0: 20 7b 0a 09 73 65 74 20 66 6f 63 75 73 20 5b 66 {..set focus [f
44d0: 6f 63 75 73 5d 0a 09 66 6f 63 75 73 20 2d 66 6f ocus]..focus -fo
44e0: 72 63 65 20 24 62 0a 09 72 61 69 73 65 20 24 62 rce $b..raise $b
44f0: 0a 09 69 66 20 7b 20 24 66 6f 63 75 73 20 6e 65 ..if { $focus ne
4500: 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 61 66 74 "" } {.. aft
4510: 65 72 20 31 30 30 20 5b 6c 69 73 74 20 66 6f 63 er 100 [list foc
4520: 75 73 20 24 66 6f 63 75 73 5d 0a 09 7d 0a 20 20 us $focus]..}.
4530: 20 20 7d 0a 7d 0a 0a 23 23 23 23 23 23 23 23 23 }.}..#########
4540: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
4550: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
4560: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
4570: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
4580: 23 23 23 23 23 23 23 0a 23 20 20 20 20 58 4d 4c #######.# XML
4590: 20 26 20 78 70 61 74 68 20 75 74 69 6c 69 74 69 & xpath utiliti
45a0: 65 73 0a 23 23 23 23 23 23 23 23 23 23 23 23 23 es.#############
45b0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
45c0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
45d0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
45e0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
45f0: 23 23 23 0a 0a 70 72 6f 63 20 78 70 61 74 68 5f ###..proc xpath_
4600: 73 74 72 20 7b 20 73 74 72 20 7d 20 7b 0a 20 20 str { str } {.
4610: 20 20 0a 20 20 20 20 66 6f 72 65 61 63 68 20 22 . foreach "
4620: 73 74 72 4c 69 73 74 20 74 79 70 65 20 70 6f 73 strList type pos
4630: 22 20 5b 6c 69 73 74 20 22 22 20 22 22 20 30 5d " [list "" "" 0]
4640: 20 62 72 65 61 6b 0a 20 20 20 20 77 68 69 6c 65 break. while
4650: 20 31 20 7b 0a 09 73 77 69 74 63 68 20 24 74 79 1 {..switch $ty
4660: 70 65 20 7b 0a 09 20 20 20 20 22 22 20 7b 0a 09 pe {.. "" {..
4670: 09 73 65 74 20 72 65 74 20 5b 72 65 67 65 78 70 .set ret [regexp
4680: 20 2d 73 74 61 72 74 20 24 70 6f 73 20 2d 69 6e -start $pos -in
4690: 64 69 63 65 73 20 7b 5b 27 22 5d 7d 20 24 73 74 dices {['"]} $st
46a0: 72 20 69 64 78 73 5d 0a 09 09 69 66 20 7b 20 21 r idxs]...if { !
46b0: 24 72 65 74 20 7d 20 7b 0a 09 09 20 20 20 20 6c $ret } {... l
46c0: 61 70 70 65 6e 64 20 73 74 72 4c 69 73 74 20 22 append strList "
46d0: 5c 22 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20 \"[string range
46e0: 24 73 74 72 20 24 70 6f 73 20 65 6e 64 5d 5c 22 $str $pos end]\"
46f0: 22 0a 09 09 20 20 20 20 62 72 65 61 6b 0a 09 09 "... break...
4700: 7d 0a 09 09 73 65 74 20 69 64 78 20 5b 6c 69 6e }...set idx [lin
4710: 64 65 78 20 24 69 64 78 73 20 30 5d 0a 09 09 73 dex $idxs 0]...s
4720: 77 69 74 63 68 20 2d 2d 20 5b 73 74 72 69 6e 67 witch -- [string
4730: 20 69 6e 64 65 78 20 24 73 74 72 20 24 69 64 78 index $str $idx
4740: 5d 20 7b 0a 09 09 20 20 20 20 27 20 7b 20 73 65 ] {... ' { se
4750: 74 20 74 79 70 65 20 61 70 6f 73 74 72 6f 70 68 t type apostroph
4760: 65 20 7d 0a 09 09 20 20 20 20 5c 22 20 7b 20 73 e }... \" { s
4770: 65 74 20 74 79 70 65 20 71 75 6f 74 65 20 7d 0a et type quote }.
4780: 09 09 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 ..}.. }..
4790: 61 70 6f 73 74 72 6f 70 68 65 20 7b 0a 09 09 73 apostrophe {...s
47a0: 65 74 20 72 65 74 20 5b 72 65 67 65 78 70 20 2d et ret [regexp -
47b0: 73 74 61 72 74 20 24 70 6f 73 20 2d 69 6e 64 69 start $pos -indi
47c0: 63 65 73 20 7b 5b 22 5d 7d 20 24 73 74 72 20 69 ces {["]} $str i
47d0: 64 78 73 5d 0a 09 09 69 66 20 7b 20 21 24 72 65 dxs]...if { !$re
47e0: 74 20 7d 20 7b 0a 09 09 20 20 20 20 6c 61 70 70 t } {... lapp
47f0: 65 6e 64 20 73 74 72 4c 69 73 74 20 22 5c 22 5b end strList "\"[
4800: 73 74 72 69 6e 67 20 72 61 6e 67 65 20 24 73 74 string range $st
4810: 72 20 24 70 6f 73 20 65 6e 64 5d 5c 22 22 0a 09 r $pos end]\""..
4820: 09 20 20 20 20 62 72 65 61 6b 0a 09 09 7d 0a 09 . break...}..
4830: 09 73 65 74 20 69 64 78 20 5b 6c 69 6e 64 65 78 .set idx [lindex
4840: 20 24 69 64 78 73 20 30 5d 0a 09 09 6c 61 70 70 $idxs 0]...lapp
4850: 65 6e 64 20 73 74 72 4c 69 73 74 20 22 5c 22 5b end strList "\"[
4860: 73 74 72 69 6e 67 20 72 61 6e 67 65 20 24 73 74 string range $st
4870: 72 20 24 70 6f 73 20 5b 65 78 70 72 20 7b 24 69 r $pos [expr {$i
4880: 64 78 2d 31 7d 5d 5d 5c 22 22 0a 09 09 73 65 74 dx-1}]]\""...set
4890: 20 74 79 70 65 20 71 75 6f 74 65 0a 09 09 73 65 type quote...se
48a0: 74 20 70 6f 73 20 24 69 64 78 0a 09 20 20 20 20 t pos $idx..
48b0: 7d 0a 09 20 20 20 20 71 75 6f 74 65 20 7b 0a 09 }.. quote {..
48c0: 09 73 65 74 20 72 65 74 20 5b 72 65 67 65 78 70 .set ret [regexp
48d0: 20 2d 73 74 61 72 74 20 24 70 6f 73 20 2d 69 6e -start $pos -in
48e0: 64 69 63 65 73 20 7b 5b 27 5d 7d 20 24 73 74 72 dices {[']} $str
48f0: 20 69 64 78 73 5d 0a 09 09 69 66 20 7b 20 21 24 idxs]...if { !$
4900: 72 65 74 20 7d 20 7b 0a 09 09 20 20 20 20 6c 61 ret } {... la
4910: 70 70 65 6e 64 20 73 74 72 4c 69 73 74 20 22 27 ppend strList "'
4920: 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20 24 73 [string range $s
4930: 74 72 20 24 70 6f 73 20 65 6e 64 5d 27 22 0a 09 tr $pos end]'"..
4940: 09 20 20 20 20 62 72 65 61 6b 0a 09 09 7d 0a 09 . break...}..
4950: 09 73 65 74 20 69 64 78 20 5b 6c 69 6e 64 65 78 .set idx [lindex
4960: 20 24 69 64 78 73 20 30 5d 0a 09 09 6c 61 70 70 $idxs 0]...lapp
4970: 65 6e 64 20 73 74 72 4c 69 73 74 20 22 27 5b 73 end strList "'[s
4980: 74 72 69 6e 67 20 72 61 6e 67 65 20 24 73 74 72 tring range $str
4990: 20 24 70 6f 73 20 5b 65 78 70 72 20 7b 24 69 64 $pos [expr {$id
49a0: 78 2d 31 7d 5d 5d 27 22 0a 09 09 73 65 74 20 74 x-1}]]'"...set t
49b0: 79 70 65 20 61 70 6f 73 74 72 6f 70 68 65 0a 09 ype apostrophe..
49c0: 09 73 65 74 20 70 6f 73 20 24 69 64 78 0a 09 20 .set pos $idx..
49d0: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
49e0: 20 20 69 66 20 7b 20 5b 6c 6c 65 6e 67 74 68 20 if { [llength
49f0: 24 73 74 72 4c 69 73 74 5d 20 3e 20 31 20 7d 20 $strList] > 1 }
4a00: 7b 0a 09 72 65 74 75 72 6e 20 22 63 6f 6e 63 61 {..return "conca
4a10: 74 28 5b 6a 6f 69 6e 20 24 73 74 72 4c 69 73 74 t([join $strList
4a20: 20 2c 5d 29 22 0a 20 20 20 20 7d 20 65 6c 73 65 ,])". } else
4a30: 20 7b 0a 09 72 65 74 75 72 6e 20 5b 6c 69 6e 64 {..return [lind
4a40: 65 78 20 24 73 74 72 4c 69 73 74 20 30 5d 0a 20 ex $strList 0].
4a50: 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 66 6f 72 }.}..proc for
4a60: 6d 61 74 5f 78 70 61 74 68 20 7b 20 73 74 72 69 mat_xpath { stri
4a70: 6e 67 20 61 72 67 73 20 7d 20 7b 0a 20 20 20 20 ng args } {.
4a80: 73 65 74 20 63 6d 64 20 5b 6c 69 73 74 20 66 6f set cmd [list fo
4a90: 72 6d 61 74 20 24 73 74 72 69 6e 67 5d 0a 20 20 rmat $string].
4aa0: 20 20 66 6f 72 65 61 63 68 20 69 20 24 61 72 67 foreach i $arg
4ab0: 73 20 7b 0a 09 6c 61 70 70 65 6e 64 20 63 6d 64 s {..lappend cmd
4ac0: 20 5b 78 70 61 74 68 5f 73 74 72 20 24 69 5d 0a [xpath_str $i].
4ad0: 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 6e }. return
4ae0: 20 5b 65 76 61 6c 20 24 63 6d 64 5d 0a 7d 0a 0a [eval $cmd].}..
4af0: 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c 20 3a namespace eval :
4b00: 3a 64 6f 6d 3a 3a 64 6f 6d 4e 6f 64 65 20 7b 7d :dom::domNode {}
4b10: 0a 0a 23 20 61 72 67 73 20 63 61 6e 20 62 65 20 ..# args can be
4b20: 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 74 61 67 73 one or more tags
4b30: 0a 70 72 6f 63 20 3a 3a 64 6f 6d 3a 3a 64 6f 6d .proc ::dom::dom
4b40: 4e 6f 64 65 3a 3a 61 70 70 65 6e 64 43 68 69 6c Node::appendChil
4b50: 64 54 61 67 20 7b 20 6e 6f 64 65 20 61 72 67 73 dTag { node args
4b60: 20 7d 20 7b 0a 20 20 20 20 69 66 20 7b 20 5b 3a } {. if { [:
4b70: 3a 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 20 :llength $args]
4b80: 3d 3d 20 30 20 7d 20 7b 0a 09 65 72 72 6f 72 20 == 0 } {..error
4b90: 22 65 72 72 6f 72 20 69 6e 20 61 70 70 65 6e 64 "error in append
4ba0: 43 68 69 6c 64 54 61 67 2e 20 41 74 20 6c 69 73 ChildTag. At lis
4bb0: 74 20 6f 6e 65 20 74 61 67 22 0a 20 20 20 20 7d t one tag". }
4bc0: 0a 20 20 20 20 3a 3a 73 65 74 20 64 6f 63 20 5b . ::set doc [
4bd0: 24 6e 6f 64 65 20 6f 77 6e 65 72 44 6f 63 75 6d $node ownerDocum
4be0: 65 6e 74 5d 0a 20 20 20 20 66 6f 72 65 61 63 68 ent]. foreach
4bf0: 20 74 61 67 20 24 61 72 67 73 20 7b 0a 09 69 66 tag $args {..if
4c00: 20 7b 20 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 { [string match
4c10: 20 22 74 65 78 74 28 29 20 2a 22 20 24 74 61 67 "text() *" $tag
4c20: 5d 20 7d 20 7b 0a 09 20 20 20 20 3a 3a 73 65 74 ] } {.. ::set
4c30: 20 6e 65 77 6e 6f 64 65 20 5b 24 64 6f 63 20 63 newnode [$doc c
4c40: 72 65 61 74 65 54 65 78 74 4e 6f 64 65 20 5b 6c reateTextNode [l
4c50: 69 6e 64 65 78 20 24 74 61 67 20 31 5d 5d 0a 09 index $tag 1]]..
4c60: 20 20 20 20 24 6e 6f 64 65 20 61 70 70 65 6e 64 $node append
4c70: 43 68 69 6c 64 20 24 6e 65 77 6e 6f 64 65 0a 09 Child $newnode..
4c80: 20 20 20 20 3a 3a 73 65 74 20 6e 6f 64 65 20 24 ::set node $
4c90: 6e 65 77 6e 6f 64 65 0a 09 7d 20 65 6c 73 65 69 newnode..} elsei
4ca0: 66 20 7b 20 5b 73 74 72 69 6e 67 20 6d 61 74 63 f { [string matc
4cb0: 68 20 22 61 74 74 72 69 62 75 74 65 73 28 29 20 h "attributes()
4cc0: 2a 22 20 24 74 61 67 5d 20 7d 20 7b 0a 09 20 20 *" $tag] } {..
4cd0: 20 20 66 6f 72 65 61 63 68 20 22 6e 20 76 22 20 foreach "n v"
4ce0: 5b 6c 72 61 6e 67 65 20 24 74 61 67 20 31 20 65 [lrange $tag 1 e
4cf0: 6e 64 5d 20 7b 0a 09 09 24 6e 6f 64 65 20 73 65 nd] {...$node se
4d00: 74 41 74 74 72 69 62 75 74 65 20 24 6e 20 24 76 tAttribute $n $v
4d10: 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 .. }..} else
4d20: 7b 0a 09 20 20 20 20 3a 3a 73 65 74 20 6e 65 77 {.. ::set new
4d30: 6e 6f 64 65 20 5b 24 64 6f 63 20 63 72 65 61 74 node [$doc creat
4d40: 65 45 6c 65 6d 65 6e 74 20 24 74 61 67 5d 0a 09 eElement $tag]..
4d50: 20 20 20 20 24 6e 6f 64 65 20 61 70 70 65 6e 64 $node append
4d60: 43 68 69 6c 64 20 24 6e 65 77 6e 6f 64 65 0a 09 Child $newnode..
4d70: 20 20 20 20 3a 3a 73 65 74 20 6e 6f 64 65 20 24 ::set node $
4d80: 6e 65 77 6e 6f 64 65 0a 09 7d 0a 20 20 20 20 7d newnode..}. }
4d90: 0a 20 20 20 20 72 65 74 75 72 6e 20 24 6e 65 77 . return $new
4da0: 6e 6f 64 65 0a 7d 0a 0a 70 72 6f 63 20 3a 3a 64 node.}..proc ::d
4db0: 6f 6d 3a 3a 64 6f 6d 4e 6f 64 65 3a 3a 61 70 70 om::domNode::app
4dc0: 65 6e 64 43 68 69 6c 64 54 65 78 74 20 7b 20 6e endChildText { n
4dd0: 6f 64 65 20 74 65 78 74 20 7d 20 7b 0a 20 20 20 ode text } {.
4de0: 20 3a 3a 73 65 74 20 64 6f 63 20 5b 24 6e 6f 64 ::set doc [$nod
4df0: 65 20 6f 77 6e 65 72 44 6f 63 75 6d 65 6e 74 5d e ownerDocument]
4e00: 0a 20 20 20 20 66 6f 72 65 61 63 68 20 63 68 69 . foreach chi
4e10: 6c 64 20 5b 24 6e 6f 64 65 20 73 65 6c 65 63 74 ld [$node select
4e20: 4e 6f 64 65 73 20 74 65 78 74 28 29 5d 20 7b 20 Nodes text()] {
4e30: 24 63 68 69 6c 64 20 64 65 6c 65 74 65 20 7d 0a $child delete }.
4e40: 20 20 20 20 3a 3a 73 65 74 20 6e 65 77 6e 6f 64 ::set newnod
4e50: 65 20 5b 24 64 6f 63 20 63 72 65 61 74 65 54 65 e [$doc createTe
4e60: 78 74 4e 6f 64 65 20 24 74 65 78 74 5d 0a 20 20 xtNode $text].
4e70: 20 20 24 6e 6f 64 65 20 61 70 70 65 6e 64 43 68 $node appendCh
4e80: 69 6c 64 20 24 6e 65 77 6e 6f 64 65 0a 20 20 20 ild $newnode.
4e90: 20 72 65 74 75 72 6e 20 24 6e 65 77 6e 6f 64 65 return $newnode
4ea0: 0a 7d 0a 0a 70 72 6f 63 20 64 69 63 74 5f 67 65 .}..proc dict_ge
4eb0: 74 64 20 7b 20 61 72 67 73 20 7d 20 7b 0a 20 20 td { args } {.
4ec0: 20 20 0a 20 20 20 20 73 65 74 20 64 69 63 74 69 . set dicti
4ed0: 6f 6e 61 72 79 56 61 6c 75 65 20 5b 6c 69 6e 64 onaryValue [lind
4ee0: 65 78 20 24 61 72 67 73 20 30 5d 0a 20 20 20 20 ex $args 0].
4ef0: 73 65 74 20 6b 65 79 73 20 5b 6c 72 61 6e 67 65 set keys [lrange
4f00: 20 24 61 72 67 73 20 31 20 65 6e 64 2d 31 5d 0a $args 1 end-1].
4f10: 20 20 20 20 73 65 74 20 64 65 66 61 75 6c 74 20 set default
4f20: 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 20 65 6e [lindex $args en
4f30: 64 5d 0a 20 20 20 20 69 66 20 7b 20 5b 64 69 63 d]. if { [dic
4f40: 74 20 65 78 69 73 74 73 20 24 64 69 63 74 69 6f t exists $dictio
4f50: 6e 61 72 79 56 61 6c 75 65 20 7b 2a 7d 24 6b 65 naryValue {*}$ke
4f60: 79 73 5d 20 7d 20 7b 0a 09 72 65 74 75 72 6e 20 ys] } {..return
4f70: 5b 64 69 63 74 20 67 65 74 20 24 64 69 63 74 69 [dict get $dicti
4f80: 6f 6e 61 72 79 56 61 6c 75 65 20 7b 2a 7d 24 6b onaryValue {*}$k
4f90: 65 79 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 72 eys]. }. r
4fa0: 65 74 75 72 6e 20 24 64 65 66 61 75 6c 74 0a 7d eturn $default.}
4fb0: 0a 0a 70 72 6f 63 20 6c 69 6e 73 65 72 74 30 20 ..proc linsert0
4fc0: 7b 20 61 72 67 73 20 7d 20 7b 0a 20 20 20 20 73 { args } {. s
4fd0: 65 74 20 6f 70 74 69 6f 6e 61 6c 20 7b 0a 09 7b et optional {..{
4fe0: 20 2d 6d 61 78 5f 6c 65 6e 20 6c 65 6e 20 22 22 -max_len len ""
4ff0: 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 }. }. set
5000: 20 63 6f 6d 70 75 6c 73 6f 72 79 20 22 6c 69 73 compulsory "lis
5010: 74 20 65 6c 65 6d 65 6e 74 22 0a 20 20 20 20 70 t element". p
5020: 61 72 73 65 5f 61 72 67 73 20 24 6f 70 74 69 6f arse_args $optio
5030: 6e 61 6c 20 24 63 6f 6d 70 75 6c 73 6f 72 79 20 nal $compulsory
5040: 24 61 72 67 73 0a 0a 20 20 20 20 73 65 74 20 69 $args.. set i
5050: 70 6f 73 20 5b 6c 73 65 61 72 63 68 20 2d 65 78 pos [lsearch -ex
5060: 61 63 74 20 24 6c 69 73 74 20 24 65 6c 65 6d 65 act $list $eleme
5070: 6e 74 5d 0a 20 20 20 20 69 66 20 7b 20 24 69 70 nt]. if { $ip
5080: 6f 73 20 21 3d 20 2d 31 20 7d 20 7b 0a 09 73 65 os != -1 } {..se
5090: 74 20 6c 69 73 74 20 5b 6c 72 65 70 6c 61 63 65 t list [lreplace
50a0: 20 24 6c 69 73 74 20 24 69 70 6f 73 20 24 69 70 $list $ipos $ip
50b0: 6f 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 os]. }. se
50c0: 74 20 6c 69 73 74 20 5b 6c 69 6e 73 65 72 74 20 t list [linsert
50d0: 24 6c 69 73 74 20 30 20 24 65 6c 65 6d 65 6e 74 $list 0 $element
50e0: 5d 0a 20 20 20 20 69 66 20 7b 20 24 6d 61 78 5f ]. if { $max_
50f0: 6c 65 6e 20 6e 65 20 22 22 20 7d 20 7b 0a 09 73 len ne "" } {..s
5100: 65 74 20 6c 69 73 74 20 5b 6c 72 61 6e 67 65 20 et list [lrange
5110: 24 6c 69 73 74 20 30 20 24 6d 61 78 5f 6c 65 6e $list 0 $max_len
5120: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 ]. }. retu
5130: 72 6e 20 24 6c 69 73 74 0a 7d 0a 0a 23 23 23 23 rn $list.}..####
5140: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5150: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5160: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5170: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5180: 23 23 23 23 23 23 23 23 23 23 23 23 0a 23 20 20 ############.#
5190: 20 20 20 63 75 3a 3a 66 69 6c 65 3a 3a 65 78 65 cu::file::exe
51a0: 63 75 74 65 2c 20 63 75 3a 3a 6b 69 6c 6c 20 61 cute, cu::kill a
51b0: 6e 64 20 63 75 3a 3a 70 73 0a 23 23 23 23 23 23 nd cu::ps.######
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 23 23 23 23 23 23 23 23 23 23 23 ################
51f0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
5200: 23 23 23 23 23 23 23 23 23 23 0a 0a 70 72 6f 63 ##########..proc
5210: 20 63 75 3a 3a 6b 69 6c 6c 20 7b 20 70 69 64 20 cu::kill { pid
5220: 7d 20 7b 0a 0a 20 20 20 20 69 66 20 7b 20 24 3a } {.. if { $:
5230: 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c :tcl_platform(pl
5240: 61 74 66 6f 72 6d 29 20 65 71 20 22 77 69 6e 64 atform) eq "wind
5250: 6f 77 73 22 20 7d 20 7b 0a 09 70 61 63 6b 61 67 ows" } {..packag
5260: 65 20 72 65 71 75 69 72 65 20 63 6f 6d 70 61 73 e require compas
5270: 73 5f 75 74 69 6c 73 3a 3a 63 0a 09 72 65 74 75 s_utils::c..retu
5280: 72 6e 20 5b 63 75 3a 3a 5f 6b 69 6c 6c 5f 77 69 rn [cu::_kill_wi
5290: 6e 20 24 70 69 64 5d 0a 20 20 20 20 7d 20 65 6c n $pid]. } el
52a0: 73 65 20 7b 0a 09 65 78 65 63 20 6b 69 6c 6c 20 se {..exec kill
52b0: 24 70 69 64 20 0a 20 20 20 20 7d 0a 7d 0a 0a 70 $pid . }.}..p
52c0: 72 6f 63 20 63 75 3a 3a 70 73 20 7b 20 61 72 67 roc cu::ps { arg
52d0: 73 20 7d 20 7b 0a 0a 20 20 20 20 69 66 20 7b 20 s } {.. if {
52e0: 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 $::tcl_platform(
52f0: 70 6c 61 74 66 6f 72 6d 29 20 65 71 20 22 77 69 platform) eq "wi
5300: 6e 64 6f 77 73 22 20 7d 20 7b 0a 09 70 61 63 6b ndows" } {..pack
5310: 61 67 65 20 72 65 71 75 69 72 65 20 63 6f 6d 70 age require comp
5320: 61 73 73 5f 75 74 69 6c 73 3a 3a 63 0a 09 72 65 ass_utils::c..re
5330: 74 75 72 6e 20 5b 63 75 3a 3a 5f 70 73 5f 77 69 turn [cu::_ps_wi
5340: 6e 20 7b 2a 7d 24 61 72 67 73 5d 0a 20 20 20 20 n {*}$args].
5350: 7d 20 65 6c 73 65 20 7b 0a 09 23 20 64 6f 65 73 } else {..# does
5360: 20 6e 6f 74 20 64 6f 20 65 78 61 63 74 6c 79 20 not do exactly
5370: 74 68 65 20 73 61 6d 65 20 74 68 61 6e 20 69 6e the same than in
5380: 20 57 69 6e 64 6f 77 73 0a 09 23 73 65 74 20 65 Windows..#set e
5390: 72 72 20 5b 63 61 74 63 68 20 7b 20 65 78 65 63 rr [catch { exec
53a0: 20 70 67 72 65 70 20 2d 6c 20 2d 66 20 5b 6c 69 pgrep -l -f [li
53b0: 6e 64 65 78 20 24 61 72 67 73 20 30 5d 20 7d 20 ndex $args 0] }
53c0: 72 65 74 5d 0a 09 23 73 65 74 20 72 65 74 4c 69 ret]..#set retLi
53d0: 73 74 20 20 5b 73 70 6c 69 74 20 24 72 65 74 20 st [split $ret
53e0: 5c 6e 5d 0a 09 6c 61 73 73 69 67 6e 20 24 61 72 \n]..lassign $ar
53f0: 67 73 20 70 61 74 74 65 72 6e 0a 09 69 66 20 7b gs pattern..if {
5400: 20 24 70 61 74 74 65 72 6e 20 65 71 20 22 22 20 $pattern eq ""
5410: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 65 72 72 } {.. set err
5420: 20 5b 63 61 74 63 68 20 7b 20 65 78 65 63 20 70 [catch { exec p
5430: 73 20 2d 75 20 24 3a 3a 65 6e 76 28 55 53 45 52 s -u $::env(USER
5440: 29 20 2d 2d 6e 6f 2d 68 65 61 64 65 72 73 20 2d ) --no-headers -
5450: 6f 20 70 69 64 2c 73 74 69 6d 65 2c 74 69 6d 65 o pid,stime,time
5460: 2c 73 69 7a 65 2c 63 6d 64 20 7d 20 72 65 74 5d ,size,cmd } ret]
5470: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
5480: 73 65 74 20 65 72 72 20 5b 63 61 74 63 68 20 7b set err [catch {
5490: 20 65 78 65 63 20 70 73 20 2d 75 20 24 3a 3a 65 exec ps -u $::e
54a0: 6e 76 28 55 53 45 52 29 20 2d 2d 6e 6f 2d 68 65 nv(USER) --no-he
54b0: 61 64 65 72 73 20 2d 6f 20 70 69 64 2c 73 74 69 aders -o pid,sti
54c0: 6d 65 2c 74 69 6d 65 2c 73 69 7a 65 2c 63 6d 64 me,time,size,cmd
54d0: 20 7c 20 67 72 65 70 20 2d 69 20 24 70 61 74 74 | grep -i $patt
54e0: 65 72 6e 20 7d 20 72 65 74 5d 0a 09 7d 20 20 20 ern } ret]..}
54f0: 20 20 20 20 20 0a 09 69 66 20 7b 20 24 65 72 72 ..if { $err
5500: 20 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 6e } {.. return
5510: 20 22 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 ""..} else {..
5520: 20 20 20 73 65 74 20 72 65 74 4c 69 73 74 20 22 set retList "
5530: 22 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 6c ".. foreach l
5540: 69 6e 65 20 5b 73 70 6c 69 74 20 24 72 65 74 20 ine [split $ret
5550: 5c 6e 5d 20 7b 0a 09 09 72 65 67 65 78 70 20 7b \n] {...regexp {
5560: 28 5c 53 2b 29 5c 73 2b 28 5c 53 2b 29 5c 73 2b (\S+)\s+(\S+)\s+
5570: 28 5c 53 2b 29 5c 73 2b 28 5c 53 2b 29 5c 73 2b (\S+)\s+(\S+)\s+
5580: 28 2e 2a 29 7d 20 24 6c 69 6e 65 20 7b 7d 20 70 (.*)} $line {} p
5590: 69 64 20 73 74 69 6d 65 20 63 70 75 74 69 6d 65 id stime cputime
55a0: 20 73 69 7a 65 20 63 6d 64 0a 09 09 6c 61 70 70 size cmd...lapp
55b0: 65 6e 64 20 72 65 74 4c 69 73 74 20 5b 6c 69 73 end retList [lis
55c0: 74 20 24 63 6d 64 20 24 70 69 64 20 24 73 74 69 t $cmd $pid $sti
55d0: 6d 65 20 24 63 70 75 74 69 6d 65 20 24 73 69 7a me $cputime $siz
55e0: 65 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 72 e].. }.. r
55f0: 65 74 75 72 6e 20 24 72 65 74 4c 69 73 74 0a 09 eturn $retList..
5600: 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 }. }.}..proc
5610: 63 75 3a 3a 66 69 6c 65 3a 3a 65 78 65 63 75 74 cu::file::execut
5620: 65 20 7b 20 61 72 67 73 20 7d 20 7b 0a 20 20 20 e { args } {.
5630: 20 0a 20 20 20 20 73 65 74 20 6f 70 74 69 6f 6e . set option
5640: 61 6c 20 7b 0a 09 7b 20 2d 77 6f 72 6b 64 69 72 al {..{ -workdir
5650: 20 64 69 72 65 63 74 6f 72 79 20 22 22 20 7d 0a directory "" }.
5660: 09 7b 20 2d 77 61 69 74 20 62 6f 6f 6c 65 61 6e .{ -wait boolean
5670: 20 30 20 7d 0a 09 7b 20 2d 68 69 64 65 5f 77 69 0 }..{ -hide_wi
5680: 6e 64 6f 77 20 62 6f 6f 6c 65 61 6e 20 30 20 7d ndow boolean 0 }
5690: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 . }. set c
56a0: 6f 6d 70 75 6c 73 6f 72 79 20 22 77 68 61 74 20 ompulsory "what
56b0: 66 69 6c 65 22 0a 0a 20 20 20 20 73 65 74 20 61 file".. set a
56c0: 72 67 73 20 5b 70 61 72 73 65 5f 61 72 67 73 20 rgs [parse_args
56d0: 2d 72 61 69 73 65 5f 63 6f 6d 70 75 6c 73 6f 72 -raise_compulsor
56e0: 79 5f 65 72 72 6f 72 20 30 20 24 6f 70 74 69 6f y_error 0 $optio
56f0: 6e 61 6c 20 24 63 6f 6d 70 75 6c 73 6f 72 79 20 nal $compulsory
5700: 24 61 72 67 73 5d 0a 0a 20 20 20 20 73 77 69 74 $args].. swit
5710: 63 68 20 2d 2d 20 24 77 68 61 74 20 7b 0a 09 67 ch -- $what {..g
5720: 69 64 20 7b 0a 09 20 20 20 20 73 65 74 20 65 78 id {.. set ex
5730: 65 20 5b 67 65 74 5f 65 78 65 63 75 74 61 62 6c e [get_executabl
5740: 65 5f 70 61 74 68 20 67 69 64 5d 0a 09 20 20 20 e_path gid]..
5750: 20 69 66 20 7b 20 24 65 78 65 20 65 71 20 22 22 if { $exe eq ""
5760: 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a 09 20 } { return }..
5770: 20 20 20 69 66 20 7b 20 24 77 61 69 74 20 7c 7c if { $wait ||
5780: 20 24 68 69 64 65 5f 77 69 6e 64 6f 77 20 7d 20 $hide_window }
5790: 7b 0a 09 09 73 65 74 20 65 72 72 20 5b 63 61 74 {...set err [cat
57a0: 63 68 20 7b 20 70 61 63 6b 61 67 65 20 72 65 71 ch { package req
57b0: 75 69 72 65 20 74 77 61 70 69 20 7d 5d 0a 09 09 uire twapi }]...
57c0: 69 66 20 7b 20 24 65 72 72 20 7d 20 7b 20 73 65 if { $err } { se
57d0: 74 20 68 61 73 5f 74 77 61 70 69 20 30 20 7d 20 t has_twapi 0 }
57e0: 65 6c 73 65 20 7b 20 73 65 74 20 68 61 73 5f 74 else { set has_t
57f0: 77 61 70 69 20 31 20 7d 0a 09 20 20 20 20 7d 0a wapi 1 }.. }.
5800: 09 20 20 20 20 69 66 20 7b 20 21 24 77 61 69 74 . if { !$wait
5810: 20 7c 7c 20 24 68 61 73 5f 74 77 61 70 69 20 7d || $has_twapi }
5820: 20 7b 20 6c 61 70 70 65 6e 64 20 61 72 67 73 20 { lappend args
5830: 26 20 7d 0a 09 20 20 20 20 73 65 74 20 70 69 64 & }.. set pid
5840: 20 5b 65 78 65 63 20 24 65 78 65 20 24 66 69 6c [exec $exe $fil
5850: 65 20 7b 2a 7d 24 61 72 67 73 5d 0a 09 20 20 20 e {*}$args]..
5860: 0a 09 20 20 20 20 69 66 20 7b 20 21 24 77 61 69 .. if { !$wai
5870: 74 20 26 26 20 21 24 68 69 64 65 5f 77 69 6e 64 t && !$hide_wind
5880: 6f 77 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a ow } { return }.
5890: 09 20 20 20 20 69 66 20 7b 20 21 24 68 61 73 5f . if { !$has_
58a0: 74 77 61 70 69 20 7d 20 7b 20 72 65 74 75 72 6e twapi } { return
58b0: 20 7d 0a 0a 09 20 20 20 20 69 66 20 7b 20 24 68 }... if { $h
58c0: 69 64 65 5f 77 69 6e 64 6f 77 20 7d 20 7b 0a 09 ide_window } {..
58d0: 09 66 6f 72 65 61 63 68 20 68 77 69 6e 20 5b 74 .foreach hwin [t
58e0: 77 61 70 69 3a 3a 66 69 6e 64 5f 77 69 6e 64 6f wapi::find_windo
58f0: 77 73 20 2d 70 69 64 73 20 24 70 69 64 20 2d 76 ws -pids $pid -v
5900: 69 73 69 62 6c 65 20 74 72 75 65 5d 20 7b 0a 09 isible true] {..
5910: 09 20 20 20 20 74 77 61 70 69 3a 3a 68 69 64 65 . twapi::hide
5920: 5f 77 69 6e 64 6f 77 20 24 68 77 69 6e 0a 09 09 _window $hwin...
5930: 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 }.. }.. if
5940: 20 7b 20 24 77 61 69 74 20 7d 20 7b 0a 09 09 77 { $wait } {...w
5950: 68 69 6c 65 20 7b 20 5b 74 77 61 70 69 3a 3a 70 hile { [twapi::p
5960: 72 6f 63 65 73 73 5f 65 78 69 73 74 73 20 24 70 rocess_exists $p
5970: 69 64 5d 20 7d 20 7b 0a 09 09 20 20 20 20 61 66 id] } {... af
5980: 74 65 72 20 32 30 30 0a 09 09 7d 0a 09 20 20 20 ter 200...}..
5990: 20 7d 0a 09 7d 0a 09 65 6d 61 63 73 20 7b 0a 09 }..}..emacs {..
59a0: 20 20 20 20 65 78 65 63 20 72 75 6e 65 6d 61 63 exec runemac
59b0: 73 20 2d 67 20 31 30 30 78 37 32 20 26 0a 09 7d s -g 100x72 &..}
59c0: 0a 09 77 69 73 68 20 7b 0a 09 20 20 20 20 73 65 ..wish {.. se
59d0: 74 20 70 77 64 20 5b 70 77 64 5d 0a 09 20 20 20 t pwd [pwd]..
59e0: 20 63 64 20 5b 66 69 6c 65 20 64 69 72 6e 61 6d cd [file dirnam
59f0: 65 20 24 66 69 6c 65 5d 0a 09 20 20 20 20 65 76 e $file].. ev
5a00: 61 6c 20 65 78 65 63 20 77 69 73 68 20 5b 6c 69 al exec wish [li
5a10: 73 74 20 5b 66 69 6c 65 20 6e 6f 72 6d 61 6c 69 st [file normali
5a20: 7a 65 20 24 66 69 6c 65 5d 5d 20 24 61 72 67 73 ze $file]] $args
5a30: 20 26 0a 09 20 20 20 20 63 64 20 24 70 77 64 0a &.. cd $pwd.
5a40: 09 7d 0a 09 74 6b 64 69 66 66 20 7b 0a 09 20 20 .}..tkdiff {..
5a50: 20 20 73 65 74 20 70 77 64 20 5b 70 77 64 5d 0a set pwd [pwd].
5a60: 09 20 20 20 20 63 64 20 5b 66 69 6c 65 20 64 69 . cd [file di
5a70: 72 6e 61 6d 65 20 24 66 69 6c 65 5d 0a 09 20 20 rname $file]..
5a80: 20 20 65 78 65 63 20 77 69 73 68 20 7e 2f 6d 79 exec wish ~/my
5a90: 54 63 6c 54 6b 2f 74 6b 63 76 73 2f 62 69 6e 2f TclTk/tkcvs/bin/
5aa0: 74 6b 64 69 66 66 2e 74 63 6c 20 2d 72 20 5b 66 tkdiff.tcl -r [f
5ab0: 69 6c 65 20 74 61 69 6c 20 24 66 69 6c 65 5d 20 ile tail $file]
5ac0: 26 0a 09 20 20 20 20 63 64 20 24 70 77 64 0a 09 &.. cd $pwd..
5ad0: 7d 0a 09 73 74 61 72 74 20 7b 0a 09 20 20 20 20 }..start {..
5ae0: 69 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 if { $::tcl_plat
5af0: 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 65 form(platform) e
5b00: 71 20 22 75 6e 69 78 22 20 7d 20 7b 0a 09 09 73 q "unix" } {...s
5b10: 65 74 20 70 72 6f 67 72 61 6d 73 20 5b 6c 69 73 et programs [lis
5b20: 74 20 78 64 67 2d 6f 70 65 6e 20 67 6e 6f 6d 65 t xdg-open gnome
5b30: 2d 6f 70 65 6e 5d 0a 09 09 69 66 20 7b 20 24 3a -open]...if { $:
5b40: 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 6f 73 :tcl_platform(os
5b50: 29 20 65 71 20 22 44 61 72 77 69 6e 22 20 7d 20 ) eq "Darwin" }
5b60: 7b 0a 09 09 20 20 20 20 73 65 74 20 70 72 6f 67 {... set prog
5b70: 72 61 6d 73 20 5b 6c 69 6e 73 65 72 74 20 24 70 rams [linsert $p
5b80: 72 6f 67 72 61 6d 73 20 30 20 6f 70 65 6e 5d 0a rograms 0 open].
5b90: 09 09 7d 0a 09 09 66 6f 72 65 61 63 68 20 69 20 ..}...foreach i
5ba0: 24 70 72 6f 67 72 61 6d 73 20 7b 0a 09 09 20 20 $programs {...
5bb0: 20 20 69 66 20 7b 20 5b 61 75 74 6f 5f 65 78 65 if { [auto_exe
5bc0: 63 6f 6b 20 24 69 5d 20 6e 65 20 22 22 20 7d 20 cok $i] ne "" }
5bd0: 7b 0a 09 09 20 20 20 20 20 20 20 20 65 78 65 63 {... exec
5be0: 20 24 69 20 24 66 69 6c 65 20 26 0a 09 09 20 20 $i $file &...
5bf0: 20 20 20 20 20 20 72 65 74 75 72 6e 0a 09 09 20 return...
5c00: 20 20 20 7d 0a 09 09 7d 0a 09 09 65 72 72 6f 72 }...}...error
5c10: 20 22 63 6f 75 6c 64 20 6e 6f 74 20 6f 70 65 6e "could not open
5c20: 20 66 69 6c 65 20 27 24 66 69 6c 65 27 22 0a 09 file '$file'"..
5c30: 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 20 5b } elseif { [
5c40: 72 65 67 65 78 70 20 7b 5b 26 5d 7d 20 24 66 69 regexp {[&]} $fi
5c50: 6c 65 5d 20 7d 20 7b 0a 09 09 73 65 74 20 62 61 le] } {...set ba
5c60: 74 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 t [file join [fi
5c70: 6c 65 20 64 69 72 6e 61 6d 65 20 24 66 69 6c 65 le dirname $file
5c80: 5d 20 61 2e 62 61 74 5d 0a 09 09 73 65 74 20 66 ] a.bat]...set f
5c90: 6f 75 74 20 5b 6f 70 65 6e 20 24 62 61 74 20 77 out [open $bat w
5ca0: 5d 0a 09 09 70 75 74 73 20 24 66 6f 75 74 20 22 ]...puts $fout "
5cb0: 73 74 61 72 74 20 5c 22 5c 22 20 5c 22 24 66 69 start \"\" \"$fi
5cc0: 6c 65 5c 22 22 0a 09 09 63 6c 6f 73 65 20 24 66 le\""...close $f
5cd0: 6f 75 74 0a 09 09 65 78 65 63 20 24 62 61 74 20 out...exec $bat
5ce0: 0a 09 09 66 69 6c 65 20 64 65 6c 65 74 65 20 24 ...file delete $
5cf0: 62 61 74 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 bat.. } else
5d00: 7b 0a 09 09 65 76 61 6c 20 65 78 65 63 20 5b 61 {...eval exec [a
5d10: 75 74 6f 5f 65 78 65 63 6f 6b 20 73 74 61 72 74 uto_execok start
5d20: 5d 20 5c 22 5c 22 20 5b 6c 69 73 74 20 24 66 69 ] \"\" [list $fi
5d30: 6c 65 5d 20 7b 2a 7d 24 61 72 67 73 20 26 0a 09 le] {*}$args &..
5d40: 20 20 20 20 7d 0a 09 7d 0a 09 75 72 6c 20 7b 0a }..}..url {.
5d50: 09 20 20 20 20 69 66 20 7b 20 5b 72 65 67 65 78 . if { [regex
5d60: 70 20 7b 5e 5b 2d 5c 77 2e 5d 2b 24 7d 20 24 66 p {^[-\w.]+$} $f
5d70: 69 6c 65 5d 20 7d 20 7b 0a 09 09 73 65 74 20 66 ile] } {...set f
5d80: 69 6c 65 20 68 74 74 70 3a 2f 2f 24 66 69 6c 65 ile http://$file
5d90: 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 .. }.. if
5da0: 7b 20 21 5b 72 65 67 65 78 70 20 7b 28 3f 69 29 { ![regexp {(?i)
5db0: 5e 5c 77 2b 3a 2f 2f 7d 20 24 66 69 6c 65 5d 20 ^\w+://} $file]
5dc0: 26 26 20 21 5b 72 65 67 65 78 70 20 7b 28 3f 69 && ![regexp {(?i
5dd0: 29 5e 6d 61 69 6c 74 6f 3a 7d 20 24 66 69 6c 65 )^mailto:} $file
5de0: 5d 20 7d 20 7b 0a 09 09 73 65 74 20 74 78 74 20 ] } {...set txt
5df0: 5b 5f 20 22 75 72 6c 20 64 6f 65 73 20 6e 6f 74 [_ "url does not
5e00: 20 62 65 67 69 6e 20 77 69 74 68 20 61 20 6b 6e begin with a kn
5e10: 6f 77 6e 20 68 61 6e 64 6c 65 72 20 6c 69 6b 65 own handler like
5e20: 3a 20 25 73 2e 20 50 72 6f 63 65 65 64 3f 22 20 : %s. Proceed?"
5e30: 5c 0a 09 09 20 20 20 20 20 20 20 20 22 68 74 74 \... "htt
5e40: 70 3a 2f 2f 20 66 74 70 3a 2f 2f 20 6d 61 69 6c p:// ftp:// mail
5e50: 74 6f 3a 22 5d 0a 09 09 73 65 74 20 72 65 74 76 to:"]...set retv
5e60: 61 6c 20 5b 74 6b 5f 6d 65 73 73 61 67 65 42 6f al [tk_messageBo
5e70: 78 20 2d 64 65 66 61 75 6c 74 20 6f 6b 20 2d 69 x -default ok -i
5e80: 63 6f 6e 20 71 75 65 73 74 69 6f 6e 20 2d 6d 65 con question -me
5e90: 73 73 61 67 65 20 24 74 78 74 20 5c 0a 09 09 20 ssage $txt \...
5ea0: 20 20 20 20 20 20 20 2d 74 79 70 65 20 6f 6b 63 -type okc
5eb0: 61 6e 63 65 6c 5d 0a 09 09 69 66 20 7b 20 24 72 ancel]...if { $r
5ec0: 65 74 76 61 6c 20 3d 3d 20 22 63 61 6e 63 65 6c etval == "cancel
5ed0: 22 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a 09 " } { return }..
5ee0: 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 20 }.. if {
5ef0: 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 $::tcl_platform(
5f00: 70 6c 61 74 66 6f 72 6d 29 20 65 71 20 22 77 69 platform) eq "wi
5f10: 6e 64 6f 77 73 22 20 7d 20 7b 0a 09 09 65 78 65 ndows" } {...exe
5f20: 63 20 72 75 6e 64 6c 6c 33 32 20 75 72 6c 2e 64 c rundll32 url.d
5f30: 6c 6c 2c 46 69 6c 65 50 72 6f 74 6f 63 6f 6c 48 ll,FileProtocolH
5f40: 61 6e 64 6c 65 72 20 24 66 69 6c 65 20 26 0a 09 andler $file &..
5f50: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 } else {...s
5f60: 65 74 20 70 72 6f 67 72 61 6d 73 20 5b 6c 69 73 et programs [lis
5f70: 74 20 78 64 67 2d 6f 70 65 6e 20 67 6e 6f 6d 65 t xdg-open gnome
5f80: 2d 6f 70 65 6e 5d 0a 09 09 69 66 20 7b 20 24 3a -open]...if { $:
5f90: 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 6f 73 :tcl_platform(os
5fa0: 29 20 65 71 20 22 44 61 72 77 69 6e 22 20 7d 20 ) eq "Darwin" }
5fb0: 7b 0a 09 09 20 20 20 20 73 65 74 20 70 72 6f 67 {... set prog
5fc0: 72 61 6d 73 20 5b 6c 69 6e 73 65 72 74 20 24 70 rams [linsert $p
5fd0: 72 6f 67 72 61 6d 73 20 30 20 6f 70 65 6e 5d 0a rograms 0 open].
5fe0: 09 09 7d 0a 09 09 66 6f 72 65 61 63 68 20 69 20 ..}...foreach i
5ff0: 24 70 72 6f 67 72 61 6d 73 20 7b 0a 09 09 20 20 $programs {...
6000: 20 20 69 66 20 7b 20 5b 61 75 74 6f 5f 65 78 65 if { [auto_exe
6010: 63 6f 6b 20 24 69 5d 20 6e 65 20 22 22 20 7d 20 cok $i] ne "" }
6020: 7b 0a 09 09 20 20 20 20 20 20 20 20 65 78 65 63 {... exec
6030: 20 24 69 20 24 66 69 6c 65 20 26 0a 09 09 20 20 $i $file &...
6040: 20 20 20 20 20 20 72 65 74 75 72 6e 0a 09 09 20 return...
6050: 20 20 20 7d 0a 09 09 7d 0a 09 09 73 65 74 20 63 }...}...set c
6060: 6d 64 4c 69 73 74 20 22 22 0a 09 09 66 6f 72 65 mdList ""...fore
6070: 61 63 68 20 69 20 5b 6c 69 73 74 20 66 69 72 65 ach i [list fire
6080: 66 6f 78 20 6b 6f 6e 71 75 65 72 6f 72 20 6d 6f fox konqueror mo
6090: 7a 69 6c 6c 61 20 6f 70 65 72 61 20 6e 65 74 73 zilla opera nets
60a0: 63 61 70 65 5d 20 7b 0a 09 09 20 20 20 20 6c 61 cape] {... la
60b0: 70 70 65 6e 64 20 63 6d 64 4c 69 73 74 20 22 24 ppend cmdList "$
60c0: 69 20 5c 22 24 66 69 6c 65 5c 22 22 0a 09 09 7d i \"$file\""...}
60d0: 0a 09 09 65 78 65 63 20 73 68 20 2d 63 20 5b 6a ...exec sh -c [j
60e0: 6f 69 6e 20 24 63 6d 64 4c 69 73 74 20 22 7c 7c oin $cmdList "||
60f0: 22 5d 20 26 20 0a 09 20 20 20 20 7d 0a 09 7d 0a "] & .. }..}.
6100: 09 65 78 65 63 20 7b 0a 09 20 20 20 20 69 66 20 .exec {.. if
6110: 7b 20 24 77 6f 72 6b 64 69 72 20 6e 65 20 22 22 { $workdir ne ""
6120: 20 7d 20 7b 0a 09 09 73 65 74 20 70 77 64 20 5b } {...set pwd [
6130: 70 77 64 5d 0a 09 09 63 64 20 24 77 6f 72 6b 64 pwd]...cd $workd
6140: 69 72 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 73 ir.. }.. s
6150: 65 74 20 65 72 72 20 5b 63 61 74 63 68 20 7b 20 et err [catch {
6160: 65 78 65 63 20 24 66 69 6c 65 20 7b 2a 7d 24 61 exec $file {*}$a
6170: 72 67 73 20 7d 20 65 72 72 73 74 72 69 6e 67 5d rgs } errstring]
6180: 0a 09 20 20 20 20 69 66 20 7b 20 24 77 6f 72 6b .. if { $work
6190: 64 69 72 20 6e 65 20 22 22 20 7d 20 7b 20 63 64 dir ne "" } { cd
61a0: 20 24 70 77 64 20 7d 0a 09 20 20 20 20 69 66 20 $pwd }.. if
61b0: 7b 20 24 65 72 72 20 7d 20 7b 0a 09 09 65 72 72 { $err } {...err
61c0: 6f 72 20 24 65 72 72 73 74 72 69 6e 67 20 24 3a or $errstring $:
61d0: 3a 65 72 72 6f 72 49 6e 66 6f 0a 09 20 20 20 20 :errorInfo..
61e0: 7d 0a 09 7d 0a 09 65 78 65 63 4c 69 73 74 20 7b }..}..execList {
61f0: 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 69 20 .. foreach i
6200: 24 66 69 6c 65 20 7b 0a 09 09 69 66 20 7b 20 5b $file {...if { [
6210: 61 75 74 6f 5f 65 78 65 63 6f 6b 20 5b 6c 69 6e auto_execok [lin
6220: 64 65 78 20 24 69 20 30 5d 5d 20 6e 65 20 22 22 dex $i 0]] ne ""
6230: 20 7d 20 7b 0a 09 09 20 20 20 20 65 78 65 63 20 } {... exec
6240: 7b 2a 7d 24 69 20 26 0a 09 09 20 20 20 20 72 65 {*}$i &... re
6250: 74 75 72 6e 0a 09 09 7d 0a 09 20 20 20 20 7d 0a turn...}.. }.
6260: 09 20 20 65 72 72 6f 72 20 22 43 6f 75 6c 64 20 . error "Could
6270: 6e 6f 74 20 65 78 65 63 75 74 65 20 66 69 6c 65 not execute file
6280: 73 22 0a 09 7d 0a 09 64 65 66 61 75 6c 74 20 7b s"..}..default {
6290: 0a 09 20 20 20 20 69 66 20 7b 20 24 77 6f 72 6b .. if { $work
62a0: 64 69 72 20 6e 65 20 22 22 20 7d 20 7b 0a 09 09 dir ne "" } {...
62b0: 73 65 74 20 70 77 64 20 5b 70 77 64 5d 0a 09 09 set pwd [pwd]...
62c0: 63 64 20 24 77 6f 72 6b 64 69 72 0a 09 20 20 20 cd $workdir..
62d0: 20 7d 0a 09 20 20 20 20 73 65 74 20 65 72 72 20 }.. set err
62e0: 5b 63 61 74 63 68 20 7b 20 65 78 65 63 20 24 66 [catch { exec $f
62f0: 69 6c 65 20 7b 2a 7d 24 61 72 67 73 20 26 20 7d ile {*}$args & }
6300: 20 65 72 72 73 74 72 69 6e 67 5d 0a 09 20 20 20 errstring]..
6310: 20 69 66 20 7b 20 24 77 6f 72 6b 64 69 72 20 6e if { $workdir n
6320: 65 20 22 22 20 7d 20 7b 20 63 64 20 24 70 77 64 e "" } { cd $pwd
6330: 20 7d 0a 09 20 20 20 20 69 66 20 7b 20 24 65 72 }.. if { $er
6340: 72 20 7d 20 7b 0a 09 09 65 72 72 6f 72 20 24 65 r } {...error $e
6350: 72 72 73 74 72 69 6e 67 20 24 3a 3a 65 72 72 6f rrstring $::erro
6360: 72 49 6e 66 6f 0a 09 20 20 20 20 7d 0a 09 7d 0a rInfo.. }..}.
6370: 20 20 20 20 7d 20 20 0a 7d } .}