Artifact
4c4121f70aaac39756082ad7d850987d2876815f:
- File
addons/dialogwin/dialogwin.tcl
— part of check-in
[8995b4234c]
at
2017-04-13 18:09:43
on branch trunk
— try not loading compass_utils in RamDebugger unless necessary
(user:
ramsan
size: 82231)
0000: 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
0010: 20 54 63 6c 20 38 2e 35 0a 70 61 63 6b 61 67 65 Tcl 8.5.package
0020: 20 72 65 71 75 69 72 65 20 54 6b 20 38 2e 35 0a require Tk 8.5.
0030: 63 61 74 63 68 20 7b 20 70 61 63 6b 61 67 65 20 catch { package
0040: 72 65 71 75 69 72 65 20 69 6d 67 3a 3a 70 6e 67 require img::png
0050: 20 7d 0a 0a 23 20 74 6f 20 61 75 74 6f 20 6c 6f }..# to auto lo
0060: 61 64 20 66 72 6f 6d 20 47 69 44 0a 63 61 74 63 ad from GiD.catc
0070: 68 20 7b 0a 20 20 20 20 61 75 74 6f 5f 6c 6f 61 h {. auto_loa
0080: 64 20 6d 73 67 63 61 74 3a 3a 6d 63 0a 20 20 20 d msgcat::mc.
0090: 20 6d 73 67 63 61 74 3a 3a 6d 63 20 22 22 0a 7d msgcat::mc "".}
00a0: 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
00b0: 20 6d 73 67 63 61 74 0a 70 61 63 6b 61 67 65 20 msgcat.package
00c0: 72 65 71 75 69 72 65 20 73 6e 69 74 0a 0a 6e 61 require snit..na
00d0: 6d 65 73 70 61 63 65 20 65 76 61 6c 20 3a 3a 64 mespace eval ::d
00e0: 69 61 6c 6f 67 77 69 6e 6d 73 67 73 20 7b 0a 20 ialogwinmsgs {.
00f0: 20 20 20 3a 3a 6d 73 67 63 61 74 3a 3a 6d 63 6c ::msgcat::mcl
0100: 6f 61 64 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b oad [file join [
0110: 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 5b 69 6e file dirname [in
0120: 66 6f 20 73 63 72 69 70 74 5d 5d 20 6d 73 67 73 fo script]] msgs
0130: 5d 0a 0a 7d 0a 0a 69 66 20 7b 20 5b 69 6e 66 6f ]..}..if { [info
0140: 20 63 6f 6d 6d 61 6e 64 73 20 5f 5d 20 65 71 20 commands _] eq
0150: 22 22 20 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 "" } {. proc
0160: 5f 20 7b 20 61 72 67 73 20 7d 20 7b 0a 09 73 65 _ { args } {..se
0170: 74 20 72 65 74 20 5b 75 70 6c 65 76 65 6c 20 31 t ret [uplevel 1
0180: 20 3a 3a 6d 73 67 63 61 74 3a 3a 6d 63 20 24 61 ::msgcat::mc $a
0190: 72 67 73 5d 0a 09 72 65 67 65 78 70 20 7b 28 2e rgs]..regexp {(.
01a0: 2a 29 23 43 23 28 2e 2a 29 7d 20 24 72 65 74 20 *)#C#(.*)} $ret
01b0: 7b 7d 20 72 65 74 0a 09 72 65 74 75 72 6e 20 24 {} ret..return $
01c0: 72 65 74 0a 20 20 20 20 7d 0a 7d 0a 0a 69 66 20 ret. }.}..if
01d0: 7b 20 5b 69 6e 66 6f 20 70 72 6f 63 73 20 47 65 { [info procs Ge
01e0: 74 49 6d 61 67 65 5d 20 3d 3d 20 22 22 20 7c 7c tImage] == "" ||
01f0: 20 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 3a ![info exists :
0200: 3a 47 49 44 44 45 46 41 55 4c 54 5d 20 7d 20 7b :GIDDEFAULT] } {
0210: 0a 20 20 20 20 23 75 73 69 6e 67 20 77 69 74 68 . #using with
0220: 6f 75 74 20 47 69 44 20 47 65 74 49 6d 61 67 65 out GiD GetImage
0230: 20 6e 6f 74 20 65 78 69 73 74 73 2c 20 74 68 65 not exists, the
0240: 6e 20 72 65 74 75 72 6e 20 61 6c 77 61 79 73 20 n return always
0250: 64 69 61 6c 6f 67 77 69 6e 71 75 65 73 74 69 6f dialogwinquestio
0260: 6e 68 65 61 64 0a 20 20 20 20 69 6d 61 67 65 20 nhead. image
0270: 63 72 65 61 74 65 20 70 68 6f 74 6f 20 64 69 61 create photo dia
0280: 6c 6f 67 77 69 6e 71 75 65 73 74 69 6f 6e 68 65 logwinquestionhe
0290: 61 64 20 2d 64 61 74 61 20 7b 0a 09 52 30 6c 47 ad -data {..R0lG
02a0: 4f 44 6c 68 4b 41 41 6f 41 4b 55 41 41 50 48 59 ODlhKAAoAKUAAPHY
02b0: 38 2b 79 39 2b 64 6d 58 31 62 78 4c 74 37 45 4d 8+y9+dmX1bxLt7EM
02c0: 70 72 41 54 71 73 49 58 74 73 45 30 74 64 61 47 prATqsIXtsE0tdaG
02d0: 7a 2b 62 4b 32 73 39 34 79 74 34 55 78 65 55 4e z+bK2s94yt4UxeUN
02e0: 7a 4e 67 4b 0a 09 77 63 67 45 73 63 51 4c 73 62 zNgK..wcgEscQLsb
02f0: 45 44 6f 63 51 6a 74 4f 45 6c 7a 66 45 62 32 50 EDocQjtOElzfEb2P
0300: 4d 57 31 4f 51 63 7a 4d 46 35 75 75 4f 72 32 64 MW1OQczMF5uuOr2d
0310: 73 73 79 66 77 30 36 76 55 6b 33 4d 31 5a 76 73 ssyfw06vUk3M1Zvs
0320: 53 63 77 4d 57 72 74 74 46 49 77 61 77 32 0a 09 ScwMWrttFIwaw2..
0330: 71 66 59 38 36 74 47 34 76 76 4c 57 31 75 48 56 qfY86tG4vvLW1uHV
0340: 31 4e 72 45 78 72 53 53 70 4d 77 2b 75 50 68 48 1NrExrSSpMw+uPhH
0350: 37 39 47 59 77 66 74 56 2b 74 38 7a 79 50 58 6a 79GYwftV+t8zyPXj
0360: 35 62 52 71 71 50 78 6f 2f 4e 78 63 79 50 6f 73 5bRqqPxo/NxcyPos
0370: 35 63 42 59 73 4e 36 6a 0a 09 7a 75 47 34 32 4e 5cBYsN6j..zuG42N
0380: 77 2b 78 4d 53 69 76 4e 78 34 78 4f 78 43 33 4c w+xMSivNx4xOxC3L
0390: 38 72 72 38 78 6b 76 4f 52 4d 30 4d 6c 72 75 65 8rr8xkvORM0Mlrue
03a0: 42 6b 79 4c 78 44 74 50 2f 2f 2f 2f 2f 2f 2f 2f BkyLxDtP////////
03b0: 2f 2f 2f 79 48 2b 46 55 4e 79 5a 57 46 30 5a 57 ///yH+FUNyZWF0ZW
03c0: 51 67 0a 09 64 32 6c 30 61 43 42 55 61 47 55 67 Qg..d2l0aCBUaGUg
03d0: 52 30 6c 4e 55 41 41 68 2b 51 51 42 43 67 41 2f R0lNUAAh+QQBCgA/
03e0: 41 43 77 41 41 41 41 41 4b 41 41 6f 41 41 41 47 ACwAAAAAKAAoAAAG
03f0: 2f 73 43 66 63 45 67 73 47 6f 2f 49 70 48 4c 4a /sCfcEgsGo/IpHLJ
0400: 62 44 71 66 30 4b 6a 30 43 41 68 59 0a 09 41 64 bDqf0Kj0CAhY..Ad
0410: 4f 6d 59 45 44 6f 64 67 75 47 41 79 4b 52 4e 53 OmYEDodguGAyKRNS
0420: 6f 4d 36 49 57 61 30 57 67 34 48 68 44 49 67 46 oM6IWa0Wg4HhDIgF
0430: 77 4f 52 41 77 53 79 59 52 53 6f 54 41 6d 44 41 wORAwSyYRSoTAmDA
0440: 74 73 44 6e 45 57 57 52 63 47 47 42 6b 61 45 78 tsDnEWWRcGGBkaEx
0450: 49 62 46 68 77 64 0a 09 48 52 77 4b 48 6f 4a 75 IbFhwd..HRwKHoJu
0460: 45 42 39 53 46 78 45 67 49 49 77 62 49 51 6b 4a EB9SFxEgIIwbIQkJ
0470: 49 69 4d 69 43 53 51 68 4a 53 61 44 6d 56 41 4a IiMiCSQhJSaDmVAJ
0480: 45 53 63 6e 6a 43 67 41 49 72 65 34 75 41 6b 64 EScnjCgAIre4uAkd
0490: 41 33 36 45 41 30 38 6d 4a 79 6d 4d 43 6a 2b 33 A36EA08mJymMCj+3
04a0: 0a 09 74 72 65 6d 75 43 4d 64 47 4c 34 51 4b 45 ..tremuCMdGL4QKE
04b0: 30 49 49 43 6b 5a 46 43 6f 72 4b 38 73 72 43 53 0IICkZFCorK8srCS
04c0: 47 69 75 51 6b 73 65 32 34 45 54 53 6f 74 4a 33 GiuQkse24ETSotJ3
04d0: 73 75 78 37 63 2f 43 52 34 59 47 42 62 62 75 42 sux7c/CR4YGBbbuB
04e0: 77 55 2b 41 30 51 68 6b 6f 43 0a 09 4a 79 30 76 wU+A0QhkoC..Jy0v
04f0: 38 4a 6e 67 74 6b 4c 46 48 67 6f 65 32 74 30 4b 8JngtkLFHgoe2t0K
0500: 77 63 66 50 67 77 4a 4c 50 4c 52 49 4d 57 48 50 wcfPgwJLPLRIMWHP
0510: 42 42 67 64 51 70 44 59 67 4b 38 69 42 34 55 72 BBgdQpDYgK8iB4Ur
0520: 59 75 44 4c 42 30 47 47 6b 68 6b 74 51 42 79 6b YuDLB0GGkhktQByk
0530: 30 45 69 46 0a 09 48 6e 77 71 61 4b 7a 49 39 61 0EiF..HnwqaKzI9a
0540: 4d 47 76 6a 34 4d 48 68 68 44 6b 73 41 47 2f 73 MGvj4MHhhDksAG/s
0550: 43 4f 49 34 4e 36 49 44 45 54 31 77 38 5a 66 57 COI4N6IDET1w8ZfW
0560: 35 53 57 41 41 6a 69 59 78 2f 47 6c 67 6d 6e 65 5SWAAjiYx/Glgmne
0570: 70 68 78 45 78 54 4b 33 37 45 6b 44 42 79 0a 09 phxExTK37EkDBy..
0580: 54 34 55 46 42 35 49 49 41 4e 47 69 49 74 43 52 T4UFB5IIANGiItCR
0590: 45 68 49 55 64 59 66 41 34 70 2b 52 46 57 34 6b EhIUdYfA4p+RFW4k
05a0: 69 57 47 44 47 4c 34 2f 58 68 45 71 46 46 45 7a iWGDGL4/XhEqFFEz
05b0: 4b 45 75 38 47 73 49 69 6b 66 47 43 49 73 75 56 KEu8GsIikfGCIsuV
05c0: 65 33 44 38 57 50 62 6a 0a 09 77 73 47 6b 42 7a e3D8WPbj..wsGkBz
05d0: 57 38 53 49 67 45 51 49 51 55 41 54 75 2b 70 54 W8SIgEQIQUATu+pT
05e0: 42 6a 47 64 38 63 69 43 31 53 65 4a 46 42 63 5a BjGd8ciC1SeJFBcZ
05f0: 4a 4f 4c 79 6f 79 59 4d 6d 61 41 67 75 4e 4a 46 JOLyoyYMmaAguNJF
0600: 42 4d 36 4e 4d 48 55 4d 63 58 49 41 51 6f 30 59 BM6NMHUMcXIAQo0Y
0610: 48 37 0a 09 38 4a 37 4e 66 44 42 77 44 57 70 78 H7..8J7NfDBwDWpx
0620: 6a 77 5a 50 57 5a 30 61 57 4e 53 31 34 68 35 48 jwZPWZ0aWNS14h5H
0630: 6c 61 62 2b 76 5a 32 43 33 5a 49 44 6b 6e 38 66 lab+vZ2C3ZIDkn8f
0640: 5a 4b 43 69 41 77 6b 53 4e 46 67 6b 39 55 31 42 ZKCiAwkSNFgk9U1B
0650: 77 37 41 4c 54 47 51 38 59 47 54 32 0a 09 73 47 w7ALTGQ8YGT2..sG
0660: 35 6c 48 55 78 4d 50 31 78 74 68 78 4d 63 44 63 5lHUxMP1xthxMcDc
0670: 7a 69 72 57 42 56 6c 34 36 4f 46 68 56 6d 41 78 zirWBVl46OFhVmAx
0680: 5a 4f 66 4a 42 66 61 78 4f 45 73 4e 59 4b 4f 4e ZOfJBfaxOEsNYKON
0690: 68 57 30 51 75 79 6f 41 66 46 44 51 36 73 39 74 hW0QuyoAfFDQ6s9t
06a0: 59 47 43 57 43 31 0a 09 41 69 4f 48 54 6b 47 59 YGCWC1..AiOHTkGY
06b0: 6d 78 51 72 38 46 41 68 41 79 52 53 73 45 46 47 mxQr8FAhAyRSsEFG
06c0: 4d 63 7a 51 6b 57 51 5a 71 43 44 68 46 41 67 51 MczQkWQZqCDhFAgQ
06d0: 30 45 61 4a 77 46 58 45 69 41 63 45 6c 72 47 43 0EaJwFXEiAcElrGC
06e0: 44 67 38 34 30 45 59 44 62 4a 43 34 51 41 4d 65 Dg840EYDbJC4QAMe
06f0: 0a 09 78 46 44 47 45 52 66 6f 63 4d 41 64 42 64 ..xFDGERfocMAdBd
0700: 79 77 41 51 49 35 48 69 6e 6c 6c 46 52 57 61 65 ywAQI5HinllFRWae
0710: 57 56 57 42 34 52 42 41 41 37 0a 20 20 20 20 7d WVWB4RBAA7. }
0720: 0a 20 20 20 20 70 72 6f 63 20 47 65 74 49 6d 61 . proc GetIma
0730: 67 65 20 7b 20 66 69 6c 65 6e 61 6d 65 20 7d 20 ge { filename }
0740: 7b 20 20 20 20 20 20 20 20 0a 09 72 65 74 75 72 { ..retur
0750: 6e 20 64 69 61 6c 6f 67 77 69 6e 71 75 65 73 74 n dialogwinquest
0760: 69 6f 6e 68 65 61 64 20 20 20 20 20 20 20 20 0a ionhead .
0770: 20 20 20 20 7d 20 20 20 0a 7d 0a 0a 6e 61 6d 65 } .}..name
0780: 73 70 61 63 65 20 65 76 61 6c 20 69 6d 67 20 7b space eval img {
0790: 7d 0a 0a 69 66 20 7b 20 5b 69 6e 66 6f 20 63 6f }..if { [info co
07a0: 6d 6d 61 6e 64 20 69 6d 67 3a 3a 6f 6b 2d 31 36 mmand img::ok-16
07b0: 5d 20 65 71 20 22 22 20 7d 20 7b 0a 20 20 20 20 ] eq "" } {.
07c0: 69 6d 61 67 65 20 63 72 65 61 74 65 20 70 68 6f image create pho
07d0: 74 6f 20 69 6d 67 3a 3a 6f 6b 2d 31 36 20 2d 64 to img::ok-16 -d
07e0: 61 74 61 20 7b 0a 09 69 56 42 4f 52 77 30 4b 47 ata {..iVBORw0KG
07f0: 67 6f 41 41 41 41 4e 53 55 68 45 55 67 41 41 41 goAAAANSUhEUgAAA
0800: 42 41 41 41 41 41 51 43 41 59 41 41 41 41 66 38 BAAAAAQCAYAAAAf8
0810: 2f 39 68 41 41 41 41 42 48 4e 43 53 56 51 49 43 /9hAAAABHNCSVQIC
0820: 41 67 49 66 41 68 6b 69 41 41 41 41 42 6c 30 52 AgIfAhkiAAAABl0R
0830: 56 68 30 0a 09 55 32 39 6d 64 48 64 68 63 6d 55 Vh0..U29mdHdhcmU
0840: 41 64 33 64 33 4c 6d 6c 75 61 33 4e 6a 59 58 42 Ad3d3Lmlua3NjYXB
0850: 6c 4c 6d 39 79 5a 35 76 75 50 42 6f 41 41 41 4e lLm9yZ5vuPBoAAAN
0860: 43 53 55 52 42 56 44 69 4e 68 5a 4e 4a 62 46 74 CSURBVDiNhZNJbFt
0870: 6c 46 49 57 2f 2f 33 2f 76 32 58 35 78 59 73 64 lFIW//3/v2X5xYsd
0880: 31 0a 09 47 73 68 55 41 6a 48 55 42 5a 49 51 45 1..GshUAjHUBZIQE
0890: 43 31 46 47 63 78 51 46 61 52 6d 55 59 6b 67 68 C1FGcxQFaRmUYkgh
08a0: 42 54 45 67 67 55 62 4a 49 71 69 72 70 42 59 73 BTEggUbJIqirpBYs
08b0: 41 42 42 47 42 5a 30 42 55 4a 49 42 53 48 4b 41 ABBGBZ0BUJIBSHKA
08c0: 6b 51 71 43 69 79 71 55 4b 64 51 68 69 41 35 0a kQqCiyqUKdQhiA5.
08d0: 09 55 42 4a 41 7a 65 41 6b 70 6f 6c 4e 34 69 6e .UBJAzeAkpolN4in
08e0: 78 73 39 2f 77 73 36 70 56 56 70 7a 74 75 65 65 xs9/ws6pVVpztuee
08f0: 37 69 33 75 50 55 45 70 78 76 55 59 6e 68 2b 49 7i3uPUEpxvUYnh+I
0900: 49 4e 53 34 31 6c 56 43 65 36 41 55 51 55 76 33 INS41lVCe6AUQUv3
0910: 71 75 57 49 61 4a 55 35 50 54 53 51 58 0a 09 72 quWIaJU5PTSQX..r
0920: 70 38 58 31 77 43 6a 6b 30 4e 53 43 48 58 53 37 p8X1wCjk0NSCHXS7
0930: 2f 4f 2f 65 4f 54 67 66 59 47 62 57 32 4e 61 65 /O/eOTgfYGbW2Nae
0940: 37 67 62 69 65 52 71 63 5a 57 6c 7a 55 58 76 33 7gbieRqcZWlzUXv3
0950: 41 2f 66 57 74 56 61 39 57 57 6c 78 47 74 54 45 A/fWtVa9WWlxGtTE
0960: 30 6d 76 44 68 69 64 48 4a 4a 53 0a 09 38 79 37 0mvDhidHJJS..8y7
0970: 73 33 39 63 39 4d 44 59 34 31 75 43 77 67 36 4f s39c9MDY41uCwg6O
0980: 71 53 4b 47 6a 43 7a 2b 36 4e 44 42 6b 41 46 79 qSKGjCz+6NDBkAFy
0990: 44 6a 32 63 2b 71 76 79 2b 2f 4e 63 76 6e 69 75 Dj2c+qvy+/Ncvniu
09a0: 48 70 79 61 53 6e 67 51 51 51 70 32 38 74 57 76 HpyaSngQQQp28tWv
09b0: 66 77 42 4d 6a 6a 7a 65 73 0a 09 57 79 6d 32 71 fwBMjjzes..Wym2q
09c0: 6d 76 34 5a 4a 44 39 34 52 48 75 69 42 77 68 62 mv4ZJD94RHuiBwhb
09d0: 4e 78 49 78 53 6d 52 64 39 4b 4d 6a 7a 78 6c 78 NxIxSmRd9KMjzxlx
09e0: 72 74 69 64 77 75 68 58 67 41 51 78 31 34 66 6a rtidwuhXgAQx14fj
09f0: 50 76 39 78 73 38 6e 48 6e 73 6d 75 4c 6f 37 69 Pv9xs8nHnsmuLo7i
0a00: 79 35 39 37 41 33 63 0a 09 77 6f 48 6d 42 32 6b y597A3c..woHmB2k
0a10: 31 65 77 43 77 33 44 4b 4c 78 52 2f 4a 57 6c 65 1ewCw3DKLxR/JWle
0a20: 77 6e 44 49 74 52 6f 78 58 50 33 31 72 78 36 72 wnDItRoxXP31rx6r
0a30: 61 41 78 4b 68 78 6f 63 48 2b 67 4d 46 5a 34 32 aAxKhxocH+gMFZ42
0a40: 53 6e 55 4d 58 66 6a 52 68 55 4c 5a 7a 75 4a 34 SnUMXfjRhULZzuJ4
0a50: 4e 51 45 42 72 0a 09 70 4b 75 78 44 30 4d 47 32 NQEBr..pKuxD0MG2
0a60: 48 55 4c 6c 4f 77 4e 45 76 30 48 41 77 6a 31 74 HULlOwNEv0HAwj1t
0a70: 43 34 31 6c 65 69 49 74 6d 6e 5a 79 69 49 52 58 C41leiItmnZyiIRX
0a80: 7a 74 33 37 6a 6c 4b 79 47 6a 46 6b 43 59 31 7a zt37jlKyGjFkCY1z
0a90: 38 4b 55 42 67 42 4e 52 67 73 48 6d 68 38 69 5a 8KUBgBNRgsHmh8iZ
0aa0: 36 58 35 0a 09 78 30 72 54 32 64 4b 68 53 55 30 6X5..x0rT2dKhSU0
0ab0: 6c 70 50 4a 45 37 77 33 68 44 76 4b 31 44 49 6d lpPJE7w3hDvK1DIm
0ac0: 32 5a 34 6d 46 44 74 4e 71 39 68 44 78 74 32 50 2Z4mFDtNq9hDxt2P
0ad0: 71 54 66 38 35 63 63 54 66 7a 6a 33 52 34 78 54 qTf85ccTfzj3R4xT
0ae0: 73 44 56 70 44 62 53 68 50 39 4d 70 72 70 71 4e sDVpDbShP9MprpqN
0af0: 73 0a 09 50 46 7a 2b 54 34 35 72 55 33 4d 71 75 s..PFz+T45rU3Mqu
0b00: 4a 34 44 67 42 5a 2f 74 4f 74 59 54 32 64 37 6c J4DgBZ/tOtYT2d7l
0b10: 79 50 7a 2f 46 6d 34 69 43 35 38 57 47 36 4a 6b yPz/Fm4iC58WG6Jk
0b20: 70 33 46 39 57 71 59 65 72 67 65 7a 70 51 58 4f p3F9WqYergezpQXO
0b30: 4a 64 2b 41 30 4d 30 59 46 73 47 63 38 76 7a 0a Jd+A0M0YFsGc8vz.
0b40: 09 73 39 4a 7a 78 66 52 36 4e 75 4e 47 2f 64 31 .s9JzxfR6NuNG/d1
0b50: 63 72 53 78 77 50 6e 4f 4b 72 39 66 65 5a 44 62 crSxwPnOKr9feZDb
0b60: 33 47 61 59 65 71 6f 64 58 53 69 6d 6d 6c 6c 38 3GaYeqodXSimmll8
0b70: 68 62 2f 31 4e 4e 4e 44 4a 79 6d 62 61 39 56 77 hb/1NNNDJymba9Vw
0b80: 78 4c 56 48 69 64 44 49 31 5a 2b 30 31 0a 09 62 xLVHidDI1Z+01..b
0b90: 69 4d 6f 6f 35 54 74 4c 53 79 33 53 45 2f 6f 55 iMoo5TtLSy3SE/oU
0ba0: 48 31 37 75 6a 68 48 63 76 31 39 69 74 55 63 70 H17ujhHcv19itUcp
0bb0: 74 5a 4d 6b 39 62 42 39 35 66 6e 4c 4a 54 34 51 tZMk9bB95fnLJT4Q
0bc0: 50 76 6a 6d 35 58 63 68 7a 50 76 65 72 6c 53 39 Pvjm5XchzPverlS9
0bd0: 76 36 48 34 38 65 4e 37 4f 34 53 0a 09 41 67 33 v6H48eN7O4S..Ag3
0be0: 4c 4c 6d 45 49 6b 39 31 61 67 63 74 62 35 37 48 LLmEIk91agctb57H
0bf0: 73 48 55 77 74 52 44 7a 79 41 4a 39 2f 39 32 55 sHUwtRDzyAJ9/92U
0c00: 6c 56 38 69 2f 4e 44 55 78 63 37 62 2b 79 6b 4a lV8i/NDUxc7b+ykJ
0c10: 36 79 56 68 48 35 31 32 6a 68 78 39 70 63 46 51 6yVhH512jhx9pcFQ
0c20: 46 46 44 52 6f 65 77 6a 71 0a 09 45 56 78 6c 34 FFDRoewjq..EVxl4
0c30: 32 4c 6a 4f 6f 6f 7a 46 7a 2b 70 58 4d 6d 73 70 2LjOoozFz+pXMmsp
0c40: 69 36 39 74 35 44 59 6e 4e 2b 71 43 71 55 55 51 i69t5DYnN+qCqUUQ
0c50: 6f 69 67 72 39 46 6f 48 48 36 2b 2f 30 53 6f 70 oigr9FoHH6+/0Sop
0c60: 66 47 35 6f 2f 63 4f 42 75 4a 74 66 66 4b 6d 35 fG5o/cOBuJtffKm5
0c70: 74 73 4a 36 73 30 73 0a 09 62 66 2f 47 66 43 62 tsJ6s0s..bf/GfCb
0c80: 6c 66 58 48 70 71 39 72 32 52 75 48 55 68 62 64 lfXHpq9r2RuHUhbd
0c90: 54 37 7a 69 57 75 77 4d 55 36 32 30 55 51 76 69 T7ziWuwMU620UQvi
0ca0: 42 59 4e 39 59 72 44 2f 61 45 33 34 79 45 4e 49 BYN9YrD/aE34yENI
0cb0: 4f 61 59 59 65 51 34 46 72 4f 34 75 56 76 50 33 OaYYeQ4FrO4uVvP3
0cc0: 54 78 76 7a 32 0a 09 6d 66 6d 7a 79 79 6d 67 44 Txvz2..mfmzyymgD
0cd0: 4a 53 56 55 74 36 2f 79 4a 39 33 51 32 72 77 45 JSVUt6/yJ93Q2rwE
0ce0: 55 30 41 41 41 41 41 53 55 56 4f 52 4b 35 43 59 U0AAAAASUVORK5CY
0cf0: 49 49 3d 0a 20 20 20 20 7d 0a 7d 0a 0a 69 66 20 II=. }.}..if
0d00: 7b 20 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 20 { [info command
0d10: 69 6d 67 3a 3a 6f 6b 2d 63 6c 6f 73 65 2d 31 36 img::ok-close-16
0d20: 5d 20 65 71 20 22 22 20 7d 20 7b 0a 20 20 20 20 ] eq "" } {.
0d30: 69 6d 61 67 65 20 63 72 65 61 74 65 20 70 68 6f image create pho
0d40: 74 6f 20 69 6d 67 3a 3a 6f 6b 2d 63 6c 6f 73 65 to img::ok-close
0d50: 2d 31 36 20 2d 64 61 74 61 20 7b 0a 09 69 56 42 -16 -data {..iVB
0d60: 4f 52 77 30 4b 47 67 6f 41 41 41 41 4e 53 55 68 ORw0KGgoAAAANSUh
0d70: 45 55 67 41 41 41 42 41 41 41 41 41 51 43 41 59 EUgAAABAAAAAQCAY
0d80: 41 41 41 41 66 38 2f 39 68 41 41 41 41 42 6d 4a AAAAf8/9hAAAABmJ
0d90: 4c 52 30 51 41 2f 77 44 2f 41 50 2b 67 76 61 65 LR0QA/wD/AP+gvae
0da0: 54 41 41 41 41 43 58 42 49 0a 09 57 58 4d 41 41 TAAAACXBI..WXMAA
0db0: 41 42 49 41 41 41 41 53 41 42 47 79 57 73 2b 41 ABIAAAASABGyWs+A
0dc0: 41 41 41 43 58 5a 77 51 57 63 41 41 41 41 51 41 AAACXZwQWcAAAAQA
0dd0: 41 41 41 45 41 42 63 78 71 33 44 41 41 41 43 37 AAAEABcxq3DAAAC7
0de0: 55 6c 45 51 56 51 34 79 33 32 54 53 32 69 63 56 UlEQVQ4y32TS2icV
0df0: 52 69 47 6e 33 50 4f 0a 09 2f 38 2b 31 6b 38 78 RiGn3PO../8+1k8x
0e00: 4d 51 6f 4b 61 49 68 71 68 68 70 70 59 4c 77 48 MQoKaIhqhhppYLwH
0e10: 52 75 74 42 4a 71 5a 70 30 49 5a 47 69 72 59 67 RutBJqZp0IZGirYg
0e20: 45 72 41 75 31 41 62 46 57 38 4c 49 51 62 48 51 ErAu1AbFW8LIQbHQ
0e30: 68 4b 43 69 43 59 49 56 53 76 49 43 4c 4c 42 51 hKCiCYIVSvICLLBQ
0e40: 53 68 47 35 55 0a 09 55 4e 73 53 73 5a 54 59 74 ShG5U..UNsSsZTYt
0e50: 43 56 54 54 42 68 4e 79 57 52 6d 2f 70 6e 2f 2f CVTTBhNyWRm/pn//
0e60: 70 2f 6a 52 69 75 57 31 41 38 2b 50 6e 68 35 65 p/jRiuW1A8+Pnh5e
0e70: 56 62 66 49 37 6a 47 76 48 2f 30 6c 56 36 52 61 VbfI7jGvH/0lV6Ra
0e80: 64 39 69 4d 4d 4b 4b 75 79 38 2b 39 39 53 52 74 d9iMMKKuy8+99SRt
0e90: 63 31 36 0a 09 34 75 70 67 2f 73 7a 4d 51 36 71 c16..4upg/szMQ6q
0ea0: 72 39 71 71 79 76 58 75 7a 64 6c 5a 4b 6f 51 6a r9qqyvXuzdlZKoQj
0eb0: 6a 78 4a 67 6f 64 7a 4c 71 6c 47 63 65 76 50 58 jxJgodzLqlGcevPX
0ec0: 6c 32 55 30 42 42 31 35 38 56 44 77 38 64 66 31 l2U0BB158VDw8df1
0ed0: 37 32 64 4c 47 43 34 56 55 53 61 54 6c 46 69 79 72dLGC4VUSaTlFiy
0ee0: 5a 0a 09 52 57 4a 68 4d 47 67 54 34 73 64 74 30 Z..RWJhMGgT4sdt0
0ef0: 39 69 51 6e 33 34 33 65 2f 6e 41 6b 63 50 48 45 9iQn343e/nAkcPHE
0f00: 67 44 72 48 38 44 6f 5a 4f 5a 4e 56 61 77 64 7a gDrH8DoZOZNVawdz
0f10: 4e 69 39 70 4f 51 57 55 72 4b 41 75 67 71 41 4a Ni9pOQWUrKAugqAJ
0f20: 55 57 78 33 4a 77 61 72 74 68 74 59 42 70 41 0a UWx3JwarthtYBpA.
0f30: 09 41 54 78 2b 61 47 54 37 74 70 30 63 4c 36 53 .ATx+aGT7tp0cL6S
0f40: 37 5a 4d 34 71 6b 4a 59 46 55 69 71 48 4c 54 49 7ZM4qkJYFUiqHLTI
0f50: 6f 6d 55 4b 69 41 45 46 74 74 55 36 55 52 47 52 omUKiAEFttU6URGR
0f60: 4c 77 57 6a 35 78 74 7a 38 54 33 4f 2f 72 30 71 LwWj5xtz8T3O/r0q
0f70: 41 2f 68 33 68 38 38 72 47 45 67 49 6b 0a 09 41 A/h3h88rGEgIk..A
0f80: 69 57 34 73 70 59 77 4b 47 46 59 58 71 71 78 72 iW4spYwKGFYXqqxr
0f90: 2f 49 52 38 31 2b 64 78 62 49 73 32 54 2f 49 51 /IR81+dxbIs2T/IQ
0fa0: 51 41 4a 59 42 64 31 4a 53 48 42 6d 42 68 45 69 QAJYBd1JSHBmBhEi
0fb0: 42 41 42 6b 67 44 31 39 31 30 2b 66 34 6d 6e 39 BABkgD1910+f4mn9
0fc0: 33 78 49 5a 57 4b 49 79 61 6b 52 0a 09 74 49 6e 3xIZWKIyakR..tIn
0fd0: 6f 36 72 45 71 57 32 2f 4c 43 4b 76 37 4f 71 56 o6rEqW2/LCKv7OqV
0fe0: 6b 56 7a 49 51 4a 54 36 78 38 59 69 31 69 39 59 kVzIQJT6x8Yi1i9Y
0ff0: 32 53 42 41 69 5a 6e 6d 70 7a 72 37 78 6f 34 7a 2SBAiZnmpzr7xo4z
1000: 74 47 65 4c 51 32 2f 66 6a 61 6f 64 49 75 36 52 tGeLQ2/fjaodIu6R
1010: 4b 53 5a 2f 76 4a 6d 6b 5a 0a 09 65 74 6f 30 6e KSZ/vJmkZ..eto0n
1020: 43 42 30 77 6f 43 57 32 2b 47 5a 33 56 2f 7a 38 CB0woCW2+GZ3V/z8
1030: 77 38 58 69 58 53 62 63 37 39 56 32 66 76 49 4a w8XiXSbc79V2fvIJ
1040: 34 78 4e 62 4f 50 77 4f 2f 63 52 6d 67 35 65 33 4xNbOPwO/cRmg5e3
1050: 4b 45 54 75 54 52 64 4e 77 35 63 72 61 58 58 4d KETuTRdNw5craXXM
1060: 48 70 6c 30 56 32 73 0a 09 2b 79 34 64 34 33 50 Hpl0V2s..+y4d43P
1070: 6e 57 44 2f 54 54 33 7a 4c 46 38 63 57 32 44 2f nWD/TT3zLF8cW2D/
1080: 2b 4a 51 2b 4d 44 2f 4c 53 7a 4e 31 34 53 59 74 +JQ+MD/LSzN14SYt
1090: 32 31 4d 4b 4a 48 4a 71 68 77 34 57 7a 6a 61 58 21MKJHJqhw4WzjaX
10a0: 49 31 35 45 43 73 48 4b 6d 33 48 2b 58 76 63 74 I15ECsHKm3H+Xvct
10b0: 53 4d 48 78 50 0a 09 6b 62 54 4b 38 73 46 72 76 SMHxP..kbTK8sFrv
10c0: 37 44 72 73 5a 75 5a 66 6d 73 59 33 37 69 30 59 7DrsZuZfmsY37i0Y
10d0: 78 63 6e 61 74 4d 49 48 4f 70 65 6b 78 4f 66 72 xcnatMIHOpekxOfr
10e0: 33 35 63 2f 54 45 34 49 51 44 73 50 4d 58 64 37 35c/TE4IQDsPMXd7
10f0: 33 62 2f 4f 72 69 39 73 4c 57 76 6b 4b 65 63 7a 3b/Ori9sLWvkKecz
1100: 72 4f 32 0a 09 71 42 6e 61 55 55 49 70 51 57 49 rO2..qBnaUUIpQWI
1110: 4d 51 52 4c 6a 68 6a 36 4e 77 4f 58 43 2b 59 32 MQRLjhj6NwOXC+Y2
1120: 31 34 38 2f 57 52 72 79 36 2b 56 4d 42 36 41 68 148/WRry6+VMB6Ah
1130: 2f 62 54 46 61 36 4c 6d 44 53 57 48 48 36 64 68 /bTFa6LmDSWHH6dh
1140: 45 35 48 73 4e 58 75 4c 52 69 56 79 63 73 45 50 E5HsNXuLRiVycsEP
1150: 54 0a 09 64 31 6a 33 48 46 5a 71 44 57 2f 32 39 T..d1j3HFZqDW/29
1160: 63 74 50 4e 69 2f 70 68 53 75 50 42 4f 42 76 6d ctPNi/phSuPBOBvm
1170: 4f 72 4b 79 66 44 37 39 49 44 65 4b 66 4a 78 6a OrKyfD79IDeKfJxj
1180: 35 38 45 64 43 49 50 4a 33 42 70 65 69 37 72 62 58EdCIPJ3Bpei7rb
1190: 5a 65 6c 4d 36 33 71 4e 32 38 30 39 36 2b 66 0a ZelM63qN28096+f.
11a0: 09 30 33 50 58 6c 41 6c 4a 6f 65 39 32 75 66 65 .03PXlAlJoe92ufe
11b0: 47 55 54 56 52 48 46 41 33 53 59 46 6f 31 58 52 GUTVRHFA3SYFo1XR
11c0: 31 35 56 51 38 39 38 64 70 2f 5a 6c 4a 61 50 36 15VQ898dp/ZlJaP6
11d0: 76 6a 66 39 42 2f 65 74 4b 44 4f 6a 4e 53 6e 38 vjf9B/etKDOjNSn8
11e0: 42 62 62 52 68 73 4c 64 69 54 52 38 41 0a 09 41 BbbRhsLdiTR8A..A
11f0: 41 41 6c 64 45 56 59 64 47 52 68 64 47 55 36 59 AAldEVYdGRhdGU6Y
1200: 33 4a 6c 59 58 52 6c 41 44 49 77 4d 54 41 74 4d 3JlYXRlADIwMTAtM
1210: 44 49 74 4d 54 46 55 4d 44 45 36 4d 44 55 36 4d DItMTFUMDE6MDU6M
1220: 44 55 74 4d 44 59 36 4d 44 43 39 74 6f 4a 4c 41 DUtMDY6MDC9toJLA
1230: 41 41 41 4a 58 52 46 57 48 52 6b 0a 09 59 58 52 AAAJXRFWHRk..YXR
1240: 6c 4f 6d 31 76 5a 47 6c 6d 65 51 41 79 4d 44 41 lOm1vZGlmeQAyMDA
1250: 34 4c 54 41 32 4c 54 45 7a 56 44 41 77 4f 6a 49 4LTA2LTEzVDAwOjI
1260: 32 4f 6a 49 30 4c 54 41 31 4f 6a 41 77 47 44 6d 2OjI0LTA1OjAwGDm
1270: 6d 77 67 41 41 41 41 42 4a 52 55 35 45 72 6b 4a mwgAAAABJRU5ErkJ
1280: 67 67 67 3d 3d 0a 20 20 20 20 7d 0a 7d 0a 0a 69 ggg==. }.}..i
1290: 66 20 7b 20 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e f { [info comman
12a0: 64 20 69 6d 67 3a 3a 66 69 6c 65 63 6c 6f 73 65 d img::fileclose
12b0: 31 36 5d 20 65 71 20 22 22 20 7d 20 7b 0a 20 20 16] eq "" } {.
12c0: 20 20 69 6d 61 67 65 20 63 72 65 61 74 65 20 70 image create p
12d0: 68 6f 74 6f 20 69 6d 67 3a 3a 66 69 6c 65 63 6c hoto img::filecl
12e0: 6f 73 65 31 36 20 2d 64 61 74 61 20 7b 0a 09 52 ose16 -data {..R
12f0: 30 6c 47 4f 44 6c 68 45 41 41 51 41 49 51 41 41 0lGODlhEAAQAIQAA
1300: 50 77 43 42 43 51 69 4a 42 77 61 48 41 51 43 42 PwCBCQiJBwaHAQCB
1310: 44 51 79 4e 44 77 36 50 46 78 61 58 46 52 53 56 DQyNDw6PFxaXFRSV
1320: 45 52 47 52 43 77 71 4c 41 77 4f 44 47 52 69 5a ERGRCwqLAwODGRiZ
1330: 48 78 36 66 50 7a 2b 2f 47 78 71 0a 09 62 41 77 Hx6fPz+/Gxq..bAw
1340: 4b 44 43 51 6d 4a 41 41 41 41 41 41 41 41 41 41 KDCQmJAAAAAAAAAA
1350: 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 AAAAAAAAAAAAAAAA
1360: 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 AAAAAAAAAAAAAAAA
1370: 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 41 AAAAAAAAAAAAAAAA
1380: 41 41 43 48 35 42 41 45 41 0a 09 41 41 41 41 4c AACH5BAEA..AAAAL
1390: 41 41 41 41 41 41 51 41 42 41 41 41 41 56 61 49 AAAAAAQABAAAAVaI
13a0: 43 43 4f 5a 47 6d 65 71 42 67 45 77 6a 43 6b 52 CCOZGmeqBgEwjCkR
13b0: 47 45 63 53 4b 4b 34 4a 72 45 63 42 72 4d 67 41 GEcSKK4JrEcBrMgA
13c0: 64 65 4c 56 44 67 30 47 67 75 47 73 59 45 62 42 deLVDg0GguGsYEbB
13d0: 51 79 47 59 79 4e 36 0a 09 46 44 6f 50 44 49 66 QyGYyN6..FDoPDIf
13e0: 30 2b 4c 43 4b 42 49 67 65 74 51 45 52 44 67 47 0+LCKBIgetQERDgG
13f0: 44 42 47 49 70 4e 59 38 47 69 6f 41 55 30 6d 36 DBGIpNY8GioAU0m6
1400: 4b 58 46 77 38 38 33 77 33 2b 2f 6c 39 66 34 41 KXFw883w3+/l9f4A
1410: 6b 66 69 6d 47 49 6e 34 68 41 43 48 2b 61 45 4e kfimGIn4hACH+aEN
1420: 79 5a 57 46 30 0a 09 5a 57 51 67 59 6e 6b 67 51 yZWF0..ZWQgYnkgQ
1430: 6b 31 51 56 47 39 48 53 55 59 67 55 48 4a 76 49 k1QVG9HSUYgUHJvI
1440: 48 5a 6c 63 6e 4e 70 62 32 34 67 4d 69 34 31 44 HZlcnNpb24gMi41D
1450: 51 71 70 49 45 52 6c 64 6d 56 73 51 32 39 79 49 QqpIERldmVsQ29yI
1460: 44 45 35 4f 54 63 73 4d 54 6b 35 4f 43 34 67 51 DE5OTcsMTk5OC4gQ
1470: 57 78 73 0a 09 49 48 4a 70 5a 32 68 30 63 79 42 Wxs..IHJpZ2h0cyB
1480: 79 5a 58 4e 6c 63 6e 5a 6c 5a 43 34 4e 43 6d 68 yZXNlcnZlZC4NCmh
1490: 30 64 48 41 36 4c 79 39 33 64 33 63 75 5a 47 56 0dHA6Ly93d3cuZGV
14a0: 32 5a 57 78 6a 62 33 49 75 59 32 39 74 41 44 73 2ZWxjb3IuY29tADs
14b0: 3d 0a 20 20 20 20 7d 0a 7d 0a 0a 69 66 20 7b 20 =. }.}..if {
14c0: 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 20 69 6d [info command im
14d0: 67 3a 3a 6e 61 76 31 64 6f 77 6e 61 72 72 6f 77 g::nav1downarrow
14e0: 31 36 5d 20 65 71 20 22 22 20 7d 20 7b 0a 20 20 16] eq "" } {.
14f0: 20 20 69 6d 61 67 65 20 63 72 65 61 74 65 20 70 image create p
1500: 68 6f 74 6f 20 69 6d 67 3a 3a 6e 61 76 31 64 6f hoto img::nav1do
1510: 77 6e 61 72 72 6f 77 31 36 20 2d 64 61 74 61 20 wnarrow16 -data
1520: 7b 0a 09 52 30 6c 47 4f 44 6c 68 45 41 41 51 41 {..R0lGODlhEAAQA
1530: 49 41 41 41 50 77 43 42 41 51 43 42 43 48 35 42 IAAAPwCBAQCBCH5B
1540: 41 45 41 41 41 41 41 4c 41 41 41 41 41 41 51 41 AEAAAAALAAAAAAQA
1550: 42 41 41 41 41 49 59 68 49 2b 70 79 2b 30 50 55 BAAAAIYhI+py+0PU
1560: 5a 69 30 7a 6d 54 74 79 70 66 6c 56 30 56 64 0a Zi0zmTtypflV0Vd.
1570: 09 52 4a 62 6d 36 66 67 46 41 43 48 2b 61 45 4e .RJbm6fgFACH+aEN
1580: 79 5a 57 46 30 5a 57 51 67 59 6e 6b 67 51 6b 31 yZWF0ZWQgYnkgQk1
1590: 51 56 47 39 48 53 55 59 67 55 48 4a 76 49 48 5a QVG9HSUYgUHJvIHZ
15a0: 6c 63 6e 4e 70 62 32 34 67 4d 69 34 31 44 51 71 lcnNpb24gMi41DQq
15b0: 70 49 45 52 6c 64 6d 56 73 51 32 39 79 0a 09 49 pIERldmVsQ29y..I
15c0: 44 45 35 4f 54 63 73 4d 54 6b 35 4f 43 34 67 51 DE5OTcsMTk5OC4gQ
15d0: 57 78 73 49 48 4a 70 5a 32 68 30 63 79 42 79 5a WxsIHJpZ2h0cyByZ
15e0: 58 4e 6c 63 6e 5a 6c 5a 43 34 4e 43 6d 68 30 64 XNlcnZlZC4NCmh0d
15f0: 48 41 36 4c 79 39 33 64 33 63 75 5a 47 56 32 5a HA6Ly93d3cuZGV2Z
1600: 57 78 6a 62 33 49 75 59 32 39 74 0a 09 41 44 73 Wxjb3IuY29t..ADs
1610: 3d 0a 20 20 20 20 7d 0a 7d 0a 0a 0a 69 66 20 7b =. }.}...if {
1620: 20 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 [info commands
1630: 74 6b 54 61 62 54 6f 57 69 6e 64 6f 77 5d 20 3d tkTabToWindow] =
1640: 3d 20 22 22 20 7d 20 7b 0a 20 20 20 20 69 6e 74 = "" } {. int
1650: 65 72 70 20 61 6c 69 61 73 20 22 22 20 74 6b 54 erp alias "" tkT
1660: 61 62 54 6f 57 69 6e 64 6f 77 20 22 22 20 74 6b abToWindow "" tk
1670: 3a 3a 54 61 62 54 6f 57 69 6e 64 6f 77 0a 20 20 ::TabToWindow.
1680: 20 20 23 3a 3a 74 6b 3a 3a 75 6e 73 75 70 70 6f #::tk::unsuppo
1690: 72 74 65 64 3a 3a 45 78 70 6f 73 65 50 72 69 76 rted::ExposePriv
16a0: 61 74 65 43 6f 6d 6d 61 6e 64 20 74 6b 54 61 62 ateCommand tkTab
16b0: 54 6f 57 69 6e 64 6f 77 0a 7d 0a 69 66 20 7b 20 ToWindow.}.if {
16c0: 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 74 [info commands t
16d0: 6b 42 75 74 74 6f 6e 49 6e 76 6f 6b 65 5d 20 3d kButtonInvoke] =
16e0: 3d 20 22 22 20 7d 20 7b 0a 20 20 20 20 69 6e 74 = "" } {. int
16f0: 65 72 70 20 61 6c 69 61 73 20 22 22 20 74 6b 42 erp alias "" tkB
1700: 75 74 74 6f 6e 49 6e 76 6f 6b 65 20 22 22 20 74 uttonInvoke "" t
1710: 6b 3a 3a 42 75 74 74 6f 6e 49 6e 76 6f 6b 65 0a k::ButtonInvoke.
1720: 20 20 20 20 23 3a 3a 74 6b 3a 3a 75 6e 73 75 70 #::tk::unsup
1730: 70 6f 72 74 65 64 3a 3a 45 78 70 6f 73 65 50 72 ported::ExposePr
1740: 69 76 61 74 65 43 6f 6d 6d 61 6e 64 20 74 6b 42 ivateCommand tkB
1750: 75 74 74 6f 6e 49 6e 76 6f 6b 65 0a 7d 0a 0a 70 uttonInvoke.}..p
1760: 61 63 6b 61 67 65 20 70 72 6f 76 69 64 65 20 64 ackage provide d
1770: 69 61 6c 6f 67 77 69 6e 52 20 31 2e 33 32 0a 70 ialogwinR 1.32.p
1780: 61 63 6b 61 67 65 20 70 72 6f 76 69 64 65 20 64 ackage provide d
1790: 69 61 6c 6f 67 77 69 6e 20 31 2e 33 32 0a 0a 23 ialogwin 1.32..#
17a0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
17b0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
17c0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
17d0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
17e0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 0a ###############.
17f0: 23 20 20 54 68 69 73 20 73 6f 66 74 77 61 72 65 # This software
1800: 20 69 73 20 63 6f 70 79 72 69 67 68 74 65 64 20 is copyrighted
1810: 62 79 20 52 61 6d 6f 6e 20 52 69 62 c3 b3 20 28 by Ramon Rib.. (
1820: 52 41 4d 53 41 4e 29 20 72 61 6d 73 61 6e 40 63 RAMSAN) ramsan@c
1830: 69 6d 6e 65 2e 75 70 63 2e 65 73 2e 0a 23 20 20 imne.upc.es..#
1840: 28 68 74 74 70 3a 2f 2f 67 69 64 2e 63 69 6d 6e (http://gid.cimn
1850: 65 2e 75 70 63 2e 65 73 2f 72 61 6d 73 61 6e 29 e.upc.es/ramsan)
1860: 20 54 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 74 The following t
1870: 65 72 6d 73 20 61 70 70 6c 79 20 74 6f 20 61 6c erms apply to al
1880: 6c 20 66 69 6c 65 73 0a 23 20 20 61 73 73 6f 63 l files.# assoc
1890: 69 61 74 65 64 20 77 69 74 68 20 74 68 65 20 73 iated with the s
18a0: 6f 66 74 77 61 72 65 20 75 6e 6c 65 73 73 20 65 oftware unless e
18b0: 78 70 6c 69 63 69 74 6c 79 20 64 69 73 63 6c 61 xplicitly discla
18c0: 69 6d 65 64 20 69 6e 20 69 6e 64 69 76 69 64 75 imed in individu
18d0: 61 6c 20 66 69 6c 65 73 2e 0a 0a 23 20 20 54 68 al files...# Th
18e0: 65 20 61 75 74 68 6f 72 73 20 68 65 72 65 62 79 e authors hereby
18f0: 20 67 72 61 6e 74 20 70 65 72 6d 69 73 73 69 6f grant permissio
1900: 6e 20 74 6f 20 75 73 65 2c 20 63 6f 70 79 2c 20 n to use, copy,
1910: 6d 6f 64 69 66 79 2c 20 64 69 73 74 72 69 62 75 modify, distribu
1920: 74 65 2c 0a 23 20 20 61 6e 64 20 6c 69 63 65 6e te,.# and licen
1930: 73 65 20 74 68 69 73 20 73 6f 66 74 77 61 72 65 se this software
1940: 20 61 6e 64 20 69 74 73 20 64 6f 63 75 6d 65 6e and its documen
1950: 74 61 74 69 6f 6e 20 66 6f 72 20 61 6e 79 20 70 tation for any p
1960: 75 72 70 6f 73 65 2c 20 70 72 6f 76 69 64 65 64 urpose, provided
1970: 0a 23 20 20 74 68 61 74 20 65 78 69 73 74 69 6e .# that existin
1980: 67 20 63 6f 70 79 72 69 67 68 74 20 6e 6f 74 69 g copyright noti
1990: 63 65 73 20 61 72 65 20 72 65 74 61 69 6e 65 64 ces are retained
19a0: 20 69 6e 20 61 6c 6c 20 63 6f 70 69 65 73 20 61 in all copies a
19b0: 6e 64 20 74 68 61 74 20 74 68 69 73 0a 23 20 20 nd that this.#
19c0: 6e 6f 74 69 63 65 20 69 73 20 69 6e 63 6c 75 64 notice is includ
19d0: 65 64 20 76 65 72 62 61 74 69 6d 20 69 6e 20 61 ed verbatim in a
19e0: 6e 79 20 64 69 73 74 72 69 62 75 74 69 6f 6e 73 ny distributions
19f0: 2e 20 4e 6f 20 77 72 69 74 74 65 6e 20 61 67 72 . No written agr
1a00: 65 65 6d 65 6e 74 2c 0a 23 20 20 6c 69 63 65 6e eement,.# licen
1a10: 73 65 2c 20 6f 72 20 72 6f 79 61 6c 74 79 20 66 se, or royalty f
1a20: 65 65 20 69 73 20 72 65 71 75 69 72 65 64 20 66 ee is required f
1a30: 6f 72 20 61 6e 79 20 6f 66 20 74 68 65 20 61 75 or any of the au
1a40: 74 68 6f 72 69 7a 65 64 20 75 73 65 73 2e 0a 23 thorized uses..#
1a50: 20 20 4d 6f 64 69 66 69 63 61 74 69 6f 6e 73 20 Modifications
1a60: 74 6f 20 74 68 69 73 20 73 6f 66 74 77 61 72 65 to this software
1a70: 20 6d 61 79 20 62 65 20 63 6f 70 79 72 69 67 68 may be copyrigh
1a80: 74 65 64 20 62 79 20 74 68 65 69 72 20 61 75 74 ted by their aut
1a90: 68 6f 72 73 0a 23 20 20 61 6e 64 20 6e 65 65 64 hors.# and need
1aa0: 20 6e 6f 74 20 66 6f 6c 6c 6f 77 20 74 68 65 20 not follow the
1ab0: 6c 69 63 65 6e 73 69 6e 67 20 74 65 72 6d 73 20 licensing terms
1ac0: 64 65 73 63 72 69 62 65 64 20 68 65 72 65 2c 20 described here,
1ad0: 70 72 6f 76 69 64 65 64 20 74 68 61 74 0a 23 20 provided that.#
1ae0: 20 74 68 65 20 6e 65 77 20 74 65 72 6d 73 20 61 the new terms a
1af0: 72 65 20 63 6c 65 61 72 6c 79 20 69 6e 64 69 63 re clearly indic
1b00: 61 74 65 64 20 6f 6e 20 74 68 65 20 66 69 72 73 ated on the firs
1b10: 74 20 70 61 67 65 20 6f 66 20 65 61 63 68 20 66 t page of each f
1b20: 69 6c 65 20 77 68 65 72 65 0a 23 20 20 74 68 65 ile where.# the
1b30: 79 20 61 70 70 6c 79 2e 0a 0a 23 20 20 49 4e 20 y apply...# IN
1b40: 4e 4f 20 45 56 45 4e 54 20 53 48 41 4c 4c 20 54 NO EVENT SHALL T
1b50: 48 45 20 41 55 54 48 4f 52 53 20 4f 52 20 44 49 HE AUTHORS OR DI
1b60: 53 54 52 49 42 55 54 4f 52 53 20 42 45 20 4c 49 STRIBUTORS BE LI
1b70: 41 42 4c 45 20 54 4f 20 41 4e 59 20 50 41 52 54 ABLE TO ANY PART
1b80: 59 0a 23 20 20 46 4f 52 20 44 49 52 45 43 54 2c Y.# FOR DIRECT,
1b90: 20 49 4e 44 49 52 45 43 54 2c 20 53 50 45 43 49 INDIRECT, SPECI
1ba0: 41 4c 2c 20 49 4e 43 49 44 45 4e 54 41 4c 2c 20 AL, INCIDENTAL,
1bb0: 4f 52 20 43 4f 4e 53 45 51 55 45 4e 54 49 41 4c OR CONSEQUENTIAL
1bc0: 20 44 41 4d 41 47 45 53 0a 23 20 20 41 52 49 53 DAMAGES.# ARIS
1bd0: 49 4e 47 20 4f 55 54 20 4f 46 20 54 48 45 20 55 ING OUT OF THE U
1be0: 53 45 20 4f 46 20 54 48 49 53 20 53 4f 46 54 57 SE OF THIS SOFTW
1bf0: 41 52 45 2c 20 49 54 53 20 44 4f 43 55 4d 45 4e ARE, ITS DOCUMEN
1c00: 54 41 54 49 4f 4e 2c 20 4f 52 20 41 4e 59 0a 23 TATION, OR ANY.#
1c10: 20 20 44 45 52 49 56 41 54 49 56 45 53 20 54 48 DERIVATIVES TH
1c20: 45 52 45 4f 46 2c 20 45 56 45 4e 20 49 46 20 54 EREOF, EVEN IF T
1c30: 48 45 20 41 55 54 48 4f 52 53 20 48 41 56 45 20 HE AUTHORS HAVE
1c40: 42 45 45 4e 20 41 44 56 49 53 45 44 20 4f 46 20 BEEN ADVISED OF
1c50: 54 48 45 0a 23 20 20 50 4f 53 53 49 42 49 4c 49 THE.# POSSIBILI
1c60: 54 59 20 4f 46 20 53 55 43 48 20 44 41 4d 41 47 TY OF SUCH DAMAG
1c70: 45 2e 0a 0a 23 20 20 54 48 45 20 41 55 54 48 4f E...# THE AUTHO
1c80: 52 53 20 41 4e 44 20 44 49 53 54 52 49 42 55 54 RS AND DISTRIBUT
1c90: 4f 52 53 20 53 50 45 43 49 46 49 43 41 4c 4c 59 ORS SPECIFICALLY
1ca0: 20 44 49 53 43 4c 41 49 4d 20 41 4e 59 20 57 41 DISCLAIM ANY WA
1cb0: 52 52 41 4e 54 49 45 53 2c 0a 23 20 20 49 4e 43 RRANTIES,.# INC
1cc0: 4c 55 44 49 4e 47 2c 20 42 55 54 20 4e 4f 54 20 LUDING, BUT NOT
1cd0: 4c 49 4d 49 54 45 44 20 54 4f 2c 20 54 48 45 20 LIMITED TO, THE
1ce0: 49 4d 50 4c 49 45 44 20 57 41 52 52 41 4e 54 49 IMPLIED WARRANTI
1cf0: 45 53 20 4f 46 20 4d 45 52 43 48 41 4e 54 41 42 ES OF MERCHANTAB
1d00: 49 4c 49 54 59 2c 0a 23 20 20 46 49 54 4e 45 53 ILITY,.# FITNES
1d10: 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 4c S FOR A PARTICUL
1d20: 41 52 20 50 55 52 50 4f 53 45 2c 20 41 4e 44 20 AR PURPOSE, AND
1d30: 4e 4f 4e 2d 49 4e 46 52 49 4e 47 45 4d 45 4e 54 NON-INFRINGEMENT
1d40: 2e 20 20 54 48 49 53 20 53 4f 46 54 57 41 52 45 . THIS SOFTWARE
1d50: 0a 23 20 20 49 53 20 50 52 4f 56 49 44 45 44 20 .# IS PROVIDED
1d60: 4f 4e 20 41 4e 20 22 41 53 20 49 53 22 20 42 41 ON AN "AS IS" BA
1d70: 53 49 53 2c 20 41 4e 44 20 54 48 45 20 41 55 54 SIS, AND THE AUT
1d80: 48 4f 52 53 20 41 4e 44 20 44 49 53 54 52 49 42 HORS AND DISTRIB
1d90: 55 54 4f 52 53 20 48 41 56 45 0a 23 20 20 4e 4f UTORS HAVE.# NO
1da0: 20 4f 42 4c 49 47 41 54 49 4f 4e 20 54 4f 20 50 OBLIGATION TO P
1db0: 52 4f 56 49 44 45 20 4d 41 49 4e 54 45 4e 41 4e ROVIDE MAINTENAN
1dc0: 43 45 2c 20 53 55 50 50 4f 52 54 2c 20 55 50 44 CE, SUPPORT, UPD
1dd0: 41 54 45 53 2c 20 45 4e 48 41 4e 43 45 4d 45 4e ATES, ENHANCEMEN
1de0: 54 53 2c 20 4f 52 0a 23 20 20 4d 4f 44 49 46 49 TS, OR.# MODIFI
1df0: 43 41 54 49 4f 4e 53 2e 0a 23 23 23 23 23 23 23 CATIONS..#######
1e00: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
1e10: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
1e20: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
1e30: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
1e40: 23 23 23 23 23 23 23 23 23 0a 0a 69 66 20 7b 20 #########..if {
1e50: 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 43 [info commands C
1e60: 43 47 65 74 52 47 42 5d 20 65 71 20 22 22 20 7d CGetRGB] eq "" }
1e70: 20 7b 0a 20 20 20 20 70 72 6f 63 20 43 43 47 65 {. proc CCGe
1e80: 74 52 47 42 20 7b 20 77 20 63 6f 6c 6f 72 7d 20 tRGB { w color}
1e90: 7b 0a 09 73 65 74 20 72 65 74 20 24 63 6f 6c 6f {..set ret $colo
1ea0: 72 0a 09 73 65 74 20 6e 20 5b 20 73 63 61 6e 20 r..set n [ scan
1eb0: 24 63 6f 6c 6f 72 20 5c 23 25 32 78 25 32 78 25 $color \#%2x%2x%
1ec0: 32 78 20 72 20 67 20 62 5d 0a 09 69 66 20 7b 20 2x r g b]..if {
1ed0: 24 6e 20 21 3d 20 33 7d 20 7b 0a 09 20 20 20 20 $n != 3} {..
1ee0: 73 65 74 20 72 67 62 20 5b 20 77 69 6e 66 6f 20 set rgb [ winfo
1ef0: 72 67 62 20 24 77 20 24 63 6f 6c 6f 72 5d 0a 09 rgb $w $color]..
1f00: 20 20 20 20 73 65 74 20 72 20 5b 20 65 78 70 72 set r [ expr
1f10: 20 69 6e 74 28 20 5b 20 6c 69 6e 64 65 78 20 24 int( [ lindex $
1f20: 72 67 62 20 30 5d 2f 32 35 36 2e 30 29 5d 0a 09 rgb 0]/256.0)]..
1f30: 20 20 20 20 73 65 74 20 67 20 5b 20 65 78 70 72 set g [ expr
1f40: 20 69 6e 74 28 20 5b 20 6c 69 6e 64 65 78 20 24 int( [ lindex $
1f50: 72 67 62 20 31 5d 2f 32 35 36 2e 30 29 5d 0a 09 rgb 1]/256.0)]..
1f60: 20 20 20 20 73 65 74 20 62 20 5b 20 65 78 70 72 set b [ expr
1f70: 20 69 6e 74 28 20 5b 20 6c 69 6e 64 65 78 20 24 int( [ lindex $
1f80: 72 67 62 20 32 5d 2f 32 35 36 2e 30 29 5d 0a 09 rgb 2]/256.0)]..
1f90: 20 20 20 20 73 65 74 20 72 65 74 20 5b 20 66 6f set ret [ fo
1fa0: 72 6d 61 74 20 5c 23 25 30 32 78 25 30 32 78 25 rmat \#%02x%02x%
1fb0: 30 32 78 20 24 72 20 24 67 20 24 62 5d 0a 09 7d 02x $r $g $b]..}
1fc0: 0a 09 72 65 74 75 72 6e 20 24 72 65 74 0a 20 20 ..return $ret.
1fd0: 20 20 7d 0a 7d 0a 0a 0a 69 66 20 7b 20 5b 69 6e }.}...if { [in
1fe0: 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 43 43 43 6f fo commands CCCo
1ff0: 6c 6f 72 41 63 74 69 76 6f 5d 20 65 71 20 22 22 lorActivo] eq ""
2000: 20 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 43 43 } {. proc CC
2010: 43 6f 6c 6f 72 41 63 74 69 76 6f 20 7b 20 63 6f ColorActivo { co
2020: 6c 6f 72 5f 75 73 75 61 72 69 6f 20 7b 20 66 61 lor_usuario { fa
2030: 63 74 6f 72 20 31 37 7d 20 7d 20 7b 0a 09 73 65 ctor 17} } {..se
2040: 74 20 72 65 74 20 22 22 0a 09 73 65 74 20 63 6f t ret ""..set co
2050: 6c 6f 72 5f 6e 75 65 76 6f 20 5b 20 43 43 47 65 lor_nuevo [ CCGe
2060: 74 52 47 42 20 2e 20 24 63 6f 6c 6f 72 5f 75 73 tRGB . $color_us
2070: 75 61 72 69 6f 5d 0a 09 73 65 74 20 6e 20 5b 20 uario]..set n [
2080: 73 63 61 6e 20 24 63 6f 6c 6f 72 5f 6e 75 65 76 scan $color_nuev
2090: 6f 20 5c 23 25 32 78 25 32 78 25 32 78 20 72 20 o \#%2x%2x%2x r
20a0: 67 20 62 5d 0a 09 69 66 20 7b 20 24 6e 20 3d 3d g b]..if { $n ==
20b0: 20 33 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 72 3} {.. set r
20c0: 20 5b 20 65 78 70 72 20 24 72 20 2b 20 24 66 61 [ expr $r + $fa
20d0: 63 74 6f 72 5d 0a 09 20 20 20 20 69 66 20 7b 20 ctor].. if {
20e0: 24 72 20 3e 20 32 35 35 7d 20 7b 20 73 65 74 20 $r > 255} { set
20f0: 72 20 32 35 35 7d 0a 09 20 20 20 20 73 65 74 20 r 255}.. set
2100: 67 20 5b 20 65 78 70 72 20 24 67 20 2b 20 24 66 g [ expr $g + $f
2110: 61 63 74 6f 72 5d 0a 09 20 20 20 20 69 66 20 7b actor].. if {
2120: 20 24 67 20 3e 20 32 35 35 7d 20 7b 20 73 65 74 $g > 255} { set
2130: 20 67 20 32 35 35 7d 0a 09 20 20 20 20 73 65 74 g 255}.. set
2140: 20 62 20 5b 20 65 78 70 72 20 24 62 20 2b 20 24 b [ expr $b + $
2150: 66 61 63 74 6f 72 5d 0a 09 20 20 20 20 69 66 20 factor].. if
2160: 7b 20 24 62 20 3e 20 32 35 35 7d 20 7b 20 73 65 { $b > 255} { se
2170: 74 20 62 20 32 35 35 7d 0a 09 20 20 20 20 73 65 t b 255}.. se
2180: 74 20 72 65 74 20 5b 20 66 6f 72 6d 61 74 20 5c t ret [ format \
2190: 23 25 32 78 25 32 78 25 32 78 20 24 72 20 24 67 #%2x%2x%2x $r $g
21a0: 20 24 62 5d 0a 09 7d 0a 09 72 65 74 75 72 6e 20 $b]..}..return
21b0: 24 72 65 74 0a 20 20 20 20 7d 0a 7d 0a 0a 6e 61 $ret. }.}..na
21c0: 6d 65 73 70 61 63 65 20 65 76 61 6c 20 44 69 61 mespace eval Dia
21d0: 6c 6f 67 57 69 6e 20 7b 0a 20 20 20 20 76 61 72 logWin {. var
21e0: 69 61 62 6c 65 20 77 0a 20 20 20 20 76 61 72 69 iable w. vari
21f0: 61 62 6c 65 20 61 63 74 69 6f 6e 0a 20 20 20 20 able action.
2200: 76 61 72 69 61 62 6c 65 20 75 73 65 72 0a 20 20 variable user.
2210: 20 20 76 61 72 69 61 62 6c 65 20 6f 6c 64 47 72 variable oldGr
2220: 61 62 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 ab. variable
2230: 67 72 61 62 53 74 61 74 75 73 0a 20 20 20 20 76 grabStatus. v
2240: 61 72 69 61 62 6c 65 20 67 72 61 62 0a 7d 0a 0a ariable grab.}..
2250: 23 63 75 72 72 65 6e 74 20 73 74 79 6c 65 73 20 #current styles
2260: 61 72 65 3a 0a 23 20 20 20 20 20 20 20 20 72 69 are:.# ri
2270: 64 67 65 66 72 61 6d 65 0a 23 20 20 20 20 20 20 dgeframe.#
2280: 20 20 73 65 70 61 72 61 74 6f 72 0a 23 0a 70 72 separator.#.pr
2290: 6f 63 20 44 69 61 6c 6f 67 57 69 6e 3a 3a 49 6e oc DialogWin::In
22a0: 69 74 20 7b 20 77 69 6e 70 61 72 65 6e 74 20 74 it { winparent t
22b0: 69 74 6c 65 20 73 74 79 6c 65 20 7b 20 6d 6f 72 itle style { mor
22c0: 65 62 75 74 74 6f 6e 73 20 22 22 20 7d 20 7b 20 ebuttons "" } {
22d0: 4f 4b 6e 61 6d 65 20 22 22 20 7d 20 7b 20 43 61 OKname "" } { Ca
22e0: 6e 63 65 6c 6e 61 6d 65 20 22 22 20 7d 20 7d 20 ncelname "" } }
22f0: 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 61 {. variable a
2300: 63 74 69 6f 6e 0a 20 20 20 20 76 61 72 69 61 62 ction. variab
2310: 6c 65 20 77 0a 20 20 20 20 76 61 72 69 61 62 6c le w. variabl
2320: 65 20 67 72 61 62 0a 0a 20 20 20 20 73 65 74 20 e grab.. set
2330: 67 72 61 62 20 31 0a 20 20 20 20 69 66 20 7b 20 grab 1. if {
2340: 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 2a 6e [string match *n
2350: 6f 67 72 61 62 20 24 73 74 79 6c 65 5d 20 7d 20 ograb $style] }
2360: 7b 20 73 65 74 20 67 72 61 62 20 30 20 7d 0a 0a { set grab 0 }..
2370: 20 20 20 20 69 66 20 7b 20 24 77 69 6e 70 61 72 if { $winpar
2380: 65 6e 74 20 3d 3d 20 22 2e 22 20 7d 20 7b 20 73 ent == "." } { s
2390: 65 74 20 77 69 6e 70 61 72 65 6e 74 20 22 22 20 et winparent ""
23a0: 7d 0a 20 20 20 20 73 65 74 20 77 20 24 77 69 6e }. set w $win
23b0: 70 61 72 65 6e 74 2e 5f 5f 64 69 61 6c 6f 67 77 parent.__dialogw
23c0: 69 6e 0a 0a 20 20 20 20 63 61 74 63 68 20 7b 20 in.. catch {
23d0: 64 65 73 74 72 6f 79 20 24 77 20 7d 0a 0a 23 20 destroy $w }..#
23e0: 20 20 20 20 73 65 74 20 69 20 30 0a 23 20 20 20 set i 0.#
23f0: 20 20 77 68 69 6c 65 20 7b 20 5b 77 69 6e 66 6f while { [winfo
2400: 20 65 78 69 73 74 73 20 24 77 5d 20 7d 20 7b 0a exists $w] } {.
2410: 23 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 # incr i
2420: 0a 23 20 20 20 20 20 20 20 20 20 73 65 74 20 77 .# set w
2430: 20 24 77 69 6e 70 61 72 65 6e 74 2e 5f 5f 64 69 $winparent.__di
2440: 61 6c 6f 67 77 69 6e 24 69 0a 23 20 20 20 20 20 alogwin$i.#
2450: 7d 0a 20 20 20 20 74 6f 70 6c 65 76 65 6c 20 24 }. toplevel $
2460: 77 0a 20 20 20 20 69 66 20 7b 20 24 3a 3a 74 63 w. if { $::tc
2470: 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 l_platform(platf
2480: 6f 72 6d 29 20 3d 3d 20 22 77 69 6e 64 6f 77 73 orm) == "windows
2490: 22 20 7d 20 7b 20 20 20 20 20 20 20 0a 09 77 6d " } { ..wm
24a0: 20 61 74 74 72 69 62 75 74 65 73 20 24 77 20 2d attributes $w -
24b0: 74 6f 6f 6c 77 69 6e 64 6f 77 20 31 0a 20 20 20 toolwindow 1.
24c0: 20 7d 0a 20 20 20 20 77 6d 20 74 69 74 6c 65 20 }. wm title
24d0: 24 77 20 24 74 69 74 6c 65 0a 20 20 20 20 77 6d $w $title. wm
24e0: 20 77 69 74 68 64 72 61 77 20 24 77 0a 0a 20 20 withdraw $w..
24f0: 20 20 73 77 69 74 63 68 20 24 73 74 79 6c 65 20 switch $style
2500: 7b 0a 09 72 69 64 67 65 66 72 61 6d 65 20 7b 0a {..ridgeframe {.
2510: 09 20 20 20 20 66 72 61 6d 65 20 24 77 2e 66 20 . frame $w.f
2520: 2d 72 65 6c 69 65 66 20 72 69 64 67 65 20 2d 62 -relief ridge -b
2530: 64 20 32 0a 09 20 20 20 20 66 72 61 6d 65 20 24 d 2.. frame $
2540: 77 2e 62 75 74 73 0a 09 20 20 20 20 67 72 69 64 w.buts.. grid
2550: 20 24 77 2e 66 20 2d 73 74 69 63 6b 79 20 65 77 $w.f -sticky ew
2560: 6e 73 20 2d 70 61 64 78 20 32 20 2d 70 61 64 79 ns -padx 2 -pady
2570: 20 32 0a 09 20 20 20 20 67 72 69 64 20 24 77 2e 2.. grid $w.
2580: 62 75 74 73 20 2d 73 74 69 63 6b 79 20 65 77 0a buts -sticky ew.
2590: 09 20 20 20 20 69 66 20 7b 20 24 3a 3a 74 63 6c . if { $::tcl
25a0: 5f 76 65 72 73 69 6f 6e 20 3e 3d 20 38 2e 35 20 _version >= 8.5
25b0: 7d 20 7b 20 67 72 69 64 20 61 6e 63 68 6f 72 20 } { grid anchor
25c0: 24 77 2e 62 75 74 73 20 63 65 6e 74 65 72 20 7d $w.buts center }
25d0: 0a 09 7d 0a 09 73 65 70 61 72 61 74 6f 72 20 2d ..}..separator -
25e0: 20 73 65 70 61 72 61 74 6f 72 5f 6e 6f 67 72 61 separator_nogra
25f0: 62 20 7b 0a 09 20 20 20 20 66 72 61 6d 65 20 24 b {.. frame $
2600: 77 2e 66 20 2d 62 64 20 30 0a 09 20 20 20 20 66 w.f -bd 0.. f
2610: 72 61 6d 65 20 24 77 2e 73 65 70 20 2d 62 64 20 rame $w.sep -bd
2620: 32 20 2d 72 65 6c 69 65 66 20 72 61 69 73 65 64 2 -relief raised
2630: 20 2d 68 65 69 67 68 74 20 32 0a 09 20 20 20 20 -height 2..
2640: 66 72 61 6d 65 20 24 77 2e 62 75 74 73 0a 09 20 frame $w.buts..
2650: 20 20 20 67 72 69 64 20 24 77 2e 66 20 2d 73 74 grid $w.f -st
2660: 69 63 6b 79 20 65 77 6e 73 20 2d 70 61 64 78 20 icky ewns -padx
2670: 32 20 2d 70 61 64 79 20 32 0a 09 20 20 20 20 67 2 -pady 2.. g
2680: 72 69 64 20 24 77 2e 73 65 70 20 2d 73 74 69 63 rid $w.sep -stic
2690: 6b 79 20 65 77 0a 09 20 20 20 20 67 72 69 64 20 ky ew.. grid
26a0: 24 77 2e 62 75 74 73 20 2d 73 74 69 63 6b 79 20 $w.buts -sticky
26b0: 65 77 0a 09 20 20 20 20 69 66 20 7b 20 24 3a 3a ew.. if { $::
26c0: 74 63 6c 5f 76 65 72 73 69 6f 6e 20 3e 3d 20 38 tcl_version >= 8
26d0: 2e 35 20 7d 20 7b 20 67 72 69 64 20 61 6e 63 68 .5 } { grid anch
26e0: 6f 72 20 24 77 2e 62 75 74 73 20 63 65 6e 74 65 or $w.buts cente
26f0: 72 20 7d 0a 09 7d 0a 09 64 65 66 61 75 6c 74 20 r }..}..default
2700: 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 65 72 {.. error "er
2710: 72 6f 72 3a 20 6f 6e 6c 79 20 61 63 63 65 70 74 ror: only accept
2720: 65 64 20 73 74 79 6c 65 73 20 72 69 64 67 65 66 ed styles ridgef
2730: 72 61 6d 65 2c 20 73 65 70 61 72 61 74 6f 72 5f rame, separator_
2740: 6e 6f 67 72 61 62 20 61 6e 64 20 73 65 70 61 72 nograb and separ
2750: 61 74 6f 72 22 0a 09 7d 0a 20 20 20 20 7d 0a 20 ator"..}. }.
2760: 20 20 20 24 77 2e 62 75 74 73 20 63 6f 6e 66 20 $w.buts conf
2770: 2d 62 67 20 5b 43 43 43 6f 6c 6f 72 41 63 74 69 -bg [CCColorActi
2780: 76 6f 20 5b 24 77 20 20 63 67 65 74 20 2d 62 67 vo [$w cget -bg
2790: 5d 5d 0a 0a 20 20 20 20 69 66 20 7b 20 24 4f 4b ]].. if { $OK
27a0: 6e 61 6d 65 20 3d 3d 20 22 22 20 7d 20 7b 0a 09 name == "" } {..
27b0: 73 65 74 20 4f 4b 6e 61 6d 65 20 5b 5f 20 4f 4b set OKname [_ OK
27c0: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b ]. }. if {
27d0: 20 24 43 61 6e 63 65 6c 6e 61 6d 65 20 21 3d 20 $Cancelname !=
27e0: 22 22 20 7d 20 7b 0a 09 73 65 74 20 43 61 6e 63 "" } {..set Canc
27f0: 65 6c 4e 61 6d 65 20 24 43 61 6e 63 65 6c 6e 61 elName $Cancelna
2800: 6d 65 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 me. } elseif
2810: 7b 20 24 4f 4b 6e 61 6d 65 20 3d 3d 20 22 2d 22 { $OKname == "-"
2820: 20 7d 20 7b 0a 09 73 65 74 20 43 61 6e 63 65 6c } {..set Cancel
2830: 4e 61 6d 65 20 5b 5f 20 43 6c 6f 73 65 5d 0a 20 Name [_ Close].
2840: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
2850: 20 43 61 6e 63 65 6c 4e 61 6d 65 20 5b 5f 20 43 CancelName [_ C
2860: 61 6e 63 65 6c 5d 0a 20 20 20 20 7d 0a 0a 20 20 ancel]. }..
2870: 20 20 73 65 74 20 62 75 74 77 69 64 74 68 20 37 set butwidth 7
2880: 0a 20 20 20 20 69 66 20 7b 20 5b 73 74 72 69 6e . if { [strin
2890: 67 20 6c 65 6e 67 74 68 20 24 4f 4b 6e 61 6d 65 g length $OKname
28a0: 5d 20 3e 20 24 62 75 74 77 69 64 74 68 20 7d 20 ] > $butwidth }
28b0: 7b 20 73 65 74 20 62 75 74 77 69 64 74 68 20 5b { set butwidth [
28c0: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 4f string length $O
28d0: 4b 6e 61 6d 65 5d 20 7d 0a 20 20 20 20 69 66 20 Kname] }. if
28e0: 7b 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 { [string length
28f0: 20 24 43 61 6e 63 65 6c 4e 61 6d 65 5d 20 3e 20 $CancelName] >
2900: 24 62 75 74 77 69 64 74 68 20 7d 20 7b 20 73 65 $butwidth } { se
2910: 74 20 62 75 74 77 69 64 74 68 20 5b 73 74 72 69 t butwidth [stri
2920: 6e 67 20 6c 65 6e 67 74 68 20 24 43 61 6e 63 65 ng length $Cance
2930: 6c 4e 61 6d 65 5d 20 7d 0a 20 20 20 20 66 6f 72 lName] }. for
2940: 65 61 63 68 20 69 20 24 6d 6f 72 65 62 75 74 74 each i $morebutt
2950: 6f 6e 73 20 7b 0a 09 69 66 20 7b 20 5b 73 74 72 ons {..if { [str
2960: 69 6e 67 20 6c 65 6e 67 74 68 20 24 69 5d 20 3e ing length $i] >
2970: 20 24 62 75 74 77 69 64 74 68 20 7d 20 7b 20 73 $butwidth } { s
2980: 65 74 20 62 75 74 77 69 64 74 68 20 5b 73 74 72 et butwidth [str
2990: 69 6e 67 20 6c 65 6e 67 74 68 20 24 69 5d 20 7d ing length $i] }
29a0: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 . }.. set
29b0: 75 73 65 64 6c 65 74 74 65 72 73 20 5b 73 74 72 usedletters [str
29c0: 69 6e 67 20 74 6f 6c 6f 77 65 72 20 5b 73 74 72 ing tolower [str
29d0: 69 6e 67 20 69 6e 64 65 78 20 24 4f 4b 6e 61 6d ing index $OKnam
29e0: 65 20 30 5d 5d 0a 20 20 20 20 69 66 20 7b 20 5b e 0]]. if { [
29f0: 73 74 72 69 6e 67 20 74 6f 6c 6f 77 65 72 20 5b string tolower [
2a00: 73 74 72 69 6e 67 20 69 6e 64 65 78 20 24 43 61 string index $Ca
2a10: 6e 63 65 6c 4e 61 6d 65 20 30 5d 5d 20 21 3d 20 ncelName 0]] !=
2a20: 24 75 73 65 64 6c 65 74 74 65 72 73 20 7d 20 7b $usedletters } {
2a30: 0a 09 6c 61 70 70 65 6e 64 20 75 73 65 64 6c 65 ..lappend usedle
2a40: 74 74 65 72 73 20 5b 73 74 72 69 6e 67 20 74 6f tters [string to
2a50: 6c 6f 77 65 72 20 5b 73 74 72 69 6e 67 20 69 6e lower [string in
2a60: 64 65 78 20 24 43 61 6e 63 65 6c 4e 61 6d 65 20 dex $CancelName
2a70: 30 5d 5d 0a 09 73 65 74 20 75 6e 64 65 72 6c 69 0]]..set underli
2a80: 6e 65 63 61 6e 63 65 6c 20 30 0a 20 20 20 20 7d necancel 0. }
2a90: 20 65 6c 73 65 20 7b 0a 09 6c 61 70 70 65 6e 64 else {..lappend
2aa0: 20 75 73 65 64 6c 65 74 74 65 72 73 20 5b 73 74 usedletters [st
2ab0: 72 69 6e 67 20 74 6f 6c 6f 77 65 72 20 5b 73 74 ring tolower [st
2ac0: 72 69 6e 67 20 69 6e 64 65 78 20 24 43 61 6e 63 ring index $Canc
2ad0: 65 6c 4e 61 6d 65 20 31 5d 5d 0a 09 73 65 74 20 elName 1]]..set
2ae0: 75 6e 64 65 72 6c 69 6e 65 63 61 6e 63 65 6c 20 underlinecancel
2af0: 31 0a 20 20 20 20 7d 0a 0a 20 20 20 20 69 66 20 1. }.. if
2b00: 7b 20 24 4f 4b 6e 61 6d 65 20 21 3d 20 22 2d 22 { $OKname != "-"
2b10: 20 7d 20 7b 0a 09 62 75 74 74 6f 6e 20 24 77 2e } {..button $w.
2b20: 62 75 74 73 2e 6f 6b 20 2d 74 65 78 74 20 24 4f buts.ok -text $O
2b30: 4b 6e 61 6d 65 20 2d 77 69 64 74 68 20 24 62 75 Kname -width $bu
2b40: 74 77 69 64 74 68 20 2d 75 6e 64 20 30 20 2d 63 twidth -und 0 -c
2b50: 6f 6d 6d 61 6e 64 20 5c 0a 09 09 5b 6e 61 6d 65 ommand \...[name
2b60: 73 70 61 63 65 20 63 6f 64 65 20 22 73 65 74 20 space code "set
2b70: 61 63 74 69 6f 6e 20 31 22 5d 0a 20 20 20 20 7d action 1"]. }
2b80: 0a 0a 20 20 20 20 73 65 74 20 74 6f 67 72 69 64 .. set togrid
2b90: 20 22 22 0a 20 20 20 20 69 66 20 7b 20 24 6d 6f "". if { $mo
2ba0: 72 65 62 75 74 74 6f 6e 73 20 21 3d 20 22 22 20 rebuttons != ""
2bb0: 7d 20 7b 0a 09 73 65 74 20 69 61 63 74 69 6f 6e } {..set iaction
2bc0: 20 32 0a 09 66 6f 72 65 61 63 68 20 69 20 24 6d 2..foreach i $m
2bd0: 6f 72 65 62 75 74 74 6f 6e 73 20 7b 0a 09 20 20 orebuttons {..
2be0: 20 20 66 6f 72 20 7b 20 73 65 74 20 69 70 6f 73 for { set ipos
2bf0: 20 30 20 7d 20 7b 20 24 69 70 6f 73 20 3c 20 5b 0 } { $ipos < [
2c00: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 69 string length $i
2c10: 5d 20 7d 20 7b 20 69 6e 63 72 20 69 70 6f 73 20 ] } { incr ipos
2c20: 7d 20 7b 0a 09 09 73 65 74 20 6c 65 74 74 65 72 } {...set letter
2c30: 20 5b 73 74 72 69 6e 67 20 74 6f 6c 6f 77 65 72 [string tolower
2c40: 20 5b 73 74 72 69 6e 67 20 69 6e 64 65 78 20 24 [string index $
2c50: 69 20 24 69 70 6f 73 5d 5d 0a 09 09 69 66 20 7b i $ipos]]...if {
2c60: 20 5b 72 65 67 65 78 70 20 7b 5b 61 2d 7a 41 2d [regexp {[a-zA-
2c70: 5a 5d 7d 20 24 6c 65 74 74 65 72 5d 20 26 26 20 Z]} $letter] &&
2c80: 5b 6c 73 65 61 72 63 68 20 24 75 73 65 64 6c 65 [lsearch $usedle
2c90: 74 74 65 72 73 20 24 6c 65 74 74 65 72 5d 20 3d tters $letter] =
2ca0: 3d 20 2d 31 20 7d 20 7b 0a 09 09 20 20 20 20 62 = -1 } {... b
2cb0: 72 65 61 6b 0a 09 09 7d 0a 09 20 20 20 20 7d 0a reak...}.. }.
2cc0: 09 20 20 20 20 69 66 20 7b 20 24 69 70 6f 73 20 . if { $ipos
2cd0: 3c 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 < [string length
2ce0: 20 24 69 5d 20 7d 20 7b 0a 09 09 62 75 74 74 6f $i] } {...butto
2cf0: 6e 20 24 77 2e 62 75 74 73 2e 62 24 69 61 63 74 n $w.buts.b$iact
2d00: 69 6f 6e 20 2d 74 65 78 74 20 24 69 20 2d 77 69 ion -text $i -wi
2d10: 64 74 68 20 24 62 75 74 77 69 64 74 68 20 2d 75 dth $butwidth -u
2d20: 6e 64 20 24 69 70 6f 73 20 5c 0a 09 09 20 20 20 nd $ipos \...
2d30: 20 20 20 20 20 2d 63 6f 6d 6d 61 6e 64 20 5b 6e -command [n
2d40: 61 6d 65 73 70 61 63 65 20 63 6f 64 65 20 22 73 amespace code "s
2d50: 65 74 20 61 63 74 69 6f 6e 20 24 69 61 63 74 69 et action $iacti
2d60: 6f 6e 22 5d 0a 09 09 62 69 6e 64 20 24 77 20 3c on"]...bind $w <
2d70: 41 6c 74 2d 24 6c 65 74 74 65 72 3e 20 5c 0a 09 Alt-$letter> \..
2d80: 09 20 20 20 20 20 20 20 20 22 74 6b 42 75 74 74 . "tkButt
2d90: 6f 6e 49 6e 76 6f 6b 65 20 24 77 2e 62 75 74 73 onInvoke $w.buts
2da0: 2e 62 24 69 61 63 74 69 6f 6e 22 0a 09 09 62 69 .b$iaction"...bi
2db0: 6e 64 20 24 77 2e 62 75 74 73 2e 62 24 69 61 63 nd $w.buts.b$iac
2dc0: 74 69 6f 6e 20 3c 52 65 74 75 72 6e 3e 20 22 74 tion <Return> "t
2dd0: 6b 42 75 74 74 6f 6e 49 6e 76 6f 6b 65 20 24 77 kButtonInvoke $w
2de0: 2e 62 75 74 73 2e 62 24 69 61 63 74 69 6f 6e 22 .buts.b$iaction"
2df0: 0a 09 09 6c 61 70 70 65 6e 64 20 75 73 65 64 6c ...lappend usedl
2e00: 65 74 74 65 72 73 20 5b 73 74 72 69 6e 67 20 74 etters [string t
2e10: 6f 6c 6f 77 65 72 20 5b 73 74 72 69 6e 67 20 69 olower [string i
2e20: 6e 64 65 78 20 24 69 20 24 69 70 6f 73 5d 5d 0a ndex $i $ipos]].
2e30: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
2e40: 62 75 74 74 6f 6e 20 24 77 2e 62 75 74 73 2e 62 button $w.buts.b
2e50: 24 69 61 63 74 69 6f 6e 20 2d 74 65 78 74 20 24 $iaction -text $
2e60: 69 20 2d 77 69 64 74 68 20 24 62 75 74 77 69 64 i -width $butwid
2e70: 74 68 20 20 5c 0a 09 09 20 20 20 20 20 20 20 20 th \...
2e80: 2d 63 6f 6d 6d 61 6e 64 20 5b 6e 61 6d 65 73 70 -command [namesp
2e90: 61 63 65 20 63 6f 64 65 20 22 73 65 74 20 61 63 ace code "set ac
2ea0: 74 69 6f 6e 20 24 69 61 63 74 69 6f 6e 22 5d 0a tion $iaction"].
2eb0: 09 20 20 20 20 7d 0a 09 20 20 20 20 6c 61 70 70 . }.. lapp
2ec0: 65 6e 64 20 74 6f 67 72 69 64 20 24 77 2e 62 75 end togrid $w.bu
2ed0: 74 73 2e 62 24 69 61 63 74 69 6f 6e 0a 09 20 20 ts.b$iaction..
2ee0: 20 20 69 6e 63 72 20 69 61 63 74 69 6f 6e 0a 09 incr iaction..
2ef0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b }. }. if {
2f00: 20 24 43 61 6e 63 65 6c 6e 61 6d 65 20 21 3d 20 $Cancelname !=
2f10: 22 2d 22 20 7d 20 7b 0a 09 62 75 74 74 6f 6e 20 "-" } {..button
2f20: 24 77 2e 62 75 74 73 2e 63 61 6e 63 65 6c 20 2d $w.buts.cancel -
2f30: 74 65 78 74 20 24 43 61 6e 63 65 6c 4e 61 6d 65 text $CancelName
2f40: 20 2d 77 69 64 74 68 20 24 62 75 74 77 69 64 74 -width $butwidt
2f50: 68 20 2d 75 6e 64 20 24 75 6e 64 65 72 6c 69 6e h -und $underlin
2f60: 65 63 61 6e 63 65 6c 20 2d 63 6f 6d 6d 61 6e 64 ecancel -command
2f70: 20 5c 0a 09 5b 6e 61 6d 65 73 70 61 63 65 20 63 \..[namespace c
2f80: 6f 64 65 20 22 73 65 74 20 61 63 74 69 6f 6e 20 ode "set action
2f90: 30 22 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 69 0"]. }.. i
2fa0: 66 20 7b 20 24 4f 4b 6e 61 6d 65 20 21 3d 20 22 f { $OKname != "
2fb0: 2d 22 20 7d 20 7b 0a 09 73 65 74 20 74 6f 67 72 -" } {..set togr
2fc0: 69 64 20 22 24 77 2e 62 75 74 73 2e 6f 6b 20 24 id "$w.buts.ok $
2fd0: 74 6f 67 72 69 64 22 0a 20 20 20 20 7d 0a 20 20 togrid". }.
2fe0: 20 20 69 66 20 7b 20 24 43 61 6e 63 65 6c 6e 61 if { $Cancelna
2ff0: 6d 65 20 21 3d 20 22 2d 22 20 7d 20 7b 0a 09 73 me != "-" } {..s
3000: 65 74 20 74 6f 67 72 69 64 20 22 24 74 6f 67 72 et togrid "$togr
3010: 69 64 20 24 77 2e 62 75 74 73 2e 63 61 6e 63 65 id $w.buts.cance
3020: 6c 22 0a 20 20 20 20 7d 0a 20 20 20 20 65 76 61 l". }. eva
3030: 6c 20 67 72 69 64 20 24 74 6f 67 72 69 64 20 2d l grid $togrid -
3040: 70 61 64 78 20 32 20 2d 70 61 64 79 20 34 0a 0a padx 2 -pady 4..
3050: 20 20 20 20 69 66 20 7b 20 24 4f 4b 6e 61 6d 65 if { $OKname
3060: 20 21 3d 20 22 2d 22 20 7d 20 7b 0a 09 62 69 6e != "-" } {..bin
3070: 64 20 24 77 2e 62 75 74 73 2e 6f 6b 20 3c 52 65 d $w.buts.ok <Re
3080: 74 75 72 6e 3e 20 22 74 6b 42 75 74 74 6f 6e 49 turn> "tkButtonI
3090: 6e 76 6f 6b 65 20 24 77 2e 62 75 74 73 2e 6f 6b nvoke $w.buts.ok
30a0: 22 0a 09 63 61 74 63 68 20 7b 0a 09 20 20 20 20 "..catch {..
30b0: 62 69 6e 64 20 24 77 20 3c 41 6c 74 2d 5b 73 74 bind $w <Alt-[st
30c0: 72 69 6e 67 20 74 6f 6c 6f 77 65 72 20 5b 73 74 ring tolower [st
30d0: 72 69 6e 67 20 69 6e 64 65 78 20 24 4f 4b 6e 61 ring index $OKna
30e0: 6d 65 20 30 5d 5d 3e 20 22 74 6b 42 75 74 74 6f me 0]]> "tkButto
30f0: 6e 49 6e 76 6f 6b 65 20 24 77 2e 62 75 74 73 2e nInvoke $w.buts.
3100: 6f 6b 22 0a 09 7d 0a 09 66 6f 63 75 73 20 24 77 ok"..}..focus $w
3110: 2e 62 75 74 73 2e 6f 6b 0a 20 20 20 20 7d 20 65 .buts.ok. } e
3120: 6c 73 65 69 66 20 7b 20 24 43 61 6e 63 65 6c 6e lseif { $Canceln
3130: 61 6d 65 20 21 3d 20 22 2d 22 20 7d 20 7b 0a 09 ame != "-" } {..
3140: 66 6f 63 75 73 20 24 77 2e 62 75 74 73 2e 63 61 focus $w.buts.ca
3150: 6e 63 65 6c 0a 20 20 20 20 7d 0a 0a 20 20 20 20 ncel. }..
3160: 69 66 20 7b 20 24 43 61 6e 63 65 6c 6e 61 6d 65 if { $Cancelname
3170: 20 21 3d 20 22 2d 22 20 7d 20 7b 0a 09 62 69 6e != "-" } {..bin
3180: 64 20 24 77 20 3c 45 73 63 61 70 65 3e 20 22 74 d $w <Escape> "t
3190: 6b 42 75 74 74 6f 6e 49 6e 76 6f 6b 65 20 24 77 kButtonInvoke $w
31a0: 2e 62 75 74 73 2e 63 61 6e 63 65 6c 22 0a 09 62 .buts.cancel"..b
31b0: 69 6e 64 20 24 77 2e 62 75 74 73 2e 63 61 6e 63 ind $w.buts.canc
31c0: 65 6c 20 3c 52 65 74 75 72 6e 3e 20 22 74 6b 42 el <Return> "tkB
31d0: 75 74 74 6f 6e 49 6e 76 6f 6b 65 20 24 77 2e 62 uttonInvoke $w.b
31e0: 75 74 73 2e 63 61 6e 63 65 6c 22 0a 09 63 61 74 uts.cancel"..cat
31f0: 63 68 20 7b 0a 09 20 20 20 20 62 69 6e 64 20 24 ch {.. bind $
3200: 77 20 3c 41 6c 74 2d 5b 73 74 72 69 6e 67 20 74 w <Alt-[string t
3210: 6f 6c 6f 77 65 72 20 5b 73 74 72 69 6e 67 20 69 olower [string i
3220: 6e 64 65 78 20 24 43 61 6e 63 65 6c 4e 61 6d 65 ndex $CancelName
3230: 20 24 75 6e 64 65 72 6c 69 6e 65 63 61 6e 63 65 $underlinecance
3240: 6c 5d 5d 3e 20 5c 0a 09 09 22 74 6b 42 75 74 74 l]]> \..."tkButt
3250: 6f 6e 49 6e 76 6f 6b 65 20 24 77 2e 62 75 74 73 onInvoke $w.buts
3260: 2e 63 61 6e 63 65 6c 22 0a 09 7d 0a 09 77 6d 20 .cancel"..}..wm
3270: 70 72 6f 74 6f 63 6f 6c 20 24 77 20 57 4d 5f 44 protocol $w WM_D
3280: 45 4c 45 54 45 5f 57 49 4e 44 4f 57 20 22 74 6b ELETE_WINDOW "tk
3290: 42 75 74 74 6f 6e 49 6e 76 6f 6b 65 20 24 77 2e ButtonInvoke $w.
32a0: 62 75 74 73 2e 63 61 6e 63 65 6c 22 0a 20 20 20 buts.cancel".
32b0: 20 7d 20 65 6c 73 65 20 7b 0a 09 62 69 6e 64 20 } else {..bind
32c0: 24 77 20 3c 45 73 63 61 70 65 3e 20 5b 6e 61 6d $w <Escape> [nam
32d0: 65 73 70 61 63 65 20 63 6f 64 65 20 22 73 65 74 espace code "set
32e0: 20 61 63 74 69 6f 6e 20 2d 31 22 5d 0a 09 77 6d action -1"]..wm
32f0: 20 70 72 6f 74 6f 63 6f 6c 20 24 77 20 57 4d 5f protocol $w WM_
3300: 44 45 4c 45 54 45 5f 57 49 4e 44 4f 57 20 5b 6e DELETE_WINDOW [n
3310: 61 6d 65 73 70 61 63 65 20 63 6f 64 65 20 22 73 amespace code "s
3320: 65 74 20 61 63 74 69 6f 6e 20 2d 31 22 5d 0a 20 et action -1"].
3330: 20 20 20 7d 0a 0a 20 20 20 20 67 72 69 64 20 63 }.. grid c
3340: 6f 6c 75 6d 6e 63 6f 6e 66 20 24 77 20 30 20 2d olumnconf $w 0 -
3350: 77 65 69 67 68 74 20 31 0a 20 20 20 20 67 72 69 weight 1. gri
3360: 64 20 72 6f 77 63 6f 6e 66 20 24 77 20 30 20 2d d rowconf $w 0 -
3370: 77 65 69 67 68 74 20 31 0a 0a 20 20 20 20 72 65 weight 1.. re
3380: 74 75 72 6e 20 24 77 2e 66 0a 7d 0a 0a 70 72 6f turn $w.f.}..pro
3390: 63 20 44 69 61 6c 6f 67 57 69 6e 3a 3a 49 6e 76 c DialogWin::Inv
33a0: 6f 6b 65 4f 4b 20 7b 20 7b 20 76 69 73 69 62 6c okeOK { { visibl
33b0: 65 20 31 20 7d 20 7d 20 7b 0a 20 20 20 20 76 61 e 1 } } {. va
33c0: 72 69 61 62 6c 65 20 77 0a 0a 20 20 20 20 69 66 riable w.. if
33d0: 20 7b 20 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 { ![winfo exist
33e0: 73 20 24 77 2e 62 75 74 73 2e 6f 6b 5d 20 7d 20 s $w.buts.ok] }
33f0: 7b 20 72 65 74 75 72 6e 20 7d 0a 0a 20 20 20 20 { return }..
3400: 69 66 20 7b 20 24 76 69 73 69 62 6c 65 20 7d 20 if { $visible }
3410: 7b 0a 09 74 6b 42 75 74 74 6f 6e 49 6e 76 6f 6b {..tkButtonInvok
3420: 65 20 24 77 2e 62 75 74 73 2e 6f 6b 0a 20 20 20 e $w.buts.ok.
3430: 20 7d 20 65 6c 73 65 20 7b 0a 09 24 77 2e 62 75 } else {..$w.bu
3440: 74 73 2e 6f 6b 20 69 6e 76 6f 6b 65 0a 20 20 20 ts.ok invoke.
3450: 20 7d 0a 7d 0a 0a 70 72 6f 63 20 44 69 61 6c 6f }.}..proc Dialo
3460: 67 57 69 6e 3a 3a 49 6e 76 6f 6b 65 43 61 6e 63 gWin::InvokeCanc
3470: 65 6c 20 7b 20 7b 20 76 69 73 69 62 6c 65 20 31 el { { visible 1
3480: 20 7d 20 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 } } {. varia
3490: 62 6c 65 20 77 0a 0a 20 20 20 20 69 66 20 7b 20 ble w.. if {
34a0: 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 24 ![winfo exists $
34b0: 77 2e 62 75 74 73 2e 63 61 6e 63 65 6c 5d 20 7d w.buts.cancel] }
34c0: 20 7b 20 72 65 74 75 72 6e 20 7d 0a 0a 20 20 20 { return }..
34d0: 20 69 66 20 7b 20 24 76 69 73 69 62 6c 65 20 7d if { $visible }
34e0: 20 7b 0a 09 74 6b 42 75 74 74 6f 6e 49 6e 76 6f {..tkButtonInvo
34f0: 6b 65 20 24 77 2e 62 75 74 73 2e 63 61 6e 63 65 ke $w.buts.cance
3500: 6c 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 l. } else {..
3510: 24 77 2e 62 75 74 73 2e 63 61 6e 63 65 6c 20 69 $w.buts.cancel i
3520: 6e 76 6f 6b 65 0a 20 20 20 20 7d 0a 7d 0a 0a 70 nvoke. }.}..p
3530: 72 6f 63 20 44 69 61 6c 6f 67 57 69 6e 3a 3a 46 roc DialogWin::F
3540: 6f 63 75 73 43 61 6e 63 65 6c 20 7b 7d 20 7b 0a ocusCancel {} {.
3550: 20 20 20 20 76 61 72 69 61 62 6c 65 20 77 0a 20 variable w.
3560: 20 20 20 66 6f 63 75 73 20 24 77 2e 62 75 74 73 focus $w.buts
3570: 2e 63 61 6e 63 65 6c 0a 7d 0a 0a 70 72 6f 63 20 .cancel.}..proc
3580: 44 69 61 6c 6f 67 57 69 6e 3a 3a 49 6e 76 6f 6b DialogWin::Invok
3590: 65 42 75 74 74 6f 6e 20 7b 20 6e 75 6d 20 7b 20 eButton { num {
35a0: 76 69 73 69 62 6c 65 20 31 20 7d 20 7d 20 7b 0a visible 1 } } {.
35b0: 20 20 20 20 76 61 72 69 61 62 6c 65 20 77 0a 0a variable w..
35c0: 20 20 20 20 69 66 20 7b 20 21 5b 77 69 6e 66 6f if { ![winfo
35d0: 20 65 78 69 73 74 73 20 24 77 2e 62 75 74 73 5d exists $w.buts]
35e0: 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a 0a 20 } { return }..
35f0: 20 20 20 69 66 20 7b 20 24 6e 75 6d 20 3c 20 32 if { $num < 2
3600: 20 7d 20 7b 0a 09 57 61 72 6e 57 69 6e 20 22 44 } {..WarnWin "D
3610: 69 61 6c 6f 67 57 69 6e 3a 3a 49 6e 76 6f 6b 65 ialogWin::Invoke
3620: 42 75 74 74 6f 6e 20 6e 75 6d 3e 32 22 0a 09 72 Button num>2"..r
3630: 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 eturn. }.
3640: 66 6f 72 65 61 63 68 20 69 20 5b 77 69 6e 66 6f foreach i [winfo
3650: 20 63 68 69 6c 64 72 65 6e 20 24 77 2e 62 75 74 children $w.but
3660: 73 5d 20 7b 0a 09 69 66 20 7b 20 5b 72 65 67 65 s] {..if { [rege
3670: 78 70 20 22 5c 5c 6d 24 6e 75 6d 5c 5c 4d 22 20 xp "\\m$num\\M"
3680: 5b 24 69 20 63 67 65 74 20 2d 63 6f 6d 6d 61 6e [$i cget -comman
3690: 64 5d 5d 20 7d 20 7b 0a 09 20 20 20 20 69 66 20 d]] } {.. if
36a0: 7b 20 24 76 69 73 69 62 6c 65 20 7d 20 7b 0a 09 { $visible } {..
36b0: 09 74 6b 42 75 74 74 6f 6e 49 6e 76 6f 6b 65 20 .tkButtonInvoke
36c0: 24 69 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b $i.. } else {
36d0: 0a 09 09 24 69 20 69 6e 76 6f 6b 65 0a 09 20 20 ...$i invoke..
36e0: 20 20 7d 0a 09 20 20 20 20 72 65 74 75 72 6e 0a }.. return.
36f0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 57 61 72 .}. }. War
3700: 6e 57 69 6e 20 22 44 69 61 6c 6f 67 57 69 6e 3a nWin "DialogWin:
3710: 3a 49 6e 76 6f 6b 65 42 75 74 74 6f 6e 20 6e 75 :InvokeButton nu
3720: 6d 20 62 61 64 22 0a 7d 0a 0a 70 72 6f 63 20 44 m bad".}..proc D
3730: 69 61 6c 6f 67 57 69 6e 3a 3a 46 6f 63 75 73 42 ialogWin::FocusB
3740: 75 74 74 6f 6e 20 7b 20 6e 75 6d 20 7d 20 7b 0a utton { num } {.
3750: 20 20 20 20 76 61 72 69 61 62 6c 65 20 77 0a 0a variable w..
3760: 20 20 20 20 69 66 20 7b 20 24 6e 75 6d 20 3c 20 if { $num <
3770: 32 20 7d 20 7b 0a 09 57 61 72 6e 57 69 6e 20 22 2 } {..WarnWin "
3780: 44 69 61 6c 6f 67 57 69 6e 3a 3a 46 6f 63 75 73 DialogWin::Focus
3790: 42 75 74 74 6f 6e 20 6e 75 6d 3e 32 22 0a 09 72 Button num>2"..r
37a0: 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 eturn. }.
37b0: 66 6f 72 65 61 63 68 20 69 20 5b 77 69 6e 66 6f foreach i [winfo
37c0: 20 63 68 69 6c 64 72 65 6e 20 24 77 2e 62 75 74 children $w.but
37d0: 73 5d 20 7b 0a 09 69 66 20 7b 20 5b 72 65 67 65 s] {..if { [rege
37e0: 78 70 20 22 5c 5c 6d 24 6e 75 6d 5c 5c 4d 22 20 xp "\\m$num\\M"
37f0: 5b 24 69 20 63 67 65 74 20 2d 63 6f 6d 6d 61 6e [$i cget -comman
3800: 64 5d 5d 20 7d 20 7b 0a 09 20 20 20 20 66 6f 63 d]] } {.. foc
3810: 75 73 20 24 69 0a 09 20 20 20 20 72 65 74 75 72 us $i.. retur
3820: 6e 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 57 n..}. }. W
3830: 61 72 6e 57 69 6e 20 22 44 69 61 6c 6f 67 57 69 arnWin "DialogWi
3840: 6e 3a 3a 46 6f 63 75 73 42 75 74 74 6f 6e 20 6e n::FocusButton n
3850: 75 6d 20 62 61 64 22 0a 7d 0a 0a 70 72 6f 63 20 um bad".}..proc
3860: 44 69 61 6c 6f 67 57 69 6e 3a 3a 43 72 65 61 74 DialogWin::Creat
3870: 65 57 69 6e 64 6f 77 20 7b 20 7b 20 67 65 6f 6d eWindow { { geom
3880: 20 22 22 20 7d 20 7b 20 6d 69 6e 77 69 64 74 68 "" } { minwidth
3890: 20 22 22 20 7d 20 7b 20 6d 69 6e 68 65 69 67 68 "" } { minheigh
38a0: 74 20 22 22 20 7d 20 7d 20 7b 0a 20 20 20 20 43 t "" } } {. C
38b0: 72 65 61 74 65 57 69 6e 64 6f 77 4e 6f 57 61 69 reateWindowNoWai
38c0: 74 20 24 67 65 6f 6d 20 24 6d 69 6e 77 69 64 74 t $geom $minwidt
38d0: 68 20 24 6d 69 6e 68 65 69 67 68 74 0a 20 20 20 h $minheight.
38e0: 20 72 65 74 75 72 6e 20 5b 57 61 69 74 46 6f 72 return [WaitFor
38f0: 57 69 6e 64 6f 77 20 30 5d 0a 7d 0a 0a 70 72 6f Window 0].}..pro
3900: 63 20 44 69 61 6c 6f 67 57 69 6e 3a 3a 43 72 65 c DialogWin::Cre
3910: 61 74 65 57 69 6e 64 6f 77 4e 6f 57 61 69 74 20 ateWindowNoWait
3920: 7b 20 7b 20 67 65 6f 6d 20 22 22 20 7d 20 7b 20 { { geom "" } {
3930: 6d 69 6e 77 69 64 74 68 20 22 22 20 7d 20 7b 20 minwidth "" } {
3940: 6d 69 6e 68 65 69 67 68 74 20 22 22 20 7d 20 7d minheight "" } }
3950: 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 {. variable
3960: 77 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 67 w. variable g
3970: 72 61 62 0a 20 20 20 20 76 61 72 69 61 62 6c 65 rab. variable
3980: 20 6f 6c 64 47 72 61 62 0a 20 20 20 20 76 61 72 oldGrab. var
3990: 69 61 62 6c 65 20 67 72 61 62 53 74 61 74 75 73 iable grabStatus
39a0: 0a 0a 20 20 20 20 73 65 74 20 74 6f 70 20 5b 77 .. set top [w
39b0: 69 6e 66 6f 20 74 6f 70 6c 65 76 65 6c 20 5b 77 info toplevel [w
39c0: 69 6e 66 6f 20 70 61 72 65 6e 74 20 24 77 5d 5d info parent $w]]
39d0: 0a 0a 20 20 20 20 77 6d 20 77 69 74 68 64 72 61 .. wm withdra
39e0: 77 20 24 77 0a 20 20 20 20 75 70 64 61 74 65 20 w $w. update
39f0: 69 64 6c 65 74 61 73 6b 73 0a 0a 20 20 20 20 69 idletasks.. i
3a00: 66 20 7b 20 24 67 65 6f 6d 20 21 3d 20 22 22 20 f { $geom != ""
3a10: 7d 20 7b 0a 09 77 6d 20 67 65 6f 6d 20 24 77 20 } {..wm geom $w
3a20: 24 67 65 6f 6d 0a 20 20 20 20 7d 20 65 6c 73 65 $geom. } else
3a30: 20 7b 0a 09 69 66 20 7b 20 24 6d 69 6e 77 69 64 {..if { $minwid
3a40: 74 68 20 21 3d 20 22 22 20 26 26 20 5b 77 69 6e th != "" && [win
3a50: 66 6f 20 72 65 71 77 69 64 74 68 20 24 77 5d 20 fo reqwidth $w]
3a60: 3c 20 24 6d 69 6e 77 69 64 74 68 20 7d 20 7b 0a < $minwidth } {.
3a70: 09 20 20 20 20 73 65 74 20 77 69 64 74 68 20 24 . set width $
3a80: 6d 69 6e 77 69 64 74 68 0a 09 7d 20 65 6c 73 65 minwidth..} else
3a90: 20 7b 20 73 65 74 20 77 69 64 74 68 20 5b 77 69 { set width [wi
3aa0: 6e 66 6f 20 72 65 71 77 69 64 74 68 20 24 77 5d nfo reqwidth $w]
3ab0: 20 7d 0a 09 69 66 20 7b 20 24 6d 69 6e 68 65 69 }..if { $minhei
3ac0: 67 68 74 20 21 3d 20 22 22 20 26 26 20 5b 77 69 ght != "" && [wi
3ad0: 6e 66 6f 20 72 65 71 68 65 69 67 68 74 20 24 77 nfo reqheight $w
3ae0: 5d 20 3c 20 24 6d 69 6e 68 65 69 67 68 74 20 7d ] < $minheight }
3af0: 20 7b 0a 09 20 20 20 20 73 65 74 20 68 65 69 67 {.. set heig
3b00: 68 74 20 24 6d 69 6e 68 65 69 67 68 74 0a 09 7d ht $minheight..}
3b10: 20 65 6c 73 65 20 7b 20 73 65 74 20 68 65 69 67 else { set heig
3b20: 68 74 20 5b 77 69 6e 66 6f 20 72 65 71 68 65 69 ht [winfo reqhei
3b30: 67 68 74 20 24 77 5d 20 7d 0a 0a 09 69 66 20 7b ght $w] }...if {
3b40: 20 5b 77 6d 20 73 74 61 74 65 20 24 74 6f 70 5d [wm state $top]
3b50: 20 3d 3d 20 22 77 69 74 68 64 72 61 77 6e 22 20 == "withdrawn"
3b60: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 5b } {.. set x [
3b70: 65 78 70 72 20 5b 77 69 6e 66 6f 20 73 63 72 65 expr [winfo scre
3b80: 65 6e 77 69 64 74 68 20 24 74 6f 70 5d 2f 32 2d enwidth $top]/2-
3b90: 24 77 69 64 74 68 2f 32 5d 0a 09 20 20 20 20 73 $width/2].. s
3ba0: 65 74 20 79 20 5b 65 78 70 72 20 5b 77 69 6e 66 et y [expr [winf
3bb0: 6f 20 73 63 72 65 65 6e 68 65 69 67 68 74 20 24 o screenheight $
3bc0: 74 6f 70 5d 2f 32 2d 24 68 65 69 67 68 74 2f 32 top]/2-$height/2
3bd0: 5d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 ]..} else {..
3be0: 20 73 65 74 20 78 20 5b 65 78 70 72 20 5b 77 69 set x [expr [wi
3bf0: 6e 66 6f 20 78 20 24 74 6f 70 5d 2b 5b 77 69 6e nfo x $top]+[win
3c00: 66 6f 20 77 69 64 74 68 20 24 74 6f 70 5d 2f 32 fo width $top]/2
3c10: 2d 24 77 69 64 74 68 2f 32 5d 0a 09 20 20 20 20 -$width/2]..
3c20: 73 65 74 20 79 20 5b 65 78 70 72 20 5b 77 69 6e set y [expr [win
3c30: 66 6f 20 79 20 24 74 6f 70 5d 2b 5b 77 69 6e 66 fo y $top]+[winf
3c40: 6f 20 68 65 69 67 68 74 20 24 74 6f 70 5d 2f 32 o height $top]/2
3c50: 2d 24 68 65 69 67 68 74 2f 32 5d 0a 09 7d 0a 09 -$height/2]..}..
3c60: 69 66 20 7b 20 24 78 20 3c 20 30 20 7d 20 7b 20 if { $x < 0 } {
3c70: 73 65 74 20 78 20 30 20 7d 0a 09 69 66 20 7b 20 set x 0 }..if {
3c80: 24 79 20 3c 20 30 20 7d 20 7b 20 73 65 74 20 79 $y < 0 } { set y
3c90: 20 30 20 7d 0a 0a 09 77 6d 20 67 65 6f 6d 20 24 0 }...wm geom $
3ca0: 77 20 24 7b 77 69 64 74 68 7d 78 24 7b 68 65 69 w ${width}x${hei
3cb0: 67 68 74 7d 2b 24 7b 78 7d 2b 24 79 0a 20 20 20 ght}+${x}+$y.
3cc0: 20 7d 0a 20 20 20 20 77 6d 20 64 65 69 63 6f 6e }. wm deicon
3cd0: 69 66 79 20 24 77 0a 20 20 20 20 75 70 64 61 74 ify $w. updat
3ce0: 65 20 69 64 6c 65 74 61 73 6b 73 0a 20 20 20 20 e idletasks.
3cf0: 77 6d 20 67 65 6f 6d 20 24 77 20 5b 77 6d 20 67 wm geom $w [wm g
3d00: 65 6f 6d 20 24 77 5d 0a 20 20 20 20 66 6f 63 75 eom $w]. focu
3d10: 73 20 24 77 0a 20 20 20 20 73 65 74 20 6f 6c 64 s $w. set old
3d20: 47 72 61 62 20 5b 67 72 61 62 20 63 75 72 72 65 Grab [grab curre
3d30: 6e 74 20 2e 5d 0a 20 20 20 20 69 66 20 7b 5b 73 nt .]. if {[s
3d40: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 24 6f tring compare $o
3d50: 6c 64 47 72 61 62 20 22 22 5d 7d 20 7b 0a 09 73 ldGrab ""]} {..s
3d60: 65 74 20 67 72 61 62 53 74 61 74 75 73 20 5b 67 et grabStatus [g
3d70: 72 61 62 20 73 74 61 74 75 73 20 24 6f 6c 64 47 rab status $oldG
3d80: 72 61 62 5d 0a 09 67 72 61 62 20 72 65 6c 65 61 rab]..grab relea
3d90: 73 65 20 24 6f 6c 64 47 72 61 62 0a 20 20 20 20 se $oldGrab.
3da0: 7d 0a 20 20 20 20 69 66 20 7b 20 24 67 72 61 62 }. if { $grab
3db0: 20 7d 20 7b 20 67 72 61 62 20 24 77 20 7d 0a 7d } { grab $w }.}
3dc0: 0a 0a 70 72 6f 63 20 44 69 61 6c 6f 67 57 69 6e ..proc DialogWin
3dd0: 3a 3a 57 61 69 74 46 6f 72 57 69 6e 64 6f 77 20 ::WaitForWindow
3de0: 7b 20 7b 20 72 61 69 73 65 20 22 22 20 7d 20 7d { { raise "" } }
3df0: 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 {. variable
3e00: 61 63 74 69 6f 6e 0a 20 20 20 20 76 61 72 69 61 action. varia
3e10: 62 6c 65 20 77 0a 0a 20 20 20 20 69 66 20 7b 20 ble w.. if {
3e20: 24 72 61 69 73 65 20 3d 3d 20 22 22 20 7d 20 7b $raise == "" } {
3e30: 0a 09 23 20 74 68 69 73 20 69 73 20 74 6f 20 61 ..# this is to a
3e40: 76 6f 69 64 20 74 68 65 20 32 20 73 65 63 6f 6e void the 2 secon
3e50: 64 20 70 72 6f 62 6c 65 6d 20 69 6e 20 4b 44 45 d problem in KDE
3e60: 20 32 0a 09 69 66 20 7b 20 24 3a 3a 74 63 6c 5f 2..if { $::tcl_
3e70: 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 platform(platfor
3e80: 6d 29 20 3d 3d 20 22 77 69 6e 64 6f 77 73 22 20 m) == "windows"
3e90: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 72 61 69 } {.. set rai
3ea0: 73 65 20 31 0a 09 7d 20 65 6c 73 65 20 7b 20 73 se 1..} else { s
3eb0: 65 74 20 72 61 69 73 65 20 30 20 7d 0a 20 20 20 et raise 0 }.
3ec0: 20 7d 0a 20 20 20 20 69 66 20 7b 20 24 72 61 69 }. if { $rai
3ed0: 73 65 20 7d 20 7b 0a 09 72 61 69 73 65 20 5b 77 se } {..raise [w
3ee0: 69 6e 66 6f 20 74 6f 70 6c 65 76 65 6c 20 24 77 info toplevel $w
3ef0: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 76 77 61 69 ]. }. vwai
3f00: 74 20 5b 6e 61 6d 65 73 70 61 63 65 20 77 68 69 t [namespace whi
3f10: 63 68 20 2d 76 61 72 69 61 62 6c 65 20 61 63 74 ch -variable act
3f20: 69 6f 6e 5d 0a 20 20 20 20 72 65 74 75 72 6e 20 ion]. return
3f30: 24 61 63 74 69 6f 6e 0a 7d 0a 0a 70 72 6f 63 20 $action.}..proc
3f40: 44 69 61 6c 6f 67 57 69 6e 3a 3a 44 65 73 74 72 DialogWin::Destr
3f50: 6f 79 57 69 6e 64 6f 77 20 7b 7d 20 7b 0a 20 20 oyWindow {} {.
3f60: 20 20 76 61 72 69 61 62 6c 65 20 77 0a 20 20 20 variable w.
3f70: 20 76 61 72 69 61 62 6c 65 20 6f 6c 64 47 72 61 variable oldGra
3f80: 62 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 67 b. variable g
3f90: 72 61 62 53 74 61 74 75 73 0a 0a 20 20 20 20 69 rabStatus.. i
3fa0: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
3fb0: 72 65 20 24 6f 6c 64 47 72 61 62 20 22 22 5d 7d re $oldGrab ""]}
3fc0: 20 7b 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 {..if {[string
3fd0: 63 6f 6d 70 61 72 65 20 24 67 72 61 62 53 74 61 compare $grabSta
3fe0: 74 75 73 20 22 67 6c 6f 62 61 6c 22 5d 7d 20 7b tus "global"]} {
3ff0: 0a 09 20 20 20 20 69 66 20 7b 20 5b 77 69 6e 66 .. if { [winf
4000: 6f 20 65 78 69 73 74 73 20 24 6f 6c 64 47 72 61 o exists $oldGra
4010: 62 5d 20 26 26 20 5b 77 69 6e 66 6f 20 69 73 6d b] && [winfo ism
4020: 61 70 70 65 64 20 24 6f 6c 64 47 72 61 62 5d 20 apped $oldGrab]
4030: 7d 20 7b 20 67 72 61 62 20 24 6f 6c 64 47 72 61 } { grab $oldGra
4040: 62 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 b }..} else {..
4050: 20 20 20 69 66 20 7b 20 5b 77 69 6e 66 6f 20 65 if { [winfo e
4060: 78 69 73 74 73 20 24 6f 6c 64 47 72 61 62 5d 20 xists $oldGrab]
4070: 26 26 20 5b 77 69 6e 66 6f 20 69 73 6d 61 70 70 && [winfo ismapp
4080: 65 64 20 24 6f 6c 64 47 72 61 62 5d 20 7d 20 7b ed $oldGrab] } {
4090: 20 67 72 61 62 20 2d 67 6c 6f 62 61 6c 20 24 6f grab -global $o
40a0: 6c 64 47 72 61 62 20 7d 0a 09 7d 0a 20 20 20 20 ldGrab }..}.
40b0: 7d 0a 20 20 20 20 64 65 73 74 72 6f 79 20 24 77 }. destroy $w
40c0: 0a 20 20 20 20 73 65 74 20 77 20 22 22 0a 7d 0a . set w "".}.
40d0: 0a 23 20 4e 4f 54 45 3a 20 69 6e 69 74 69 61 6c .# NOTE: initial
40e0: 20 76 61 6c 75 65 20 6f 66 20 76 61 72 69 61 62 value of variab
40f0: 6c 65 73 20 69 73 20 6e 6f 74 20 74 72 61 6e 73 les is not trans
4100: 66 65 72 72 65 64 0a 70 72 6f 63 20 43 6f 70 79 ferred.proc Copy
4110: 4e 61 6d 65 73 70 61 63 65 20 7b 20 6e 66 72 6f Namespace { nfro
4120: 6d 20 6e 74 6f 20 7d 20 7b 0a 0a 20 20 20 20 73 m nto } {.. s
4130: 65 74 20 63 6f 6d 6d 20 22 6e 61 6d 65 73 70 61 et comm "namespa
4140: 63 65 20 65 76 61 6c 20 24 6e 74 6f 20 7b 5c 6e ce eval $nto {\n
4150: 22 0a 20 20 20 20 66 6f 72 65 61 63 68 20 69 20 ". foreach i
4160: 5b 69 6e 66 6f 20 76 61 72 73 20 24 7b 6e 66 72 [info vars ${nfr
4170: 6f 6d 7d 3a 3a 2a 5d 20 7b 0a 09 61 70 70 65 6e om}::*] {..appen
4180: 64 20 63 6f 6d 6d 20 22 76 61 72 69 61 62 6c 65 d comm "variable
4190: 20 5b 6e 61 6d 65 73 70 61 63 65 20 74 61 69 6c [namespace tail
41a0: 20 24 69 5d 5c 6e 22 0a 20 20 20 20 7d 0a 20 20 $i]\n". }.
41b0: 20 20 66 6f 72 65 61 63 68 20 69 20 5b 69 6e 66 foreach i [inf
41c0: 6f 20 63 6f 6d 6d 61 6e 64 73 20 24 7b 6e 66 72 o commands ${nfr
41d0: 6f 6d 7d 3a 3a 2a 5d 20 7b 0a 09 73 65 74 20 61 om}::*] {..set a
41e0: 72 67 73 20 22 22 0a 09 66 6f 72 65 61 63 68 20 rgs ""..foreach
41f0: 6a 20 5b 69 6e 66 6f 20 61 72 67 73 20 24 69 5d j [info args $i]
4200: 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 5b 69 6e {.. if { [in
4210: 66 6f 20 64 65 66 61 75 6c 74 20 24 69 20 24 6a fo default $i $j
4220: 20 6b 6b 5d 20 7d 20 7b 0a 09 09 6c 61 70 70 65 kk] } {...lappe
4230: 6e 64 20 61 72 67 73 20 5b 6c 69 73 74 20 24 6a nd args [list $j
4240: 20 24 6b 6b 5d 0a 09 20 20 20 20 7d 20 65 6c 73 $kk].. } els
4250: 65 20 7b 0a 09 09 6c 61 70 70 65 6e 64 20 61 72 e {...lappend ar
4260: 67 73 20 24 6a 0a 09 20 20 20 20 7d 0a 09 7d 0a gs $j.. }..}.
4270: 09 61 70 70 65 6e 64 20 63 6f 6d 6d 20 22 70 72 .append comm "pr
4280: 6f 63 20 5b 6e 61 6d 65 73 70 61 63 65 20 74 61 oc [namespace ta
4290: 69 6c 20 24 69 5d 20 7b 20 24 61 72 67 73 20 7d il $i] { $args }
42a0: 20 7b 5c 6e 5b 69 6e 66 6f 20 62 6f 64 79 20 24 {\n[info body $
42b0: 69 5d 5c 6e 7d 5c 6e 22 0a 20 20 20 20 7d 0a 0a i]\n}\n". }..
42c0: 20 20 20 20 61 70 70 65 6e 64 20 63 6f 6d 6d 20 append comm
42d0: 22 7d 22 0a 20 20 20 20 65 76 61 6c 20 24 63 6f "}". eval $co
42e0: 6d 6d 0a 7d 0a 0a 6e 61 6d 65 73 70 61 63 65 20 mm.}..namespace
42f0: 65 76 61 6c 20 44 69 61 6c 6f 67 57 69 6e 54 6f eval DialogWinTo
4300: 70 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 p {. variable
4310: 20 75 73 65 72 0a 20 20 20 20 76 61 72 69 61 62 user. variab
4320: 6c 65 20 6e 61 6d 65 70 72 65 66 69 78 20 5f 5f le nameprefix __
4330: 0a 7d 0a 0a 70 72 6f 63 20 44 69 61 6c 6f 67 57 .}..proc DialogW
4340: 69 6e 54 6f 70 3a 3a 53 65 74 4e 61 6d 65 50 72 inTop::SetNamePr
4350: 65 66 69 78 20 7b 20 70 72 65 66 69 78 20 7d 20 efix { prefix }
4360: 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 6e {. variable n
4370: 61 6d 65 70 72 65 66 69 78 20 24 70 72 65 66 69 ameprefix $prefi
4380: 78 0a 7d 0a 0a 23 20 63 6f 6d 6d 61 6e 64 20 66 x.}..# command f
4390: 6f 72 20 4f 4b 20 69 73 20 66 69 72 73 74 3b 20 or OK is first;
43a0: 66 6f 72 20 63 61 6e 63 65 6c 20 69 73 20 6c 61 for cancel is la
43b0: 73 74 0a 70 72 6f 63 20 44 69 61 6c 6f 67 57 69 st.proc DialogWi
43c0: 6e 54 6f 70 3a 3a 49 6e 69 74 20 7b 20 77 69 6e nTop::Init { win
43d0: 70 61 72 65 6e 74 20 74 69 74 6c 65 20 73 74 79 parent title sty
43e0: 6c 65 20 63 6f 6d 6d 61 6e 64 73 20 7b 20 6d 6f le commands { mo
43f0: 72 65 62 75 74 74 6f 6e 73 20 22 22 20 7d 20 7b rebuttons "" } {
4400: 20 4f 4b 6e 61 6d 65 20 22 22 20 7d 20 5c 0a 20 OKname "" } \.
4410: 20 20 20 7b 20 43 61 6e 63 65 6c 6e 61 6d 65 20 { Cancelname
4420: 22 22 20 7d 20 7d 20 7b 0a 20 20 20 20 76 61 72 "" } } {. var
4430: 69 61 62 6c 65 20 6e 61 6d 65 70 72 65 66 69 78 iable nameprefix
4440: 0a 0a 20 20 20 20 69 66 20 7b 20 24 77 69 6e 70 .. if { $winp
4450: 61 72 65 6e 74 20 3d 3d 20 22 2e 22 20 7d 20 7b arent == "." } {
4460: 20 73 65 74 20 77 69 6e 70 61 72 65 6e 74 20 22 set winparent "
4470: 22 20 7d 0a 20 20 20 20 73 65 74 20 77 20 24 77 " }. set w $w
4480: 69 6e 70 61 72 65 6e 74 2e 24 7b 6e 61 6d 65 70 inparent.${namep
4490: 72 65 66 69 78 7d 64 69 61 6c 6f 67 77 69 6e 74 refix}dialogwint
44a0: 6f 70 0a 20 20 20 20 73 65 74 20 69 20 30 0a 20 op. set i 0.
44b0: 20 20 20 77 68 69 6c 65 20 7b 20 5b 77 69 6e 66 while { [winf
44c0: 6f 20 65 78 69 73 74 73 20 24 77 5d 20 7d 20 7b o exists $w] } {
44d0: 0a 09 69 6e 63 72 20 69 0a 09 73 65 74 20 77 20 ..incr i..set w
44e0: 24 77 69 6e 70 61 72 65 6e 74 2e 24 7b 6e 61 6d $winparent.${nam
44f0: 65 70 72 65 66 69 78 7d 64 69 61 6c 6f 67 77 69 eprefix}dialogwi
4500: 6e 74 6f 70 24 69 0a 20 20 20 20 7d 0a 20 20 20 ntop$i. }.
4510: 20 74 6f 70 6c 65 76 65 6c 20 24 77 0a 20 20 20 toplevel $w.
4520: 20 69 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 6c 61 if { $::tcl_pla
4530: 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 tform(platform)
4540: 3d 3d 20 22 77 69 6e 64 6f 77 73 22 20 7d 20 7b == "windows" } {
4550: 0a 09 77 6d 20 61 74 74 72 69 62 75 74 65 73 20 ..wm attributes
4560: 24 77 20 2d 74 6f 6f 6c 77 69 6e 64 6f 77 20 31 $w -toolwindow 1
4570: 0a 20 20 20 20 7d 0a 20 20 20 20 77 6d 20 74 69 . }. wm ti
4580: 74 6c 65 20 24 77 20 24 74 69 74 6c 65 0a 0a 20 tle $w $title..
4590: 20 20 20 73 77 69 74 63 68 20 24 73 74 79 6c 65 switch $style
45a0: 20 7b 0a 09 72 69 64 67 65 66 72 61 6d 65 20 7b {..ridgeframe {
45b0: 0a 09 20 20 20 20 66 72 61 6d 65 20 24 77 2e 66 .. frame $w.f
45c0: 20 2d 72 65 6c 69 65 66 20 72 69 64 67 65 20 2d -relief ridge -
45d0: 62 64 20 32 0a 09 20 20 20 20 66 72 61 6d 65 20 bd 2.. frame
45e0: 24 77 2e 62 75 74 73 0a 09 20 20 20 20 67 72 69 $w.buts.. gri
45f0: 64 20 24 77 2e 66 20 2d 73 74 69 63 6b 79 20 65 d $w.f -sticky e
4600: 77 6e 73 20 2d 70 61 64 78 20 32 20 2d 70 61 64 wns -padx 2 -pad
4610: 79 20 32 0a 09 20 20 20 20 67 72 69 64 20 24 77 y 2.. grid $w
4620: 2e 62 75 74 73 20 2d 73 74 69 63 6b 79 20 65 77 .buts -sticky ew
4630: 0a 09 20 20 20 20 69 66 20 7b 20 24 3a 3a 74 63 .. if { $::tc
4640: 6c 5f 76 65 72 73 69 6f 6e 20 3e 3d 20 38 2e 35 l_version >= 8.5
4650: 20 7d 20 7b 20 67 72 69 64 20 61 6e 63 68 6f 72 } { grid anchor
4660: 20 24 77 2e 62 75 74 73 20 63 65 6e 74 65 72 20 $w.buts center
4670: 7d 0a 09 7d 0a 09 73 65 70 61 72 61 74 6f 72 20 }..}..separator
4680: 7b 0a 09 20 20 20 20 66 72 61 6d 65 20 24 77 2e {.. frame $w.
4690: 66 20 2d 62 64 20 30 0a 09 20 20 20 20 66 72 61 f -bd 0.. fra
46a0: 6d 65 20 24 77 2e 73 65 70 20 2d 62 64 20 32 20 me $w.sep -bd 2
46b0: 2d 72 65 6c 69 65 66 20 72 61 69 73 65 64 20 2d -relief raised -
46c0: 68 65 69 67 68 74 20 32 0a 09 20 20 20 20 66 72 height 2.. fr
46d0: 61 6d 65 20 24 77 2e 62 75 74 73 0a 09 20 20 20 ame $w.buts..
46e0: 20 67 72 69 64 20 24 77 2e 66 20 2d 73 74 69 63 grid $w.f -stic
46f0: 6b 79 20 65 77 6e 73 20 2d 70 61 64 78 20 32 20 ky ewns -padx 2
4700: 2d 70 61 64 79 20 32 0a 09 20 20 20 20 67 72 69 -pady 2.. gri
4710: 64 20 24 77 2e 73 65 70 20 2d 73 74 69 63 6b 79 d $w.sep -sticky
4720: 20 65 77 0a 09 20 20 20 20 67 72 69 64 20 24 77 ew.. grid $w
4730: 2e 62 75 74 73 20 2d 73 74 69 63 6b 79 20 65 77 .buts -sticky ew
4740: 0a 09 20 20 20 20 69 66 20 7b 20 24 3a 3a 74 63 .. if { $::tc
4750: 6c 5f 76 65 72 73 69 6f 6e 20 3e 3d 20 38 2e 35 l_version >= 8.5
4760: 20 7d 20 7b 20 67 72 69 64 20 61 6e 63 68 6f 72 } { grid anchor
4770: 20 24 77 2e 62 75 74 73 20 63 65 6e 74 65 72 20 $w.buts center
4780: 7d 0a 09 7d 0a 09 64 65 66 61 75 6c 74 20 7b 0a }..}..default {.
4790: 09 20 20 20 20 65 72 72 6f 72 20 22 65 72 72 6f . error "erro
47a0: 72 3a 20 6f 6e 6c 79 20 61 63 63 65 70 74 65 64 r: only accepted
47b0: 20 73 74 79 6c 65 73 20 72 69 64 67 65 66 72 61 styles ridgefra
47c0: 6d 65 20 61 6e 64 20 73 65 70 61 72 61 74 6f 72 me and separator
47d0: 22 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 "..}. }..
47e0: 24 77 2e 62 75 74 73 20 63 6f 6e 66 20 2d 62 67 $w.buts conf -bg
47f0: 20 5b 43 43 43 6f 6c 6f 72 41 63 74 69 76 6f 20 [CCColorActivo
4800: 5b 24 77 20 20 63 67 65 74 20 2d 62 67 5d 5d 0a [$w cget -bg]].
4810: 0a 20 20 20 20 69 66 20 7b 20 24 4f 4b 6e 61 6d . if { $OKnam
4820: 65 20 3d 3d 20 22 22 20 7d 20 7b 0a 09 73 65 74 e == "" } {..set
4830: 20 4f 4b 6e 61 6d 65 20 5b 5f 20 4f 4b 5d 0a 20 OKname [_ OK].
4840: 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 20 24 43 }. if { $C
4850: 61 6e 63 65 6c 6e 61 6d 65 20 21 3d 20 22 22 20 ancelname != ""
4860: 7d 20 7b 0a 09 73 65 74 20 43 61 6e 63 65 6c 4e } {..set CancelN
4870: 61 6d 65 20 24 43 61 6e 63 65 6c 6e 61 6d 65 0a ame $Cancelname.
4880: 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 20 24 } elseif { $
4890: 4f 4b 6e 61 6d 65 20 3d 3d 20 22 2d 22 20 7d 20 OKname == "-" }
48a0: 7b 0a 09 73 65 74 20 43 61 6e 63 65 6c 4e 61 6d {..set CancelNam
48b0: 65 20 5b 5f 20 43 6c 6f 73 65 5d 0a 20 20 20 20 e [_ Close].
48c0: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 43 61 } else {..set Ca
48d0: 6e 63 65 6c 4e 61 6d 65 20 5b 5f 20 43 61 6e 63 ncelName [_ Canc
48e0: 65 6c 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 el]. }.. s
48f0: 65 74 20 62 75 74 77 69 64 74 68 20 37 0a 20 20 et butwidth 7.
4900: 20 20 69 66 20 7b 20 5b 73 74 72 69 6e 67 20 6c if { [string l
4910: 65 6e 67 74 68 20 24 4f 4b 6e 61 6d 65 5d 20 3e ength $OKname] >
4920: 20 24 62 75 74 77 69 64 74 68 20 7d 20 7b 20 73 $butwidth } { s
4930: 65 74 20 62 75 74 77 69 64 74 68 20 5b 73 74 72 et butwidth [str
4940: 69 6e 67 20 6c 65 6e 67 74 68 20 24 4f 4b 6e 61 ing length $OKna
4950: 6d 65 5d 20 7d 0a 20 20 20 20 69 66 20 7b 20 5b me] }. if { [
4960: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 43 string length $C
4970: 61 6e 63 65 6c 4e 61 6d 65 5d 20 3e 20 24 62 75 ancelName] > $bu
4980: 74 77 69 64 74 68 20 7d 20 7b 20 73 65 74 20 62 twidth } { set b
4990: 75 74 77 69 64 74 68 20 5b 73 74 72 69 6e 67 20 utwidth [string
49a0: 6c 65 6e 67 74 68 20 24 43 61 6e 63 65 6c 4e 61 length $CancelNa
49b0: 6d 65 5d 20 7d 0a 20 20 20 20 66 6f 72 65 61 63 me] }. foreac
49c0: 68 20 69 20 24 6d 6f 72 65 62 75 74 74 6f 6e 73 h i $morebuttons
49d0: 20 7b 0a 09 69 66 20 7b 20 5b 73 74 72 69 6e 67 {..if { [string
49e0: 20 6c 65 6e 67 74 68 20 24 69 5d 20 3e 20 24 62 length $i] > $b
49f0: 75 74 77 69 64 74 68 20 7d 20 7b 20 73 65 74 20 utwidth } { set
4a00: 62 75 74 77 69 64 74 68 20 5b 73 74 72 69 6e 67 butwidth [string
4a10: 20 6c 65 6e 67 74 68 20 24 69 5d 20 7d 0a 20 20 length $i] }.
4a20: 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 75 73 65 }.. set use
4a30: 64 6c 65 74 74 65 72 73 20 5b 6c 69 73 74 20 5b dletters [list [
4a40: 73 74 72 69 6e 67 20 74 6f 6c 6f 77 65 72 20 5b string tolower [
4a50: 73 74 72 69 6e 67 20 69 6e 64 65 78 20 24 4f 4b string index $OK
4a60: 6e 61 6d 65 20 30 5d 5d 5d 0a 20 20 20 20 69 66 name 0]]]. if
4a70: 20 7b 20 5b 73 74 72 69 6e 67 20 74 6f 6c 6f 77 { [string tolow
4a80: 65 72 20 5b 73 74 72 69 6e 67 20 69 6e 64 65 78 er [string index
4a90: 20 24 43 61 6e 63 65 6c 4e 61 6d 65 20 30 5d 5d $CancelName 0]]
4aa0: 20 21 3d 20 24 75 73 65 64 6c 65 74 74 65 72 73 != $usedletters
4ab0: 20 7d 20 7b 0a 09 6c 61 70 70 65 6e 64 20 75 73 } {..lappend us
4ac0: 65 64 6c 65 74 74 65 72 73 20 5b 73 74 72 69 6e edletters [strin
4ad0: 67 20 74 6f 6c 6f 77 65 72 20 5b 73 74 72 69 6e g tolower [strin
4ae0: 67 20 69 6e 64 65 78 20 24 43 61 6e 63 65 6c 4e g index $CancelN
4af0: 61 6d 65 20 30 5d 5d 0a 09 73 65 74 20 75 6e 64 ame 0]]..set und
4b00: 65 72 6c 69 6e 65 63 61 6e 63 65 6c 20 30 0a 20 erlinecancel 0.
4b10: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 6c 61 70 } else {..lap
4b20: 70 65 6e 64 20 75 73 65 64 6c 65 74 74 65 72 73 pend usedletters
4b30: 20 5b 73 74 72 69 6e 67 20 74 6f 6c 6f 77 65 72 [string tolower
4b40: 20 5b 73 74 72 69 6e 67 20 69 6e 64 65 78 20 24 [string index $
4b50: 43 61 6e 63 65 6c 4e 61 6d 65 20 31 5d 5d 0a 09 CancelName 1]]..
4b60: 73 65 74 20 75 6e 64 65 72 6c 69 6e 65 63 61 6e set underlinecan
4b70: 63 65 6c 20 31 0a 20 20 20 20 7d 0a 0a 20 20 20 cel 1. }..
4b80: 20 73 65 74 20 69 63 6f 6d 6d 20 30 0a 20 20 20 set icomm 0.
4b90: 20 69 66 20 7b 20 24 4f 4b 6e 61 6d 65 20 21 3d if { $OKname !=
4ba0: 20 22 2d 22 20 7d 20 7b 0a 09 62 75 74 74 6f 6e "-" } {..button
4bb0: 20 24 77 2e 62 75 74 73 2e 6f 6b 20 2d 74 65 78 $w.buts.ok -tex
4bc0: 74 20 24 4f 4b 6e 61 6d 65 20 2d 77 69 64 74 68 t $OKname -width
4bd0: 20 24 62 75 74 77 69 64 74 68 20 2d 75 6e 64 20 $butwidth -und
4be0: 30 20 2d 63 6f 6d 6d 61 6e 64 20 5c 0a 09 20 20 0 -command \..
4bf0: 20 20 22 5b 6c 69 6e 64 65 78 20 24 63 6f 6d 6d "[lindex $comm
4c00: 61 6e 64 73 20 30 5d 20 24 77 2e 66 22 0a 09 69 ands 0] $w.f"..i
4c10: 6e 63 72 20 69 63 6f 6d 6d 0a 20 20 20 20 7d 0a ncr icomm. }.
4c20: 20 20 20 20 73 65 74 20 6c 65 74 74 65 72 62 69 set letterbi
4c30: 6e 64 69 6e 67 73 20 22 22 0a 20 20 20 20 73 65 ndings "". se
4c40: 74 20 74 6f 67 72 69 64 20 22 22 0a 20 20 20 20 t togrid "".
4c50: 69 66 20 7b 20 24 6d 6f 72 65 62 75 74 74 6f 6e if { $morebutton
4c60: 73 20 21 3d 20 22 22 20 7d 20 7b 0a 09 66 6f 72 s != "" } {..for
4c70: 65 61 63 68 20 69 20 24 6d 6f 72 65 62 75 74 74 each i $morebutt
4c80: 6f 6e 73 20 7b 0a 09 20 20 20 20 66 6f 72 20 7b ons {.. for {
4c90: 20 73 65 74 20 69 70 6f 73 20 30 20 7d 20 7b 20 set ipos 0 } {
4ca0: 24 69 70 6f 73 20 3c 20 5b 73 74 72 69 6e 67 20 $ipos < [string
4cb0: 6c 65 6e 67 74 68 20 24 69 5d 20 7d 20 7b 20 69 length $i] } { i
4cc0: 6e 63 72 20 69 70 6f 73 20 7d 20 7b 0a 09 09 73 ncr ipos } {...s
4cd0: 65 74 20 6c 65 74 74 65 72 20 5b 73 74 72 69 6e et letter [strin
4ce0: 67 20 74 6f 6c 6f 77 65 72 20 5b 73 74 72 69 6e g tolower [strin
4cf0: 67 20 69 6e 64 65 78 20 24 69 20 24 69 70 6f 73 g index $i $ipos
4d00: 5d 5d 0a 09 09 69 66 20 7b 20 5b 72 65 67 65 78 ]]...if { [regex
4d10: 70 20 7b 5b 61 2d 7a 41 2d 5a 5d 7d 20 24 6c 65 p {[a-zA-Z]} $le
4d20: 74 74 65 72 5d 20 26 26 20 5b 6c 73 65 61 72 63 tter] && [lsearc
4d30: 68 20 24 75 73 65 64 6c 65 74 74 65 72 73 20 24 h $usedletters $
4d40: 6c 65 74 74 65 72 5d 20 3d 3d 20 2d 31 20 7d 20 letter] == -1 }
4d50: 7b 0a 09 09 20 20 20 20 62 72 65 61 6b 0a 09 09 {... break...
4d60: 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 }.. }.. if
4d70: 20 7b 20 24 69 70 6f 73 20 3c 20 5b 73 74 72 69 { $ipos < [stri
4d80: 6e 67 20 6c 65 6e 67 74 68 20 24 69 5d 20 7d 20 ng length $i] }
4d90: 7b 0a 09 09 62 75 74 74 6f 6e 20 24 77 2e 62 75 {...button $w.bu
4da0: 74 73 2e 62 24 69 63 6f 6d 6d 20 2d 74 65 78 74 ts.b$icomm -text
4db0: 20 24 69 20 2d 77 69 64 74 68 20 24 62 75 74 77 $i -width $butw
4dc0: 69 64 74 68 20 2d 75 6e 64 20 24 69 70 6f 73 20 idth -und $ipos
4dd0: 5c 0a 09 09 20 20 20 20 20 20 20 20 2d 63 6f 6d \... -com
4de0: 6d 61 6e 64 20 22 5b 6c 69 6e 64 65 78 20 24 63 mand "[lindex $c
4df0: 6f 6d 6d 61 6e 64 73 20 24 69 63 6f 6d 6d 5d 20 ommands $icomm]
4e00: 24 77 2e 66 22 0a 09 09 73 65 74 20 6c 65 74 74 $w.f"...set lett
4e10: 65 72 20 5b 73 74 72 69 6e 67 20 74 6f 6c 6f 77 er [string tolow
4e20: 65 72 20 5b 73 74 72 69 6e 67 20 69 6e 64 65 78 er [string index
4e30: 20 24 69 20 24 69 70 6f 73 5d 5d 0a 09 09 62 69 $i $ipos]]...bi
4e40: 6e 64 20 24 77 20 3c 41 6c 74 2d 24 6c 65 74 74 nd $w <Alt-$lett
4e50: 65 72 3e 20 22 74 6b 42 75 74 74 6f 6e 49 6e 76 er> "tkButtonInv
4e60: 6f 6b 65 20 24 77 2e 62 75 74 73 2e 62 24 69 63 oke $w.buts.b$ic
4e70: 6f 6d 6d 22 0a 09 09 6c 61 70 70 65 6e 64 20 6c omm"...lappend l
4e80: 65 74 74 65 72 62 69 6e 64 69 6e 67 73 20 24 6c etterbindings $l
4e90: 65 74 74 65 72 20 22 74 6b 42 75 74 74 6f 6e 49 etter "tkButtonI
4ea0: 6e 76 6f 6b 65 20 24 77 2e 62 75 74 73 2e 62 24 nvoke $w.buts.b$
4eb0: 69 63 6f 6d 6d 22 0a 09 09 62 69 6e 64 20 24 77 icomm"...bind $w
4ec0: 2e 62 75 74 73 2e 62 24 69 63 6f 6d 6d 20 3c 52 .buts.b$icomm <R
4ed0: 65 74 75 72 6e 3e 20 22 74 6b 42 75 74 74 6f 6e eturn> "tkButton
4ee0: 49 6e 76 6f 6b 65 20 24 77 2e 62 75 74 73 2e 62 Invoke $w.buts.b
4ef0: 24 69 63 6f 6d 6d 22 0a 09 09 6c 61 70 70 65 6e $icomm"...lappen
4f00: 64 20 75 73 65 64 6c 65 74 74 65 72 73 20 5b 73 d usedletters [s
4f10: 74 72 69 6e 67 20 74 6f 6c 6f 77 65 72 20 5b 73 tring tolower [s
4f20: 74 72 69 6e 67 20 69 6e 64 65 78 20 24 69 20 24 tring index $i $
4f30: 69 70 6f 73 5d 5d 0a 09 20 20 20 20 7d 20 65 6c ipos]].. } el
4f40: 73 65 20 7b 0a 09 09 62 75 74 74 6f 6e 20 24 77 se {...button $w
4f50: 2e 62 75 74 73 2e 62 24 69 63 6f 6d 6d 20 2d 74 .buts.b$icomm -t
4f60: 65 78 74 20 24 69 20 2d 77 69 64 74 68 20 24 62 ext $i -width $b
4f70: 75 74 77 69 64 74 68 20 20 5c 0a 09 09 20 20 20 utwidth \...
4f80: 20 20 20 20 20 2d 63 6f 6d 6d 61 6e 64 20 22 5b -command "[
4f90: 6c 69 6e 64 65 78 20 24 63 6f 6d 6d 61 6e 64 73 lindex $commands
4fa0: 20 24 69 63 6f 6d 6d 5d 20 24 77 2e 66 22 0a 09 $icomm] $w.f"..
4fb0: 20 20 20 20 7d 0a 09 20 20 20 20 6c 61 70 70 65 }.. lappe
4fc0: 6e 64 20 74 6f 67 72 69 64 20 24 77 2e 62 75 74 nd togrid $w.but
4fd0: 73 2e 62 24 69 63 6f 6d 6d 0a 09 20 20 20 20 69 s.b$icomm.. i
4fe0: 6e 63 72 20 69 63 6f 6d 6d 0a 09 7d 0a 20 20 20 ncr icomm..}.
4ff0: 20 7d 0a 20 20 20 20 69 66 20 7b 20 24 43 61 6e }. if { $Can
5000: 63 65 6c 6e 61 6d 65 20 21 3d 20 22 2d 22 20 7d celname != "-" }
5010: 20 7b 0a 09 62 75 74 74 6f 6e 20 24 77 2e 62 75 {..button $w.bu
5020: 74 73 2e 63 61 6e 63 65 6c 20 2d 74 65 78 74 20 ts.cancel -text
5030: 24 43 61 6e 63 65 6c 4e 61 6d 65 20 2d 77 69 64 $CancelName -wid
5040: 74 68 20 24 62 75 74 77 69 64 74 68 20 2d 75 6e th $butwidth -un
5050: 64 20 24 75 6e 64 65 72 6c 69 6e 65 63 61 6e 63 d $underlinecanc
5060: 65 6c 20 2d 63 6f 6d 6d 61 6e 64 20 5c 0a 09 20 el -command \..
5070: 20 20 20 22 5b 6c 69 6e 64 65 78 20 24 63 6f 6d "[lindex $com
5080: 6d 61 6e 64 73 20 24 69 63 6f 6d 6d 5d 20 24 77 mands $icomm] $w
5090: 2e 66 22 0a 20 20 20 20 7d 0a 20 20 20 20 20 69 .f". }. i
50a0: 66 20 7b 20 24 4f 4b 6e 61 6d 65 20 21 3d 20 22 f { $OKname != "
50b0: 2d 22 20 7d 20 7b 0a 09 73 65 74 20 74 6f 67 72 -" } {..set togr
50c0: 69 64 20 22 24 77 2e 62 75 74 73 2e 6f 6b 20 24 id "$w.buts.ok $
50d0: 74 6f 67 72 69 64 22 0a 20 20 20 20 7d 0a 20 20 togrid". }.
50e0: 20 20 69 66 20 7b 20 24 43 61 6e 63 65 6c 6e 61 if { $Cancelna
50f0: 6d 65 20 21 3d 20 22 2d 22 20 7d 20 7b 0a 09 73 me != "-" } {..s
5100: 65 74 20 74 6f 67 72 69 64 20 22 24 74 6f 67 72 et togrid "$togr
5110: 69 64 20 24 77 2e 62 75 74 73 2e 63 61 6e 63 65 id $w.buts.cance
5120: 6c 22 0a 20 20 20 20 7d 0a 20 20 20 20 65 76 61 l". }. eva
5130: 6c 20 67 72 69 64 20 24 74 6f 67 72 69 64 20 2d l grid $togrid -
5140: 70 61 64 78 20 32 20 2d 70 61 64 79 20 34 0a 0a padx 2 -pady 4..
5150: 0a 20 20 20 20 69 66 20 7b 20 24 4f 4b 6e 61 6d . if { $OKnam
5160: 65 20 21 3d 20 22 2d 22 20 7d 20 7b 0a 09 62 69 e != "-" } {..bi
5170: 6e 64 20 24 77 2e 62 75 74 73 2e 6f 6b 20 3c 52 nd $w.buts.ok <R
5180: 65 74 75 72 6e 3e 20 22 74 6b 42 75 74 74 6f 6e eturn> "tkButton
5190: 49 6e 76 6f 6b 65 20 24 77 2e 62 75 74 73 2e 6f Invoke $w.buts.o
51a0: 6b 22 0a 09 73 65 74 20 6c 65 74 74 65 72 20 5b k"..set letter [
51b0: 73 74 72 69 6e 67 20 74 6f 6c 6f 77 65 72 20 5b string tolower [
51c0: 73 74 72 69 6e 67 20 69 6e 64 65 78 20 24 4f 4b string index $OK
51d0: 6e 61 6d 65 20 30 5d 5d 0a 09 63 61 74 63 68 20 name 0]]..catch
51e0: 7b 0a 09 20 20 20 20 62 69 6e 64 20 24 77 20 3c {.. bind $w <
51f0: 41 6c 74 2d 24 6c 65 74 74 65 72 3e 20 22 74 6b Alt-$letter> "tk
5200: 42 75 74 74 6f 6e 49 6e 76 6f 6b 65 20 24 77 2e ButtonInvoke $w.
5210: 62 75 74 73 2e 6f 6b 22 0a 09 20 20 20 20 6c 61 buts.ok".. la
5220: 70 70 65 6e 64 20 6c 65 74 74 65 72 62 69 6e 64 ppend letterbind
5230: 69 6e 67 73 20 24 6c 65 74 74 65 72 20 22 74 6b ings $letter "tk
5240: 42 75 74 74 6f 6e 49 6e 76 6f 6b 65 20 24 77 2e ButtonInvoke $w.
5250: 62 75 74 73 2e 6f 6b 22 0a 09 7d 0a 09 66 6f 63 buts.ok"..}..foc
5260: 75 73 20 24 77 2e 62 75 74 73 2e 6f 6b 0a 20 20 us $w.buts.ok.
5270: 20 20 7d 20 65 6c 73 65 69 66 20 7b 20 24 43 61 } elseif { $Ca
5280: 6e 63 65 6c 6e 61 6d 65 20 21 3d 20 22 2d 22 20 ncelname != "-"
5290: 7d 20 7b 0a 09 66 6f 63 75 73 20 24 77 2e 62 75 } {..focus $w.bu
52a0: 74 73 2e 63 61 6e 63 65 6c 0a 20 20 20 20 7d 0a ts.cancel. }.
52b0: 0a 20 20 20 20 69 66 20 7b 20 24 43 61 6e 63 65 . if { $Cance
52c0: 6c 6e 61 6d 65 20 21 3d 20 22 2d 22 20 7d 20 7b lname != "-" } {
52d0: 0a 09 62 69 6e 64 20 24 77 20 3c 45 73 63 61 70 ..bind $w <Escap
52e0: 65 3e 20 22 74 6b 42 75 74 74 6f 6e 49 6e 76 6f e> "tkButtonInvo
52f0: 6b 65 20 24 77 2e 62 75 74 73 2e 63 61 6e 63 65 ke $w.buts.cance
5300: 6c 22 0a 09 62 69 6e 64 20 24 77 2e 62 75 74 73 l"..bind $w.buts
5310: 2e 63 61 6e 63 65 6c 20 3c 52 65 74 75 72 6e 3e .cancel <Return>
5320: 20 22 74 6b 42 75 74 74 6f 6e 49 6e 76 6f 6b 65 "tkButtonInvoke
5330: 20 24 77 2e 62 75 74 73 2e 63 61 6e 63 65 6c 22 $w.buts.cancel"
5340: 0a 0a 09 73 65 74 20 6c 65 74 74 65 72 20 5b 73 ...set letter [s
5350: 74 72 69 6e 67 20 74 6f 6c 6f 77 65 72 20 5b 73 tring tolower [s
5360: 74 72 69 6e 67 20 69 6e 64 65 78 20 24 43 61 6e tring index $Can
5370: 63 65 6c 4e 61 6d 65 20 24 75 6e 64 65 72 6c 69 celName $underli
5380: 6e 65 63 61 6e 63 65 6c 5d 5d 0a 09 63 61 74 63 necancel]]..catc
5390: 68 20 7b 0a 09 20 20 20 20 62 69 6e 64 20 24 77 h {.. bind $w
53a0: 20 3c 41 6c 74 2d 24 6c 65 74 74 65 72 3e 20 22 <Alt-$letter> "
53b0: 74 6b 42 75 74 74 6f 6e 49 6e 76 6f 6b 65 20 24 tkButtonInvoke $
53c0: 77 2e 62 75 74 73 2e 63 61 6e 63 65 6c 22 0a 09 w.buts.cancel"..
53d0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 65 74 74 lappend lett
53e0: 65 72 62 69 6e 64 69 6e 67 73 20 24 6c 65 74 74 erbindings $lett
53f0: 65 72 20 22 74 6b 42 75 74 74 6f 6e 49 6e 76 6f er "tkButtonInvo
5400: 6b 65 20 24 77 2e 62 75 74 73 2e 63 61 6e 63 65 ke $w.buts.cance
5410: 6c 22 0a 09 7d 0a 09 77 6d 20 70 72 6f 74 6f 63 l"..}..wm protoc
5420: 6f 6c 20 24 77 20 57 4d 5f 44 45 4c 45 54 45 5f ol $w WM_DELETE_
5430: 57 49 4e 44 4f 57 20 22 74 6b 42 75 74 74 6f 6e WINDOW "tkButton
5440: 49 6e 76 6f 6b 65 20 24 77 2e 62 75 74 73 2e 63 Invoke $w.buts.c
5450: 61 6e 63 65 6c 22 0a 20 20 20 20 7d 20 65 6c 73 ancel". } els
5460: 65 69 66 20 7b 20 24 4f 4b 6e 61 6d 65 20 21 3d eif { $OKname !=
5470: 20 22 2d 22 20 7d 20 7b 0a 09 62 69 6e 64 20 24 "-" } {..bind $
5480: 77 20 3c 45 73 63 61 70 65 3e 20 22 74 6b 42 75 w <Escape> "tkBu
5490: 74 74 6f 6e 49 6e 76 6f 6b 65 20 24 77 2e 62 75 ttonInvoke $w.bu
54a0: 74 73 2e 6f 6b 22 0a 09 77 6d 20 70 72 6f 74 6f ts.ok"..wm proto
54b0: 63 6f 6c 20 24 77 20 57 4d 5f 44 45 4c 45 54 45 col $w WM_DELETE
54c0: 5f 57 49 4e 44 4f 57 20 22 74 6b 42 75 74 74 6f _WINDOW "tkButto
54d0: 6e 49 6e 76 6f 6b 65 20 24 77 2e 62 75 74 73 2e nInvoke $w.buts.
54e0: 6f 6b 22 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b ok". } else {
54f0: 0a 09 62 69 6e 64 20 24 77 20 3c 45 73 63 61 70 ..bind $w <Escap
5500: 65 3e 20 22 74 6b 42 75 74 74 6f 6e 49 6e 76 6f e> "tkButtonInvo
5510: 6b 65 20 24 77 2e 62 75 74 73 2e 62 30 22 0a 09 ke $w.buts.b0"..
5520: 77 6d 20 70 72 6f 74 6f 63 6f 6c 20 24 77 20 57 wm protocol $w W
5530: 4d 5f 44 45 4c 45 54 45 5f 57 49 4e 44 4f 57 20 M_DELETE_WINDOW
5540: 22 74 6b 42 75 74 74 6f 6e 49 6e 76 6f 6b 65 20 "tkButtonInvoke
5550: 24 77 2e 62 75 74 73 2e 62 30 22 0a 20 20 20 20 $w.buts.b0".
5560: 7d 0a 0a 20 20 20 20 20 62 69 6e 64 20 24 77 20 }.. bind $w
5570: 3c 44 65 73 74 72 6f 79 3e 20 7b 0a 09 20 69 66 <Destroy> {.. if
5580: 20 7b 20 5b 77 69 6e 66 6f 20 63 6c 61 73 73 20 { [winfo class
5590: 25 57 5d 20 3d 3d 20 22 54 6f 70 6c 65 76 65 6c %W] == "Toplevel
55a0: 22 20 7d 20 7b 0a 09 20 20 20 20 20 20 44 69 61 " } {.. Dia
55b0: 6c 6f 67 57 69 6e 54 6f 70 3a 3a 44 65 73 74 72 logWinTop::Destr
55c0: 6f 79 57 69 6e 64 6f 77 20 25 57 0a 09 20 7d 0a oyWindow %W.. }.
55d0: 20 20 20 20 7d 0a 0a 20 20 20 20 66 6f 72 65 61 }.. forea
55e0: 63 68 20 62 75 74 20 5b 77 69 6e 66 6f 20 63 68 ch but [winfo ch
55f0: 69 6c 64 72 65 6e 20 24 77 2e 62 75 74 73 5d 20 ildren $w.buts]
5600: 7b 0a 09 66 6f 72 65 61 63 68 20 22 6c 65 74 74 {..foreach "lett
5610: 65 72 20 63 6f 6d 6d 61 6e 64 22 20 24 6c 65 74 er command" $let
5620: 74 65 72 62 69 6e 64 69 6e 67 73 20 7b 0a 09 20 terbindings {..
5630: 20 20 20 62 69 6e 64 20 24 62 75 74 20 3c 4b 65 bind $but <Ke
5640: 79 50 72 65 73 73 2d 24 6c 65 74 74 65 72 3e 20 yPress-$letter>
5650: 24 63 6f 6d 6d 61 6e 64 0a 09 7d 0a 20 20 20 20 $command..}.
5660: 7d 0a 0a 20 20 20 20 67 72 69 64 20 63 6f 6c 75 }.. grid colu
5670: 6d 6e 63 6f 6e 66 20 24 77 20 30 20 2d 77 65 69 mnconf $w 0 -wei
5680: 67 68 74 20 31 0a 20 20 20 20 67 72 69 64 20 72 ght 1. grid r
5690: 6f 77 63 6f 6e 66 20 24 77 20 30 20 2d 77 65 69 owconf $w 0 -wei
56a0: 67 68 74 20 31 0a 0a 20 20 20 20 72 65 74 75 72 ght 1.. retur
56b0: 6e 20 24 77 2e 66 0a 7d 0a 0a 70 72 6f 63 20 44 n $w.f.}..proc D
56c0: 69 61 6c 6f 67 57 69 6e 54 6f 70 3a 3a 44 65 73 ialogWinTop::Des
56d0: 74 72 6f 79 57 69 6e 64 6f 77 20 7b 20 77 20 7d troyWindow { w }
56e0: 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 {. variable
56f0: 6f 6c 64 47 72 61 62 0a 20 20 20 20 76 61 72 69 oldGrab. vari
5700: 61 62 6c 65 20 67 72 61 62 53 74 61 74 75 73 0a able grabStatus.
5710: 20 20 20 20 76 61 72 69 61 62 6c 65 20 74 61 62 variable tab
5720: 6f 72 64 65 72 0a 0a 20 20 20 20 69 66 20 7b 20 order.. if {
5730: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 74 61 62 [info exists tab
5740: 6f 72 64 65 72 28 24 77 29 5d 20 7d 20 7b 20 75 order($w)] } { u
5750: 6e 73 65 74 20 74 61 62 6f 72 64 65 72 28 24 77 nset taborder($w
5760: 29 20 7d 0a 0a 20 20 20 20 69 66 20 7b 5b 73 74 ) }.. if {[st
5770: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 24 6f 6c ring compare $ol
5780: 64 47 72 61 62 20 22 22 5d 7d 20 7b 0a 09 69 66 dGrab ""]} {..if
5790: 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 {[string compar
57a0: 65 20 24 67 72 61 62 53 74 61 74 75 73 20 22 67 e $grabStatus "g
57b0: 6c 6f 62 61 6c 22 5d 7d 20 7b 0a 09 20 20 20 20 lobal"]} {..
57c0: 69 66 20 7b 20 5b 77 69 6e 66 6f 20 65 78 69 73 if { [winfo exis
57d0: 74 73 20 24 6f 6c 64 47 72 61 62 5d 20 26 26 20 ts $oldGrab] &&
57e0: 5b 77 69 6e 66 6f 20 69 73 6d 61 70 70 65 64 20 [winfo ismapped
57f0: 24 6f 6c 64 47 72 61 62 5d 20 7d 20 7b 20 67 72 $oldGrab] } { gr
5800: 61 62 20 24 6f 6c 64 47 72 61 62 20 7d 0a 09 7d ab $oldGrab }..}
5810: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 66 20 else {.. if
5820: 7b 20 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 { [winfo exists
5830: 24 6f 6c 64 47 72 61 62 5d 20 26 26 20 5b 77 69 $oldGrab] && [wi
5840: 6e 66 6f 20 69 73 6d 61 70 70 65 64 20 24 6f 6c nfo ismapped $ol
5850: 64 47 72 61 62 5d 20 7d 20 7b 20 67 72 61 62 20 dGrab] } { grab
5860: 2d 67 6c 6f 62 61 6c 20 24 6f 6c 64 47 72 61 62 -global $oldGrab
5870: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 }..}. }.}..p
5880: 72 6f 63 20 6c 72 65 76 65 72 73 65 20 4c 20 7b roc lreverse L {
5890: 0a 20 20 20 20 73 65 74 20 72 65 73 20 7b 7d 0a . set res {}.
58a0: 20 20 20 20 73 65 74 20 69 20 5b 6c 6c 65 6e 67 set i [lleng
58b0: 74 68 20 24 4c 5d 0a 20 20 20 20 77 68 69 6c 65 th $L]. while
58c0: 20 7b 24 69 7d 20 7b 6c 61 70 70 65 6e 64 20 72 {$i} {lappend r
58d0: 65 73 20 5b 6c 69 6e 64 65 78 20 24 4c 20 5b 69 es [lindex $L [i
58e0: 6e 63 72 20 69 20 2d 31 5d 5d 7d 0a 20 20 20 20 ncr i -1]]}.
58f0: 73 65 74 20 72 65 73 0a 20 7d 0a 0a 70 72 6f 63 set res. }..proc
5900: 20 44 69 61 6c 6f 67 57 69 6e 54 6f 70 3a 3a 54 DialogWinTop::T
5910: 61 62 4f 72 64 65 72 50 72 65 76 4e 65 78 74 20 abOrderPrevNext
5920: 7b 20 77 20 77 68 61 74 20 7d 20 7b 0a 20 20 20 { w what } {.
5930: 20 76 61 72 69 61 62 6c 65 20 74 61 62 6f 72 64 variable tabord
5940: 65 72 0a 0a 20 20 20 20 73 65 74 20 74 61 62 6f er.. set tabo
5950: 20 24 74 61 62 6f 72 64 65 72 28 5b 77 69 6e 66 $taborder([winf
5960: 6f 20 74 6f 70 6c 65 76 65 6c 20 24 77 5d 29 0a o toplevel $w]).
5970: 20 20 20 20 73 65 74 20 69 70 6f 73 20 5b 6c 73 set ipos [ls
5980: 65 61 72 63 68 20 24 74 61 62 6f 20 24 77 5d 0a earch $tabo $w].
5990: 20 20 20 20 73 65 74 20 74 61 62 6f 20 5b 63 6f set tabo [co
59a0: 6e 63 61 74 20 5b 6c 72 61 6e 67 65 20 24 74 61 ncat [lrange $ta
59b0: 62 6f 20 5b 65 78 70 72 20 7b 24 69 70 6f 73 2b bo [expr {$ipos+
59c0: 31 7d 5d 20 65 6e 64 5d 20 5b 6c 72 61 6e 67 65 1}] end] [lrange
59d0: 20 24 74 61 62 6f 20 30 20 5b 65 78 70 72 20 7b $tabo 0 [expr {
59e0: 24 69 70 6f 73 2d 31 7d 5d 5d 5d 0a 20 20 20 20 $ipos-1}]]].
59f0: 69 66 20 7b 20 24 77 68 61 74 20 65 71 20 22 70 if { $what eq "p
5a00: 72 65 76 22 20 7d 20 7b 20 73 65 74 20 74 61 62 rev" } { set tab
5a10: 6f 20 5b 6c 72 65 76 65 72 73 65 20 24 74 61 62 o [lreverse $tab
5a20: 6f 5d 20 7d 0a 0a 20 20 20 20 66 6f 72 65 61 63 o] }.. foreac
5a30: 68 20 77 20 24 74 61 62 6f 20 7b 0a 09 69 66 20 h w $tabo {..if
5a40: 7b 20 5b 74 6b 3a 3a 46 6f 63 75 73 4f 4b 20 24 { [tk::FocusOK $
5a50: 77 5d 20 7d 20 7b 0a 09 20 20 20 20 74 6b 3a 3a w] } {.. tk::
5a60: 54 61 62 54 6f 57 69 6e 64 6f 77 20 24 77 0a 09 TabToWindow $w..
5a70: 20 20 20 20 72 65 74 75 72 6e 0a 09 7d 0a 20 20 return..}.
5a80: 20 20 7d 0a 20 20 20 20 72 65 74 75 72 6e 0a 7d }. return.}
5a90: 0a 0a 70 72 6f 63 20 44 69 61 6c 6f 67 57 69 6e ..proc DialogWin
5aa0: 54 6f 70 3a 3a 53 65 74 54 61 62 4f 72 64 65 72 Top::SetTabOrder
5ab0: 20 7b 20 77 69 6e 6c 69 73 74 20 7d 20 7b 0a 20 { winlist } {.
5ac0: 20 20 20 76 61 72 69 61 62 6c 65 20 74 61 62 6f variable tabo
5ad0: 72 64 65 72 0a 0a 20 20 20 20 73 65 74 20 74 6f rder.. set to
5ae0: 70 20 5b 77 69 6e 66 6f 20 74 6f 70 6c 65 76 65 p [winfo topleve
5af0: 6c 20 5b 6c 69 6e 64 65 78 20 24 77 69 6e 6c 69 l [lindex $winli
5b00: 73 74 20 30 5d 5d 0a 20 20 20 20 73 65 74 20 74 st 0]]. set t
5b10: 61 62 6f 72 64 65 72 28 24 74 6f 70 29 20 24 77 aborder($top) $w
5b20: 69 6e 6c 69 73 74 0a 0a 20 20 20 20 66 6f 72 65 inlist.. fore
5b30: 61 63 68 20 77 20 24 77 69 6e 6c 69 73 74 20 7b ach w $winlist {
5b40: 0a 09 62 69 6e 64 20 24 77 20 3c 54 61 62 3e 20 ..bind $w <Tab>
5b50: 22 44 69 61 6c 6f 67 57 69 6e 54 6f 70 3a 3a 54 "DialogWinTop::T
5b60: 61 62 4f 72 64 65 72 50 72 65 76 4e 65 78 74 20 abOrderPrevNext
5b70: 24 77 20 6e 65 78 74 3b 20 62 72 65 61 6b 22 0a $w next; break".
5b80: 09 62 69 6e 64 20 24 77 20 3c 3c 50 72 65 76 57 .bind $w <<PrevW
5b90: 69 6e 64 6f 77 3e 3e 20 22 44 69 61 6c 6f 67 57 indow>> "DialogW
5ba0: 69 6e 54 6f 70 3a 3a 54 61 62 4f 72 64 65 72 50 inTop::TabOrderP
5bb0: 72 65 76 4e 65 78 74 20 24 77 20 70 72 65 76 3b revNext $w prev;
5bc0: 20 62 72 65 61 6b 22 0a 20 20 20 20 7d 0a 7d 0a break". }.}.
5bd0: 0a 70 72 6f 63 20 44 69 61 6c 6f 67 57 69 6e 54 .proc DialogWinT
5be0: 6f 70 3a 3a 49 6e 76 6f 6b 65 4f 4b 20 7b 20 66 op::InvokeOK { f
5bf0: 20 7d 20 7b 0a 0a 20 20 20 20 69 66 20 7b 20 21 } {.. if { !
5c00: 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 24 66 [winfo exists $f
5c10: 5d 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a 0a ] } { return }..
5c20: 20 20 20 20 73 65 74 20 77 20 5b 77 69 6e 66 6f set w [winfo
5c30: 20 74 6f 70 6c 65 76 65 6c 20 24 66 5d 0a 20 20 toplevel $f].
5c40: 20 20 74 6b 42 75 74 74 6f 6e 49 6e 76 6f 6b 65 tkButtonInvoke
5c50: 20 24 77 2e 62 75 74 73 2e 6f 6b 0a 7d 0a 0a 70 $w.buts.ok.}..p
5c60: 72 6f 63 20 44 69 61 6c 6f 67 57 69 6e 54 6f 70 roc DialogWinTop
5c70: 3a 3a 49 6e 76 6f 6b 65 43 61 6e 63 65 6c 20 7b ::InvokeCancel {
5c80: 20 66 20 7b 20 76 69 73 69 62 6c 65 20 31 20 7d f { visible 1 }
5c90: 20 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c } {. variabl
5ca0: 65 20 77 0a 0a 20 20 20 20 69 66 20 7b 20 21 5b e w.. if { ![
5cb0: 77 69 6e 66 6f 20 65 78 69 73 74 73 20 24 66 5d winfo exists $f]
5cc0: 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a 0a 20 } { return }..
5cd0: 20 20 20 73 65 74 20 77 20 5b 77 69 6e 66 6f 20 set w [winfo
5ce0: 74 6f 70 6c 65 76 65 6c 20 24 66 5d 0a 20 20 20 toplevel $f].
5cf0: 20 69 66 20 7b 20 24 76 69 73 69 62 6c 65 20 7d if { $visible }
5d00: 20 7b 0a 09 74 6b 42 75 74 74 6f 6e 49 6e 76 6f {..tkButtonInvo
5d10: 6b 65 20 24 77 2e 62 75 74 73 2e 63 61 6e 63 65 ke $w.buts.cance
5d20: 6c 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 l. } else {..
5d30: 24 77 2e 62 75 74 73 2e 63 61 6e 63 65 6c 20 69 $w.buts.cancel i
5d40: 6e 76 6f 6b 65 0a 20 20 20 20 7d 0a 7d 0a 0a 70 nvoke. }.}..p
5d50: 72 6f 63 20 44 69 61 6c 6f 67 57 69 6e 54 6f 70 roc DialogWinTop
5d60: 3a 3a 49 6e 76 6f 6b 65 42 75 74 74 6f 6e 20 7b ::InvokeButton {
5d70: 20 66 20 6e 75 6d 20 7b 20 76 69 73 69 62 6c 65 f num { visible
5d80: 20 31 20 7d 20 7d 20 7b 0a 0a 20 20 20 20 69 66 1 } } {.. if
5d90: 20 7b 20 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 { ![winfo exist
5da0: 73 20 24 66 5d 20 7d 20 7b 20 72 65 74 75 72 6e s $f] } { return
5db0: 20 7d 0a 0a 20 20 20 20 73 65 74 20 77 20 5b 77 }.. set w [w
5dc0: 69 6e 66 6f 20 74 6f 70 6c 65 76 65 6c 20 24 66 info toplevel $f
5dd0: 5d 0a 20 20 20 20 69 66 20 7b 20 24 6e 75 6d 20 ]. if { $num
5de0: 3c 20 32 20 7d 20 7b 0a 09 57 61 72 6e 57 69 6e < 2 } {..WarnWin
5df0: 20 22 44 69 61 6c 6f 67 57 69 6e 54 6f 70 3a 3a "DialogWinTop::
5e00: 49 6e 76 6f 6b 65 42 75 74 74 6f 6e 20 6e 75 6d InvokeButton num
5e10: 3e 32 22 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 >2"..return.
5e20: 7d 0a 20 20 20 20 69 66 20 7b 20 24 76 69 73 69 }. if { $visi
5e30: 62 6c 65 20 7d 20 7b 0a 09 74 6b 42 75 74 74 6f ble } {..tkButto
5e40: 6e 49 6e 76 6f 6b 65 20 24 77 2e 62 75 74 73 2e nInvoke $w.buts.
5e50: 62 5b 65 78 70 72 20 24 6e 75 6d 2d 31 5d 0a 20 b[expr $num-1].
5e60: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 24 77 2e } else {..$w.
5e70: 62 75 74 73 2e 62 5b 65 78 70 72 20 24 6e 75 6d buts.b[expr $num
5e80: 2d 31 5d 20 69 6e 76 6f 6b 65 0a 20 20 20 20 7d -1] invoke. }
5e90: 0a 7d 0a 0a 70 72 6f 63 20 44 69 61 6c 6f 67 57 .}..proc DialogW
5ea0: 69 6e 54 6f 70 3a 3a 46 6f 63 75 73 42 75 74 74 inTop::FocusButt
5eb0: 6f 6e 20 7b 20 66 20 6e 75 6d 20 7d 20 7b 0a 0a on { f num } {..
5ec0: 20 20 20 20 73 65 74 20 77 20 5b 77 69 6e 66 6f set w [winfo
5ed0: 20 74 6f 70 6c 65 76 65 6c 20 24 66 5d 0a 20 20 toplevel $f].
5ee0: 20 20 69 66 20 7b 20 24 6e 75 6d 20 3c 20 32 20 if { $num < 2
5ef0: 7d 20 7b 0a 09 57 61 72 6e 57 69 6e 20 22 44 69 } {..WarnWin "Di
5f00: 61 6c 6f 67 57 69 6e 54 6f 70 3a 3a 46 6f 63 75 alogWinTop::Focu
5f10: 73 42 75 74 74 6f 6e 20 6e 75 6d 3e 32 22 0a 09 sButton num>2"..
5f20: 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 return. }.
5f30: 20 66 6f 72 65 61 63 68 20 69 20 5b 77 69 6e 66 foreach i [winf
5f40: 6f 20 63 68 69 6c 64 72 65 6e 20 24 77 2e 62 75 o children $w.bu
5f50: 74 73 5d 20 7b 0a 09 69 66 20 7b 20 5b 72 65 67 ts] {..if { [reg
5f60: 65 78 70 20 22 5c 5c 6d 24 6e 75 6d 5c 5c 4d 22 exp "\\m$num\\M"
5f70: 20 5b 24 69 20 63 67 65 74 20 2d 63 6f 6d 6d 61 [$i cget -comma
5f80: 6e 64 5d 5d 20 7d 20 7b 0a 09 20 20 20 20 66 6f nd]] } {.. fo
5f90: 63 75 73 20 24 69 0a 09 20 20 20 20 72 65 74 75 cus $i.. retu
5fa0: 72 6e 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 rn..}. }.
5fb0: 57 61 72 6e 57 69 6e 20 22 44 69 61 6c 6f 67 57 WarnWin "DialogW
5fc0: 69 6e 54 6f 70 3a 3a 46 6f 63 75 73 42 75 74 74 inTop::FocusButt
5fd0: 6f 6e 20 6e 75 6d 20 62 61 64 22 0a 7d 0a 0a 23 on num bad".}..#
5fe0: 20 77 68 61 74 3d 20 30 20 64 69 73 61 62 6c 65 what= 0 disable
5ff0: 20 3b 20 3d 31 20 65 6e 61 62 6c 65 0a 70 72 6f ; =1 enable.pro
6000: 63 20 44 69 61 6c 6f 67 57 69 6e 54 6f 70 3a 3a c DialogWinTop::
6010: 45 6e 61 62 6c 65 44 69 73 61 62 6c 65 42 75 74 EnableDisableBut
6020: 74 6f 6e 20 7b 20 66 20 6e 61 6d 65 20 77 68 61 ton { f name wha
6030: 74 20 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 62 t } {. variab
6040: 6c 65 20 77 0a 0a 20 20 20 20 73 65 74 20 77 20 le w.. set w
6050: 5b 77 69 6e 66 6f 20 74 6f 70 6c 65 76 65 6c 20 [winfo toplevel
6060: 24 66 5d 0a 20 20 20 20 66 6f 72 65 61 63 68 20 $f]. foreach
6070: 69 20 5b 77 69 6e 66 6f 20 63 68 69 6c 64 72 65 i [winfo childre
6080: 6e 20 24 77 2e 62 75 74 73 5d 20 7b 0a 09 69 66 n $w.buts] {..if
6090: 20 7b 20 24 6e 61 6d 65 20 3d 3d 20 5b 24 69 20 { $name == [$i
60a0: 63 67 65 74 20 2d 74 65 78 74 5d 20 7d 20 7b 0a cget -text] } {.
60b0: 09 20 20 20 20 73 77 69 74 63 68 20 24 77 68 61 . switch $wha
60c0: 74 20 7b 0a 09 09 31 20 7b 20 24 69 20 63 6f 6e t {...1 { $i con
60d0: 66 20 2d 73 74 61 74 65 20 6e 6f 72 6d 61 6c 20 f -state normal
60e0: 7d 0a 09 09 30 20 7b 20 24 69 20 63 6f 6e 66 20 }...0 { $i conf
60f0: 2d 73 74 61 74 65 20 64 69 73 61 62 6c 65 64 20 -state disabled
6100: 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 72 65 }.. }.. re
6110: 74 75 72 6e 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 turn..}. }.
6120: 20 20 57 61 72 6e 57 69 6e 20 22 44 69 61 6c 6f WarnWin "Dialo
6130: 67 57 69 6e 3a 3a 45 6e 61 62 6c 65 44 69 73 61 gWin::EnableDisa
6140: 62 6c 65 42 75 74 74 6f 6e 20 6e 61 6d 65 20 62 bleButton name b
6150: 61 64 22 0a 7d 0a 0a 70 72 6f 63 20 44 69 61 6c ad".}..proc Dial
6160: 6f 67 57 69 6e 54 6f 70 3a 3a 43 72 65 61 74 65 ogWinTop::Create
6170: 57 69 6e 64 6f 77 20 7b 20 66 20 7b 20 67 65 6f Window { f { geo
6180: 6d 20 22 22 20 7d 20 7b 20 6d 69 6e 77 69 64 74 m "" } { minwidt
6190: 68 20 22 22 20 7d 20 7b 20 6d 69 6e 68 65 69 67 h "" } { minheig
61a0: 68 74 20 22 22 20 7d 20 7b 20 67 72 61 62 20 30 ht "" } { grab 0
61b0: 20 7d 20 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 } } {. varia
61c0: 62 6c 65 20 6f 6c 64 47 72 61 62 0a 20 20 20 20 ble oldGrab.
61d0: 76 61 72 69 61 62 6c 65 20 67 72 61 62 53 74 61 variable grabSta
61e0: 74 75 73 0a 0a 0a 20 20 20 20 73 65 74 20 77 20 tus... set w
61f0: 5b 77 69 6e 66 6f 20 70 61 72 65 6e 74 20 24 66 [winfo parent $f
6200: 5d 0a 20 20 20 20 73 65 74 20 74 6f 70 20 5b 77 ]. set top [w
6210: 69 6e 66 6f 20 74 6f 70 6c 65 76 65 6c 20 5b 77 info toplevel [w
6220: 69 6e 66 6f 20 70 61 72 65 6e 74 20 24 77 5d 5d info parent $w]]
6230: 0a 0a 20 20 20 20 77 6d 20 77 69 74 68 64 72 61 .. wm withdra
6240: 77 20 24 77 0a 20 20 20 20 75 70 64 61 74 65 20 w $w. update
6250: 69 64 6c 65 74 61 73 6b 73 0a 0a 20 20 20 20 69 idletasks.. i
6260: 66 20 7b 20 24 67 65 6f 6d 20 21 3d 20 22 22 20 f { $geom != ""
6270: 7d 20 7b 0a 09 77 6d 20 67 65 6f 6d 20 24 77 20 } {..wm geom $w
6280: 24 67 65 6f 6d 0a 20 20 20 20 7d 20 65 6c 73 65 $geom. } else
6290: 20 7b 0a 09 69 66 20 7b 20 24 6d 69 6e 77 69 64 {..if { $minwid
62a0: 74 68 20 21 3d 20 22 22 20 26 26 20 5b 77 69 6e th != "" && [win
62b0: 66 6f 20 72 65 71 77 69 64 74 68 20 24 77 5d 20 fo reqwidth $w]
62c0: 3c 20 24 6d 69 6e 77 69 64 74 68 20 7d 20 7b 0a < $minwidth } {.
62d0: 09 20 20 20 20 73 65 74 20 77 69 64 74 68 20 24 . set width $
62e0: 6d 69 6e 77 69 64 74 68 0a 09 7d 20 65 6c 73 65 minwidth..} else
62f0: 20 7b 20 73 65 74 20 77 69 64 74 68 20 5b 77 69 { set width [wi
6300: 6e 66 6f 20 72 65 71 77 69 64 74 68 20 24 77 5d nfo reqwidth $w]
6310: 20 7d 0a 09 69 66 20 7b 20 24 6d 69 6e 68 65 69 }..if { $minhei
6320: 67 68 74 20 21 3d 20 22 22 20 26 26 20 5b 77 69 ght != "" && [wi
6330: 6e 66 6f 20 72 65 71 68 65 69 67 68 74 20 24 77 nfo reqheight $w
6340: 5d 20 3c 20 24 6d 69 6e 68 65 69 67 68 74 20 7d ] < $minheight }
6350: 20 7b 0a 09 20 20 20 20 73 65 74 20 68 65 69 67 {.. set heig
6360: 68 74 20 24 6d 69 6e 68 65 69 67 68 74 0a 09 7d ht $minheight..}
6370: 20 65 6c 73 65 20 7b 20 73 65 74 20 68 65 69 67 else { set heig
6380: 68 74 20 5b 77 69 6e 66 6f 20 72 65 71 68 65 69 ht [winfo reqhei
6390: 67 68 74 20 24 77 5d 20 7d 0a 0a 09 69 66 20 7b ght $w] }...if {
63a0: 20 5b 77 6d 20 73 74 61 74 65 20 24 74 6f 70 5d [wm state $top]
63b0: 20 3d 3d 20 22 77 69 74 68 64 72 61 77 6e 22 20 == "withdrawn"
63c0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 5b } {.. set x [
63d0: 65 78 70 72 20 5b 77 69 6e 66 6f 20 73 63 72 65 expr [winfo scre
63e0: 65 6e 77 69 64 74 68 20 24 74 6f 70 5d 2f 32 2d enwidth $top]/2-
63f0: 24 77 69 64 74 68 2f 32 5d 0a 09 20 20 20 20 73 $width/2].. s
6400: 65 74 20 79 20 5b 65 78 70 72 20 5b 77 69 6e 66 et y [expr [winf
6410: 6f 20 73 63 72 65 65 6e 68 65 69 67 68 74 20 24 o screenheight $
6420: 74 6f 70 5d 2f 32 2d 24 68 65 69 67 68 74 2f 32 top]/2-$height/2
6430: 5d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 ]..} else {..
6440: 20 73 65 74 20 78 20 5b 65 78 70 72 20 5b 77 69 set x [expr [wi
6450: 6e 66 6f 20 78 20 24 74 6f 70 5d 2b 5b 77 69 6e nfo x $top]+[win
6460: 66 6f 20 77 69 64 74 68 20 24 74 6f 70 5d 2f 32 fo width $top]/2
6470: 2d 24 77 69 64 74 68 2f 32 5d 0a 09 20 20 20 20 -$width/2]..
6480: 73 65 74 20 79 20 5b 65 78 70 72 20 5b 77 69 6e set y [expr [win
6490: 66 6f 20 79 20 24 74 6f 70 5d 2b 5b 77 69 6e 66 fo y $top]+[winf
64a0: 6f 20 68 65 69 67 68 74 20 24 74 6f 70 5d 2f 32 o height $top]/2
64b0: 2d 24 68 65 69 67 68 74 2f 32 5d 0a 09 7d 0a 09 -$height/2]..}..
64c0: 69 66 20 7b 20 24 78 20 3c 20 30 20 7d 20 7b 20 if { $x < 0 } {
64d0: 73 65 74 20 78 20 30 20 7d 0a 09 69 66 20 7b 20 set x 0 }..if {
64e0: 24 79 20 3c 20 30 20 7d 20 7b 20 73 65 74 20 79 $y < 0 } { set y
64f0: 20 30 20 7d 0a 09 77 6d 20 67 65 6f 6d 20 24 77 0 }..wm geom $w
6500: 20 24 7b 77 69 64 74 68 7d 78 24 7b 68 65 69 67 ${width}x${heig
6510: 68 74 7d 2b 24 7b 78 7d 2b 24 79 0a 20 20 20 20 ht}+${x}+$y.
6520: 7d 0a 20 20 20 20 77 6d 20 64 65 69 63 6f 6e 69 }. wm deiconi
6530: 66 79 20 24 77 0a 20 20 20 20 75 70 64 61 74 65 fy $w. update
6540: 20 69 64 6c 65 74 61 73 6b 73 0a 20 20 20 20 23 idletasks. #
6550: 77 6d 20 67 65 6f 6d 20 24 77 20 5b 77 6d 20 67 wm geom $w [wm g
6560: 65 6f 6d 20 24 77 5d 0a 20 20 20 20 69 66 20 7b eom $w]. if {
6570: 21 24 67 72 61 62 20 7d 20 7b 0a 09 73 65 74 20 !$grab } {..set
6580: 6f 6c 64 47 72 61 62 20 22 22 0a 09 73 65 74 20 oldGrab ""..set
6590: 67 72 61 62 53 74 61 74 75 73 20 22 22 0a 20 20 grabStatus "".
65a0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 } else {..set
65b0: 6f 6c 64 47 72 61 62 20 5b 67 72 61 62 20 63 75 oldGrab [grab cu
65c0: 72 72 65 6e 74 20 24 77 5d 0a 09 69 66 20 7b 5b rrent $w]..if {[
65d0: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 24 string compare $
65e0: 6f 6c 64 47 72 61 62 20 22 22 5d 7d 20 7b 0a 09 oldGrab ""]} {..
65f0: 20 20 20 20 73 65 74 20 67 72 61 62 53 74 61 74 set grabStat
6600: 75 73 20 5b 67 72 61 62 20 73 74 61 74 75 73 20 us [grab status
6610: 24 6f 6c 64 47 72 61 62 5d 0a 09 20 20 20 20 67 $oldGrab].. g
6620: 72 61 62 20 72 65 6c 65 61 73 65 20 24 6f 6c 64 rab release $old
6630: 47 72 61 62 0a 09 7d 0a 09 67 72 61 62 20 24 77 Grab..}..grab $w
6640: 0a 20 20 20 20 7d 0a 20 20 20 20 66 6f 63 75 73 . }. focus
6650: 20 24 77 0a 7d 0a 0a 23 20 70 72 6f 63 20 44 69 $w.}..# proc Di
6660: 61 6c 6f 67 57 69 6e 3a 3a 6d 65 73 73 61 67 65 alogWin::message
6670: 42 6f 78 20 7b 20 61 72 67 73 20 7d 20 7b 0a 23 Box { args } {.#
6680: 20 20 20 20 20 69 66 20 7b 20 5b 69 6e 66 6f 20 if { [info
6690: 65 78 69 73 74 73 20 44 69 61 6c 6f 67 57 69 6e exists DialogWin
66a0: 32 3a 3a 77 5d 20 7d 20 7b 0a 23 20 20 20 20 20 2::w] } {.#
66b0: 20 20 20 20 61 66 74 65 72 20 35 30 30 20 5b 6c after 500 [l
66c0: 69 73 74 20 44 69 61 6c 6f 67 57 69 6e 3a 3a 6d ist DialogWin::m
66d0: 65 73 73 61 67 65 42 6f 78 20 24 61 72 67 73 5d essageBox $args]
66e0: 0a 23 20 20 20 20 20 20 20 20 20 72 65 74 75 72 .# retur
66f0: 6e 0a 23 20 20 20 20 20 7d 0a 23 20 20 20 20 20 n.# }.#
6700: 43 6f 70 79 4e 61 6d 65 73 70 61 63 65 20 3a 3a CopyNamespace ::
6710: 44 69 61 6c 6f 67 57 69 6e 20 3a 3a 44 69 61 6c DialogWin ::Dial
6720: 6f 67 57 69 6e 32 0a 0a 23 20 20 20 20 20 61 72 ogWin2..# ar
6730: 72 61 79 20 73 65 74 20 6f 70 74 73 20 5b 6c 69 ray set opts [li
6740: 73 74 20 2d 64 65 66 61 75 6c 74 20 22 22 20 2d st -default "" -
6750: 69 63 6f 6e 20 71 75 65 73 74 69 6f 6e 2d 33 32 icon question-32
6760: 2e 70 6e 67 20 2d 6d 65 73 73 61 67 65 20 22 22 .png -message ""
6770: 20 2d 70 61 72 65 6e 74 20 2e 20 2d 74 69 74 6c -parent . -titl
6780: 65 20 22 22 20 5c 0a 23 20 20 20 20 20 20 20 20 e "" \.#
6790: 20 2d 74 79 70 65 20 6f 6b 5d 0a 0a 23 20 20 20 -type ok]..#
67a0: 20 20 66 6f 72 20 7b 20 73 65 74 20 69 20 30 20 for { set i 0
67b0: 7d 20 7b 20 24 69 20 3c 20 5b 6c 6c 65 6e 67 74 } { $i < [llengt
67c0: 68 20 24 61 72 67 73 5d 20 7d 20 7b 20 69 6e 63 h $args] } { inc
67d0: 72 20 69 20 7d 20 7b 0a 23 20 20 20 20 20 20 20 r i } {.#
67e0: 20 20 73 65 74 20 6f 70 74 20 5b 6c 69 6e 64 65 set opt [linde
67f0: 78 20 24 61 72 67 73 20 24 69 5d 0a 23 20 20 20 x $args $i].#
6800: 20 20 20 20 20 20 69 66 20 7b 20 21 5b 69 6e 66 if { ![inf
6810: 6f 20 65 78 69 73 74 73 20 6f 70 74 73 28 24 6f o exists opts($o
6820: 70 74 29 5d 20 7d 20 7b 0a 23 20 20 20 20 20 20 pt)] } {.#
6830: 20 20 20 20 20 20 20 65 72 72 6f 72 20 22 75 6e error "un
6840: 6b 6e 6f 77 6e 20 6f 70 74 69 6f 6e 20 27 24 6f known option '$o
6850: 70 74 27 20 69 6e 20 44 69 61 6c 6f 67 57 69 6e pt' in DialogWin
6860: 3a 3a 6d 65 73 73 61 67 65 42 6f 78 22 0a 23 20 ::messageBox".#
6870: 20 20 20 20 20 20 20 20 7d 0a 23 20 20 20 20 20 }.#
6880: 20 20 20 20 69 6e 63 72 20 69 0a 23 20 20 20 20 incr i.#
6890: 20 20 20 20 20 73 65 74 20 6f 70 74 73 28 24 6f set opts($o
68a0: 70 74 29 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 pt) [lindex $arg
68b0: 73 20 24 69 5d 0a 23 20 20 20 20 20 7d 0a 23 20 s $i].# }.#
68c0: 20 20 20 20 73 77 69 74 63 68 20 2d 2d 20 24 6f switch -- $o
68d0: 70 74 73 28 2d 74 79 70 65 29 20 7b 0a 23 20 20 pts(-type) {.#
68e0: 20 20 20 20 20 20 20 61 62 6f 72 74 72 65 74 72 abortretr
68f0: 79 69 67 6e 6f 72 65 20 7b 0a 23 20 20 20 20 20 yignore {.#
6900: 20 20 20 20 20 20 20 20 73 65 74 20 62 75 74 73 set buts
6910: 20 5b 6c 69 73 74 20 41 62 6f 72 74 20 52 65 74 [list Abort Ret
6920: 72 79 20 49 67 6e 6f 72 65 5d 0a 23 20 20 20 20 ry Ignore].#
6930: 20 20 20 20 20 7d 0a 23 20 20 20 20 20 20 20 20 }.#
6940: 20 6f 6b 20 7b 0a 23 20 20 20 20 20 20 20 20 20 ok {.#
6950: 20 20 20 20 73 65 74 20 62 75 74 73 20 5b 6c 69 set buts [li
6960: 73 74 20 4f 4b 5d 0a 23 20 20 20 20 20 20 20 20 st OK].#
6970: 20 7d 0a 23 20 20 20 20 20 20 20 20 20 6f 6b 63 }.# okc
6980: 61 6e 63 65 6c 20 7b 0a 23 20 20 20 20 20 20 20 ancel {.#
6990: 20 20 20 20 20 20 73 65 74 20 62 75 74 73 20 5b set buts [
69a0: 6c 69 73 74 20 4f 4b 20 43 61 6e 63 65 6c 5d 0a list OK Cancel].
69b0: 23 20 20 20 20 20 20 20 20 20 7d 0a 23 20 20 20 # }.#
69c0: 20 20 20 20 20 20 72 65 74 72 79 63 61 6e 63 65 retrycance
69d0: 6c 20 7b 0a 23 20 20 20 20 20 20 20 20 20 20 20 l {.#
69e0: 20 20 73 65 74 20 62 75 74 73 20 5b 6c 69 73 74 set buts [list
69f0: 20 52 65 74 72 79 20 43 61 6e 63 65 6c 5d 0a 23 Retry Cancel].#
6a00: 20 20 20 20 20 20 20 20 20 7d 0a 23 20 20 20 20 }.#
6a10: 20 20 20 20 20 79 65 73 6e 6f 20 7b 0a 23 20 20 yesno {.#
6a20: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 62 set b
6a30: 75 74 73 20 5b 6c 69 73 74 20 59 65 73 20 4e 6f uts [list Yes No
6a40: 5d 0a 23 20 20 20 20 20 20 20 20 20 7d 0a 23 20 ].# }.#
6a50: 20 20 20 20 20 20 20 20 79 65 73 6e 6f 63 61 6e yesnocan
6a60: 63 65 6c 20 7b 0a 23 20 20 20 20 20 20 20 20 20 cel {.#
6a70: 20 20 20 20 73 65 74 20 62 75 74 73 20 5b 6c 69 set buts [li
6a80: 73 74 20 59 65 73 20 4e 6f 20 43 61 6e 63 65 6c st Yes No Cancel
6a90: 5d 0a 23 20 20 20 20 20 20 20 20 20 7d 0a 23 20 ].# }.#
6aa0: 20 20 20 20 20 20 20 20 64 65 66 61 75 6c 74 20 default
6ab0: 7b 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 20 {.#
6ac0: 65 72 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 74 error "unknown t
6ad0: 79 70 65 3a 20 27 24 6f 70 74 73 28 2d 74 79 70 ype: '$opts(-typ
6ae0: 65 29 27 20 69 6e 20 44 69 61 6c 6f 67 57 69 6e e)' in DialogWin
6af0: 3a 3a 6d 65 73 73 61 67 65 42 6f 78 22 0a 23 20 ::messageBox".#
6b00: 20 20 20 20 20 20 20 20 7d 0a 23 20 20 20 20 20 }.#
6b10: 7d 0a 23 20 20 20 20 20 69 66 20 7b 20 24 6f 70 }.# if { $op
6b20: 74 73 28 2d 64 65 66 61 75 6c 74 29 20 3d 3d 20 ts(-default) ==
6b30: 22 22 20 7d 20 7b 0a 23 20 20 20 20 20 20 20 20 "" } {.#
6b40: 20 73 65 74 20 6f 70 74 73 28 2d 64 65 66 61 75 set opts(-defau
6b50: 6c 74 70 6f 73 29 20 30 0a 23 20 20 20 20 20 7d ltpos) 0.# }
6b60: 20 65 6c 73 65 20 7b 0a 23 20 20 20 20 20 20 20 else {.#
6b70: 20 20 73 65 74 20 6f 70 74 73 28 2d 64 65 66 61 set opts(-defa
6b80: 75 6c 74 70 6f 73 29 20 5b 6c 73 65 61 72 63 68 ultpos) [lsearch
6b90: 20 2d 72 65 67 65 78 70 20 24 62 75 74 73 20 22 -regexp $buts "
6ba0: 28 3f 69 71 29 24 6f 70 74 73 28 2d 64 65 66 61 (?iq)$opts(-defa
6bb0: 75 6c 74 29 22 5d 0a 23 20 20 20 20 20 20 20 20 ult)"].#
6bc0: 20 69 66 20 7b 20 24 6f 70 74 73 28 2d 64 65 66 if { $opts(-def
6bd0: 61 75 6c 74 70 6f 73 29 20 3d 3d 20 2d 31 20 7d aultpos) == -1 }
6be0: 20 7b 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 {.#
6bf0: 20 65 72 72 6f 72 20 22 62 61 64 20 64 65 66 61 error "bad defa
6c00: 75 6c 74 20 6f 70 74 69 6f 6e 3a 20 27 24 6f 70 ult option: '$op
6c10: 74 73 28 2d 64 65 66 61 75 6c 74 29 27 20 69 6e ts(-default)' in
6c20: 20 44 69 61 6c 6f 67 57 69 6e 3a 3a 6d 65 73 73 DialogWin::mess
6c30: 61 67 65 42 6f 78 22 0a 23 20 20 20 20 20 20 20 ageBox".#
6c40: 20 20 7d 0a 23 20 20 20 20 20 7d 0a 0a 23 20 20 }.# }..#
6c50: 20 20 20 73 65 74 20 66 20 5b 44 69 61 6c 6f 67 set f [Dialog
6c60: 57 69 6e 32 3a 3a 49 6e 69 74 20 24 6f 70 74 73 Win2::Init $opts
6c70: 28 2d 70 61 72 65 6e 74 29 20 24 6f 70 74 73 28 (-parent) $opts(
6c80: 2d 74 69 74 6c 65 29 20 73 65 70 61 72 61 74 6f -title) separato
6c90: 72 20 24 62 75 74 73 20 2d 20 2d 5d 0a 23 20 20 r $buts - -].#
6ca0: 20 20 20 73 65 74 20 77 20 5b 77 69 6e 66 6f 20 set w [winfo
6cb0: 74 6f 70 6c 65 76 65 6c 20 24 66 5d 0a 0a 23 20 toplevel $f]..#
6cc0: 20 20 20 20 6c 61 62 65 6c 20 24 66 2e 6c 31 20 label $f.l1
6cd0: 2d 69 6d 61 67 65 20 5b 47 65 74 49 6d 61 67 65 -image [GetImage
6ce0: 20 71 75 65 73 74 69 6f 6e 2d 33 32 2e 70 6e 67 question-32.png
6cf0: 5d 20 2d 67 72 69 64 20 30 0a 23 20 20 20 20 20 ] -grid 0.#
6d00: 6c 61 62 65 6c 20 24 66 2e 6d 73 67 20 2d 6a 75 label $f.msg -ju
6d10: 73 74 69 66 79 20 6c 65 66 74 20 2d 74 65 78 74 stify left -text
6d20: 20 24 6f 70 74 73 28 2d 6d 65 73 73 61 67 65 29 $opts(-message)
6d30: 20 2d 77 72 61 70 6c 65 6e 67 74 68 20 33 69 20 -wraplength 3i
6d40: 2d 67 72 69 64 20 22 31 20 70 78 35 20 70 79 35 -grid "1 px5 py5
6d50: 22 0a 0a 23 20 20 20 20 20 73 75 70 65 72 67 72 "..# supergr
6d60: 69 64 3a 3a 67 6f 20 24 66 0a 0a 23 20 20 20 20 id::go $f..#
6d70: 20 44 69 61 6c 6f 67 57 69 6e 32 3a 3a 46 6f 63 DialogWin2::Foc
6d80: 75 73 42 75 74 74 6f 6e 20 5b 65 78 70 72 20 24 usButton [expr $
6d90: 6f 70 74 73 28 2d 64 65 66 61 75 6c 74 70 6f 73 opts(-defaultpos
6da0: 29 2b 32 5d 0a 0a 23 20 20 20 20 20 73 65 74 20 )+2]..# set
6db0: 61 63 74 69 6f 6e 20 5b 44 69 61 6c 6f 67 57 69 action [DialogWi
6dc0: 6e 32 3a 3a 43 72 65 61 74 65 57 69 6e 64 6f 77 n2::CreateWindow
6dd0: 5d 0a 23 20 20 20 20 20 77 68 69 6c 65 20 31 20 ].# while 1
6de0: 7b 0a 23 20 20 20 20 20 20 20 20 20 73 77 69 74 {.# swit
6df0: 63 68 20 2d 2d 20 24 61 63 74 69 6f 6e 20 7b 0a ch -- $action {.
6e00: 23 20 20 20 20 20 20 20 20 20 20 20 20 20 2d 31 # -1
6e10: 20 7b 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 {.#
6e20: 20 20 20 20 20 69 66 20 7b 20 5b 6c 73 65 61 72 if { [lsear
6e30: 63 68 20 24 62 75 74 73 20 43 61 6e 63 65 6c 5d ch $buts Cancel]
6e40: 20 21 3d 20 2d 31 20 7d 20 7b 0a 23 20 20 20 20 != -1 } {.#
6e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e60: 20 63 61 74 63 68 20 7b 0a 23 20 20 20 20 20 20 catch {.#
6e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e80: 20 20 20 44 69 61 6c 6f 67 57 69 6e 32 3a 3a 44 DialogWin2::D
6e90: 65 73 74 72 6f 79 57 69 6e 64 6f 77 0a 23 20 20 estroyWindow.#
6ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6eb0: 20 20 20 20 20 20 20 6e 61 6d 65 73 70 61 63 65 namespace
6ec0: 20 64 65 6c 65 74 65 20 3a 3a 44 69 61 6c 6f 67 delete ::Dialog
6ed0: 57 69 6e 32 0a 23 20 20 20 20 20 20 20 20 20 20 Win2.#
6ee0: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 23 20 20 }.#
6ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f00: 20 20 20 72 65 74 75 72 6e 20 63 61 6e 63 65 6c return cancel
6f10: 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .#
6f20: 20 20 20 7d 0a 23 20 20 20 20 20 20 20 20 20 20 }.#
6f30: 20 20 20 20 20 20 20 69 66 20 7b 20 5b 6c 73 65 if { [lse
6f40: 61 72 63 68 20 24 62 75 74 73 20 4f 4b 5d 20 21 arch $buts OK] !
6f50: 3d 20 2d 31 20 7d 20 7b 0a 23 20 20 20 20 20 20 = -1 } {.#
6f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 44 D
6f70: 69 61 6c 6f 67 57 69 6e 32 3a 3a 44 65 73 74 72 ialogWin2::Destr
6f80: 6f 79 57 69 6e 64 6f 77 0a 23 20 20 20 20 20 20 oyWindow.#
6f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e n
6fa0: 61 6d 65 73 70 61 63 65 20 64 65 6c 65 74 65 20 amespace delete
6fb0: 3a 3a 44 69 61 6c 6f 67 57 69 6e 32 0a 23 20 20 ::DialogWin2.#
6fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fd0: 20 20 20 72 65 74 75 72 6e 20 6f 6b 0a 23 20 20 return ok.#
6fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 7d }
6ff0: 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 20 7d .# }
7000: 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 20 64 .# d
7010: 65 66 61 75 6c 74 20 7b 0a 23 20 20 20 20 20 20 efault {.#
7020: 20 20 20 20 20 20 20 20 20 20 20 44 69 61 6c 6f Dialo
7030: 67 57 69 6e 32 3a 3a 44 65 73 74 72 6f 79 57 69 gWin2::DestroyWi
7040: 6e 64 6f 77 0a 23 20 20 20 20 20 20 20 20 20 20 ndow.#
7050: 20 20 20 20 20 20 20 6e 61 6d 65 73 70 61 63 65 namespace
7060: 20 64 65 6c 65 74 65 20 3a 3a 44 69 61 6c 6f 67 delete ::Dialog
7070: 57 69 6e 32 0a 23 20 20 20 20 20 20 20 20 20 20 Win2.#
7080: 20 20 20 20 20 20 20 72 65 74 75 72 6e 20 5b 73 return [s
7090: 74 72 69 6e 67 20 74 6f 6c 6f 77 65 72 20 5b 6c tring tolower [l
70a0: 69 6e 64 65 78 20 24 62 75 74 73 20 5b 65 78 70 index $buts [exp
70b0: 72 20 24 61 63 74 69 6f 6e 2d 32 5d 5d 5d 0a 23 r $action-2]]].#
70c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 23 }.#
70d0: 20 20 20 20 20 20 20 20 20 7d 0a 23 20 20 20 20 }.#
70e0: 20 20 20 20 20 73 65 74 20 61 63 74 69 6f 6e 20 set action
70f0: 5b 44 69 61 6c 6f 67 57 69 6e 32 3a 3a 57 61 69 [DialogWin2::Wai
7100: 74 46 6f 72 57 69 6e 64 6f 77 5d 0a 23 20 20 20 tForWindow].#
7110: 20 20 7d 0a 23 20 7d 0a 0a 23 20 66 6f 72 20 63 }.# }..# for c
7120: 6f 6d 70 61 74 69 62 69 6c 69 74 79 0a 70 72 6f ompatibility.pro
7130: 63 20 44 69 61 6c 6f 67 57 69 6e 3a 3a 6d 65 73 c DialogWin::mes
7140: 73 61 67 65 42 6f 78 20 7b 20 61 72 67 73 20 7d sageBox { args }
7150: 20 7b 0a 20 20 20 20 23 72 65 74 75 72 6e 20 5b {. #return [
7160: 65 76 61 6c 20 44 69 61 6c 6f 67 57 69 6e 54 6f eval DialogWinTo
7170: 70 3a 3a 6d 65 73 73 61 67 65 42 6f 78 20 24 61 p::messageBox $a
7180: 72 67 73 5d 0a 20 20 20 20 72 65 74 75 72 6e 20 rgs]. return
7190: 5b 65 76 61 6c 20 73 6e 69 74 5f 6d 65 73 73 61 [eval snit_messa
71a0: 67 65 42 6f 78 20 24 61 72 67 73 5d 0a 7d 0a 0a geBox $args].}..
71b0: 70 72 6f 63 20 44 69 61 6c 6f 67 57 69 6e 54 6f proc DialogWinTo
71c0: 70 3a 3a 6d 65 73 73 61 67 65 42 6f 78 20 7b 20 p::messageBox {
71d0: 61 72 67 73 20 7d 20 7b 0a 20 20 20 20 72 65 74 args } {. ret
71e0: 75 72 6e 20 5b 65 76 61 6c 20 73 6e 69 74 5f 6d urn [eval snit_m
71f0: 65 73 73 61 67 65 42 6f 78 20 24 61 72 67 73 5d essageBox $args]
7200: 0a 7d 0a 0a 70 72 6f 63 20 4d 65 73 73 61 67 65 .}..proc Message
7210: 57 69 6e 20 7b 20 74 65 78 74 20 74 69 74 6c 65 Win { text title
7220: 20 7b 69 6d 61 67 65 20 71 75 65 73 74 69 6f 6e {image question
7230: 2d 33 32 2e 70 6e 67 7d 20 7b 70 61 72 65 6e 74 -32.png} {parent
7240: 20 2e 7d 20 7b 63 68 65 63 6b 5f 6e 6f 5f 6d 6f .} {check_no_mo
7250: 72 65 20 31 7d 7d 20 7b 0a 20 20 20 20 69 66 20 re 1}} {. if
7260: 7b 20 24 70 61 72 65 6e 74 20 65 71 20 22 2e 22 { $parent eq "."
7270: 20 7d 20 7b 20 73 65 74 20 70 61 72 65 6e 74 20 } { set parent
7280: 22 22 20 7d 0a 20 20 20 20 73 65 74 20 77 20 5b "" }. set w [
7290: 64 69 61 6c 6f 67 77 69 6e 5f 73 6e 69 74 20 24 dialogwin_snit $
72a0: 70 61 72 65 6e 74 2e 25 41 55 54 4f 25 20 2d 74 parent.%AUTO% -t
72b0: 69 74 6c 65 20 24 74 69 74 6c 65 20 2d 6f 6b 6e itle $title -okn
72c0: 61 6d 65 20 5c 0a 09 20 20 20 20 20 20 20 5b 5f ame \.. [_
72d0: 20 22 4f 6b 22 5d 20 2d 63 61 6e 63 65 6c 6e 61 "Ok"] -cancelna
72e0: 6d 65 20 22 2d 22 5d 0a 20 20 20 20 73 65 74 20 me "-"]. set
72f0: 66 20 5b 24 77 20 67 69 76 65 66 72 61 6d 65 5d f [$w giveframe]
7300: 0a 0a 20 20 20 20 74 74 6b 3a 3a 6c 61 62 65 6c .. ttk::label
7310: 20 24 66 2e 6c 31 20 2d 69 6d 61 67 65 20 5b 47 $f.l1 -image [G
7320: 65 74 49 6d 61 67 65 20 24 69 6d 61 67 65 5d 0a etImage $image].
7330: 20 20 20 20 74 74 6b 3a 3a 6c 61 62 65 6c 20 24 ttk::label $
7340: 66 2e 6d 73 67 20 2d 6a 75 73 74 69 66 79 20 6c f.msg -justify l
7350: 65 66 74 20 2d 74 65 78 74 20 24 74 65 78 74 20 eft -text $text
7360: 2d 77 72 61 70 6c 65 6e 67 74 68 20 33 69 0a 0a -wraplength 3i..
7370: 20 20 20 20 73 65 74 20 3a 3a 4d 65 73 73 61 67 set ::Messag
7380: 65 57 69 6e 5f 73 6b 69 70 5f 6d 6f 72 65 5f 77 eWin_skip_more_w
7390: 69 6e 64 6f 77 73 20 30 0a 20 20 20 20 69 66 20 indows 0. if
73a0: 7b 20 24 63 68 65 63 6b 5f 6e 6f 5f 6d 6f 72 65 { $check_no_more
73b0: 7d 20 7b 0a 09 74 74 6b 3a 3a 63 68 65 63 6b 62 } {..ttk::checkb
73c0: 75 74 74 6f 6e 20 24 66 2e 63 62 20 2d 74 65 78 utton $f.cb -tex
73d0: 74 20 5b 5f 20 22 53 6b 69 70 20 74 68 69 73 20 t [_ "Skip this
73e0: 77 69 6e 64 6f 77 22 5d 20 2d 6f 66 66 76 61 6c window"] -offval
73f0: 75 65 20 30 20 2d 6f 6e 76 61 6c 75 65 20 31 20 ue 0 -onvalue 1
7400: 5c 0a 09 20 20 20 20 2d 76 61 72 69 61 62 6c 65 \.. -variable
7410: 20 3a 3a 4d 65 73 73 61 67 65 57 69 6e 5f 73 6b ::MessageWin_sk
7420: 69 70 5f 6d 6f 72 65 5f 77 69 6e 64 6f 77 73 0a ip_more_windows.
7430: 20 20 20 20 7d 0a 0a 20 20 20 20 67 72 69 64 20 }.. grid
7440: 24 66 2e 6c 31 20 24 66 2e 6d 73 67 20 2d 73 74 $f.l1 $f.msg -st
7450: 69 63 6b 79 20 6e 77 0a 20 20 20 20 67 72 69 64 icky nw. grid
7460: 20 63 6f 6e 66 69 67 75 72 65 20 24 66 2e 6d 73 configure $f.ms
7470: 67 20 2d 70 61 64 78 20 35 20 2d 70 61 64 79 20 g -padx 5 -pady
7480: 35 0a 0a 20 20 20 20 69 66 20 7b 20 24 63 68 65 5.. if { $che
7490: 63 6b 5f 6e 6f 5f 6d 6f 72 65 7d 20 7b 0a 09 67 ck_no_more} {..g
74a0: 72 69 64 20 24 66 2e 63 62 20 2d 73 74 69 63 6b rid $f.cb -stick
74b0: 79 20 6e 77 20 2d 70 61 64 78 20 35 20 5c 0a 09 y nw -padx 5 \..
74c0: 20 20 20 20 2d 63 6f 6c 75 6d 6e 20 31 0a 09 23 -column 1..#
74d0: 20 2d 63 6f 6c 75 6d 6e 73 70 61 6e 20 32 0a 20 -columnspan 2.
74e0: 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 61 63 }.. set ac
74f0: 74 69 6f 6e 20 5b 24 77 20 63 72 65 61 74 65 77 tion [$w createw
7500: 69 6e 64 6f 77 5d 0a 20 20 20 20 64 65 73 74 72 indow]. destr
7510: 6f 79 20 24 77 0a 20 20 20 20 72 65 74 75 72 6e oy $w. return
7520: 20 24 3a 3a 4d 65 73 73 61 67 65 57 69 6e 5f 73 $::MessageWin_s
7530: 6b 69 70 5f 6d 6f 72 65 5f 77 69 6e 64 6f 77 73 kip_more_windows
7540: 0a 7d 0a 0a 70 72 6f 63 20 57 61 72 6e 57 69 6e .}..proc WarnWin
7550: 20 7b 20 74 65 78 74 20 7b 70 61 72 65 6e 74 20 { text {parent
7560: 2e 7d 20 7b 69 64 20 30 7d 20 7b 74 69 74 6c 65 .} {id 0} {title
7570: 20 22 22 7d 20 7d 20 7b 0a 20 20 20 20 23 70 75 ""} } {. #pu
7580: 74 73 20 24 3a 3a 65 72 72 6f 72 49 6e 66 6f 0a ts $::errorInfo.
7590: 20 20 20 20 23 20 57 61 72 6e 57 69 6e 54 65 78 # WarnWinTex
75a0: 74 20 22 24 69 64 3a 20 62 65 66 6f 72 65 20 4d t "$id: before M
75b0: 65 73 73 61 67 65 57 69 6e 22 0a 20 20 20 20 20 essageWin".
75c0: 20 20 0a 20 20 20 20 73 65 74 20 63 68 65 63 6b . set check
75d0: 5f 6e 6f 5f 6d 6f 72 65 20 30 0a 20 20 20 20 69 _no_more 0. i
75e0: 66 20 7b 20 24 69 64 20 21 3d 20 30 7d 20 7b 0a f { $id != 0} {.
75f0: 09 73 65 74 20 63 68 65 63 6b 5f 6e 6f 5f 6d 6f .set check_no_mo
7600: 72 65 20 31 0a 20 20 20 20 7d 0a 20 20 20 20 69 re 1. }. i
7610: 66 20 7b 20 21 5b 20 69 6e 66 6f 20 65 78 69 73 f { ![ info exis
7620: 74 73 20 3a 3a 47 69 64 50 72 69 76 28 4d 65 73 ts ::GidPriv(Mes
7630: 73 61 67 65 57 69 6e 2c 4e 6f 4d 6f 72 65 4d 6f sageWin,NoMoreMo
7640: 64 61 6c 24 69 64 29 5d 7d 20 7b 0a 09 73 65 74 dal$id)]} {..set
7650: 20 3a 3a 47 69 64 50 72 69 76 28 4d 65 73 73 61 ::GidPriv(Messa
7660: 67 65 57 69 6e 2c 4e 6f 4d 6f 72 65 4d 6f 64 61 geWin,NoMoreModa
7670: 6c 24 69 64 29 20 30 0a 20 20 20 20 7d 0a 20 20 l$id) 0. }.
7680: 20 20 69 66 20 7b 20 24 3a 3a 47 69 64 50 72 69 if { $::GidPri
7690: 76 28 4d 65 73 73 61 67 65 57 69 6e 2c 4e 6f 4d v(MessageWin,NoM
76a0: 6f 72 65 4d 6f 64 61 6c 24 69 64 29 20 7d 20 7b oreModal$id) } {
76b0: 0a 09 57 61 72 6e 57 69 6e 54 65 78 74 20 22 57 ..WarnWinText "W
76c0: 61 72 6e 69 6e 67 3a 20 24 74 65 78 74 22 0a 09 arning: $text"..
76d0: 73 65 74 20 72 65 74 20 31 0a 20 20 20 20 7d 20 set ret 1. }
76e0: 65 6c 73 65 20 7b 0a 09 69 66 20 7b 24 74 69 74 else {..if {$tit
76f0: 6c 65 20 65 71 20 22 22 7d 20 7b 20 73 65 74 20 le eq ""} { set
7700: 74 69 74 6c 65 20 5b 5f 20 22 57 61 72 6e 69 6e title [_ "Warnin
7710: 67 22 5d 20 7d 0a 09 73 65 74 20 72 65 74 20 5b g"] }..set ret [
7720: 20 4d 65 73 73 61 67 65 57 69 6e 20 24 74 65 78 MessageWin $tex
7730: 74 20 24 74 69 74 6c 65 20 71 75 65 73 74 69 6f t $title questio
7740: 6e 2d 33 32 2e 70 6e 67 20 24 70 61 72 65 6e 74 n-32.png $parent
7750: 20 24 63 68 65 63 6b 5f 6e 6f 5f 6d 6f 72 65 5d $check_no_more]
7760: 0a 09 73 65 74 20 3a 3a 47 69 64 50 72 69 76 28 ..set ::GidPriv(
7770: 4d 65 73 73 61 67 65 57 69 6e 2c 4e 6f 4d 6f 72 MessageWin,NoMor
7780: 65 4d 6f 64 61 6c 24 69 64 29 20 24 72 65 74 0a eModal$id) $ret.
7790: 20 20 20 20 7d 0a 20 20 20 20 23 20 57 61 72 6e }. # Warn
77a0: 57 69 6e 54 65 78 74 20 22 24 69 64 3a 20 61 66 WinText "$id: af
77b0: 74 65 72 20 4d 65 73 73 61 67 65 57 69 6e 3a 20 ter MessageWin:
77c0: 72 65 74 3d 24 72 65 74 3d 22 0a 7d 0a 0a 70 72 ret=$ret=".}..pr
77d0: 6f 63 20 49 6e 66 6f 57 69 6e 20 7b 20 74 65 78 oc InfoWin { tex
77e0: 74 20 7b 70 61 72 65 6e 74 20 2e 7d 20 7b 69 64 t {parent .} {id
77f0: 20 30 7d 7d 20 7b 0a 20 20 20 20 23 20 57 61 72 0}} {. # War
7800: 6e 57 69 6e 54 65 78 74 20 22 24 69 64 3a 20 62 nWinText "$id: b
7810: 65 66 6f 72 65 20 4d 65 73 73 61 67 65 57 69 6e efore MessageWin
7820: 22 0a 20 20 20 20 73 65 74 20 63 68 65 63 6b 5f ". set check_
7830: 6e 6f 5f 6d 6f 72 65 20 30 0a 20 20 20 20 69 66 no_more 0. if
7840: 20 7b 20 24 69 64 20 21 3d 20 30 7d 20 7b 0a 09 { $id != 0} {..
7850: 73 65 74 20 63 68 65 63 6b 5f 6e 6f 5f 6d 6f 72 set check_no_mor
7860: 65 20 31 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 e 1. }. if
7870: 20 7b 20 21 5b 20 69 6e 66 6f 20 65 78 69 73 74 { ![ info exist
7880: 73 20 3a 3a 47 69 64 50 72 69 76 28 4d 65 73 73 s ::GidPriv(Mess
7890: 61 67 65 57 69 6e 2c 4e 6f 4d 6f 72 65 4d 6f 64 ageWin,NoMoreMod
78a0: 61 6c 24 69 64 29 5d 7d 20 7b 0a 09 73 65 74 20 al$id)]} {..set
78b0: 3a 3a 47 69 64 50 72 69 76 28 4d 65 73 73 61 67 ::GidPriv(Messag
78c0: 65 57 69 6e 2c 4e 6f 4d 6f 72 65 4d 6f 64 61 6c eWin,NoMoreModal
78d0: 24 69 64 29 20 30 0a 20 20 20 20 7d 0a 20 20 20 $id) 0. }.
78e0: 20 69 66 20 7b 20 24 3a 3a 47 69 64 50 72 69 76 if { $::GidPriv
78f0: 28 4d 65 73 73 61 67 65 57 69 6e 2c 4e 6f 4d 6f (MessageWin,NoMo
7900: 72 65 4d 6f 64 61 6c 24 69 64 29 20 7d 20 7b 0a reModal$id) } {.
7910: 09 57 61 72 6e 57 69 6e 54 65 78 74 20 22 57 61 .WarnWinText "Wa
7920: 72 6e 69 6e 67 3a 20 24 74 65 78 74 22 0a 09 73 rning: $text"..s
7930: 65 74 20 72 65 74 20 31 0a 20 20 20 20 7d 20 65 et ret 1. } e
7940: 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 74 20 5b lse {..set ret [
7950: 20 4d 65 73 73 61 67 65 57 69 6e 20 24 74 65 78 MessageWin $tex
7960: 74 20 5b 5f 20 22 57 61 72 6e 69 6e 67 22 5d 20 t [_ "Warning"]
7970: 69 6e 66 6f 2d 33 32 2e 70 6e 67 20 24 70 61 72 info-32.png $par
7980: 65 6e 74 20 24 63 68 65 63 6b 5f 6e 6f 5f 6d 6f ent $check_no_mo
7990: 72 65 5d 0a 09 73 65 74 20 3a 3a 47 69 64 50 72 re]..set ::GidPr
79a0: 69 76 28 4d 65 73 73 61 67 65 57 69 6e 2c 4e 6f iv(MessageWin,No
79b0: 4d 6f 72 65 4d 6f 64 61 6c 24 69 64 29 20 24 72 MoreModal$id) $r
79c0: 65 74 0a 20 20 20 20 7d 0a 20 20 20 20 23 20 57 et. }. # W
79d0: 61 72 6e 57 69 6e 54 65 78 74 20 22 24 69 64 3a arnWinText "$id:
79e0: 20 61 66 74 65 72 20 4d 65 73 73 61 67 65 57 69 after MessageWi
79f0: 6e 3a 20 72 65 74 3d 24 72 65 74 3d 22 0a 7d 0a n: ret=$ret=".}.
7a00: 0a 70 72 6f 63 20 43 72 65 61 74 65 57 61 72 6e .proc CreateWarn
7a10: 57 69 6e 49 64 20 7b 20 74 65 78 74 7d 20 7b 0a WinId { text} {.
7a20: 20 20 20 20 73 65 74 20 74 6f 74 61 6c 5f 73 75 set total_su
7a30: 6d 20 30 0a 20 20 20 20 73 65 74 20 63 68 65 63 m 0. set chec
7a40: 6b 5f 73 75 6d 20 30 0a 20 20 20 20 66 6f 72 20 k_sum 0. for
7a50: 7b 20 73 65 74 20 69 20 30 7d 20 7b 20 24 69 20 { set i 0} { $i
7a60: 3c 20 5b 20 73 74 72 69 6e 67 20 6c 65 6e 67 74 < [ string lengt
7a70: 68 20 24 74 65 78 74 5d 7d 20 7b 20 69 6e 63 72 h $text]} { incr
7a80: 20 69 7d 20 7b 0a 09 73 65 74 20 63 68 61 72 20 i} {..set char
7a90: 5b 20 73 74 72 69 6e 67 20 69 6e 64 65 78 20 24 [ string index $
7aa0: 69 5d 0a 09 73 65 74 20 74 6f 74 61 6c 5f 73 75 i]..set total_su
7ab0: 6d 20 5b 20 65 78 70 72 20 24 74 6f 74 61 6c 5f m [ expr $total_
7ac0: 73 75 6d 20 2b 20 24 63 68 61 72 5d 0a 09 73 65 sum + $char]..se
7ad0: 74 20 63 68 65 63 6b 5f 73 75 6d 20 5b 20 65 78 t check_sum [ ex
7ae0: 70 72 20 24 63 68 65 63 6b 5f 73 75 6d 20 5e 20 pr $check_sum ^
7af0: 24 63 68 61 72 5d 0a 20 20 20 20 7d 0a 20 20 20 $char]. }.
7b00: 20 73 65 74 20 77 69 6e 64 6f 77 5f 69 64 20 5b set window_id [
7b10: 20 65 78 70 72 20 28 20 28 20 24 74 6f 74 61 6c expr ( ( $total
7b20: 5f 73 75 6d 20 26 20 30 78 66 66 66 66 66 66 29 _sum & 0xffffff)
7b30: 20 3c 3c 20 38 29 20 7c 20 24 63 68 65 63 6b 5f << 8) | $check_
7b40: 73 75 6d 5d 0a 20 20 20 20 72 65 74 75 72 6e 20 sum]. return
7b50: 24 77 69 6e 64 6f 77 5f 69 64 0a 7d 0a 0a 70 72 $window_id.}..pr
7b60: 6f 63 20 52 65 73 65 74 4e 6f 4d 6f 72 65 43 68 oc ResetNoMoreCh
7b70: 65 63 6b 73 20 7b 7d 20 7b 0a 20 20 20 20 66 6f ecks {} {. fo
7b80: 72 65 61 63 68 20 69 64 78 20 5b 20 61 72 72 61 reach idx [ arra
7b90: 79 20 6e 61 6d 65 73 20 3a 3a 47 69 64 50 72 69 y names ::GidPri
7ba0: 76 20 4d 65 73 73 61 67 65 57 69 6e 2c 4e 6f 4d v MessageWin,NoM
7bb0: 6f 72 65 4d 6f 64 61 6c 2a 5d 20 7b 0a 09 75 6e oreModal*] {..un
7bc0: 73 65 74 20 3a 3a 47 69 64 50 72 69 76 28 24 69 set ::GidPriv($i
7bd0: 64 78 29 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f dx). }.}..pro
7be0: 63 20 57 61 72 6e 57 69 6e 5f 68 69 64 65 65 72 c WarnWin_hideer
7bf0: 72 6f 72 20 7b 20 74 65 78 74 20 65 72 72 6f 72 ror { text error
7c00: 64 61 74 61 20 7b 20 70 61 72 65 6e 74 20 2e 7d data { parent .}
7c10: 20 7d 20 7b 0a 20 20 20 20 69 66 20 7b 20 24 70 } {. if { $p
7c20: 61 72 65 6e 74 20 65 71 20 22 2e 22 20 7d 20 7b arent eq "." } {
7c30: 20 73 65 74 20 70 61 72 65 6e 74 20 22 22 20 7d set parent "" }
7c40: 0a 20 20 20 20 73 65 74 20 77 20 5b 64 69 61 6c . set w [dial
7c50: 6f 67 77 69 6e 5f 73 6e 69 74 20 24 70 61 72 65 ogwin_snit $pare
7c60: 6e 74 2e 25 41 55 54 4f 25 20 2d 74 69 74 6c 65 nt.%AUTO% -title
7c70: 20 5b 5f 20 57 61 72 6e 69 6e 67 5d 20 2d 6f 6b [_ Warning] -ok
7c80: 6e 61 6d 65 20 5b 5f 20 4f 6b 5d 20 5c 0a 09 20 name [_ Ok] \..
7c90: 20 20 20 20 20 20 2d 63 61 6e 63 65 6c 6e 61 6d -cancelnam
7ca0: 65 20 2d 5d 0a 20 20 20 20 73 65 74 20 66 20 5b e -]. set f [
7cb0: 24 77 20 67 69 76 65 66 72 61 6d 65 5d 0a 0a 20 $w giveframe]..
7cc0: 20 20 20 74 74 6b 3a 3a 6c 61 62 65 6c 20 24 66 ttk::label $f
7cd0: 2e 6c 31 20 2d 69 6d 61 67 65 20 5b 47 65 74 49 .l1 -image [GetI
7ce0: 6d 61 67 65 20 71 75 65 73 74 69 6f 6e 2d 33 32 mage question-32
7cf0: 2e 70 6e 67 5d 0a 20 20 20 20 74 74 6b 3a 3a 6c .png]. ttk::l
7d00: 61 62 65 6c 20 24 66 2e 6d 73 67 20 2d 6a 75 73 abel $f.msg -jus
7d10: 74 69 66 79 20 6c 65 66 74 20 2d 74 65 78 74 20 tify left -text
7d20: 24 74 65 78 74 20 2d 77 72 61 70 6c 65 6e 67 74 $text -wraplengt
7d30: 68 20 33 69 0a 0a 20 20 20 20 67 72 69 64 20 24 h 3i.. grid $
7d40: 66 2e 6c 31 20 24 66 2e 6d 73 67 20 2d 73 74 69 f.l1 $f.msg -sti
7d50: 63 6b 79 20 6e 77 0a 20 20 20 20 67 72 69 64 20 cky nw. grid
7d60: 63 6f 6e 66 69 67 75 72 65 20 24 66 2e 6d 73 67 configure $f.msg
7d70: 20 2d 70 61 64 78 20 35 20 2d 70 61 64 79 20 35 -padx 5 -pady 5
7d80: 0a 0a 20 20 20 20 62 69 6e 64 20 24 77 20 3c 32 .. bind $w <2
7d90: 3e 20 5b 6c 69 73 74 20 65 72 72 6f 72 20 24 74 > [list error $t
7da0: 65 78 74 20 24 65 72 72 6f 72 64 61 74 61 5d 0a ext $errordata].
7db0: 0a 20 20 20 20 73 65 74 20 61 63 74 69 6f 6e 20 . set action
7dc0: 5b 24 77 20 63 72 65 61 74 65 77 69 6e 64 6f 77 [$w createwindow
7dd0: 5d 0a 20 20 20 20 64 65 73 74 72 6f 79 20 24 77 ]. destroy $w
7de0: 0a 7d 0a 0a 70 72 6f 63 20 73 6e 69 74 5f 6d 65 .}..proc snit_me
7df0: 73 73 61 67 65 42 6f 78 20 7b 20 61 72 67 73 20 ssageBox { args
7e00: 7d 20 7b 0a 0a 20 20 20 20 61 72 72 61 79 20 73 } {.. array s
7e10: 65 74 20 6f 70 74 73 20 5b 6c 69 73 74 20 2d 64 et opts [list -d
7e20: 65 66 61 75 6c 74 20 22 22 20 2d 69 63 6f 6e 20 efault "" -icon
7e30: 71 75 65 73 74 69 6f 6e 2d 33 32 2e 70 6e 67 20 question-32.png
7e40: 2d 6d 65 73 73 61 67 65 20 22 22 20 2d 70 61 72 -message "" -par
7e50: 65 6e 74 20 2e 20 2d 74 69 74 6c 65 20 22 22 20 ent . -title ""
7e60: 5c 0a 09 20 20 20 20 2d 74 79 70 65 20 6f 6b 20 \.. -type ok
7e70: 2d 64 6f 5f 6e 6f 74 5f 61 73 6b 5f 61 67 61 69 -do_not_ask_agai
7e80: 6e 20 30 20 2d 64 6f 5f 6e 6f 74 5f 61 73 6b 5f n 0 -do_not_ask_
7e90: 61 67 61 69 6e 5f 6b 65 79 20 22 22 20 2d 61 63 again_key "" -ac
7ea0: 63 64 69 63 74 20 22 22 5d 0a 0a 20 20 20 20 66 cdict ""].. f
7eb0: 6f 72 20 7b 20 73 65 74 20 69 20 30 20 7d 20 7b or { set i 0 } {
7ec0: 20 24 69 20 3c 20 5b 6c 6c 65 6e 67 74 68 20 24 $i < [llength $
7ed0: 61 72 67 73 5d 20 7d 20 7b 20 69 6e 63 72 20 69 args] } { incr i
7ee0: 20 7d 20 7b 0a 09 73 65 74 20 6f 70 74 20 5b 6c } {..set opt [l
7ef0: 69 6e 64 65 78 20 24 61 72 67 73 20 24 69 5d 0a index $args $i].
7f00: 09 69 66 20 7b 20 21 5b 69 6e 66 6f 20 65 78 69 .if { ![info exi
7f10: 73 74 73 20 6f 70 74 73 28 24 6f 70 74 29 5d 20 sts opts($opt)]
7f20: 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 5b } {.. error [
7f30: 5f 20 22 75 6e 6b 6e 6f 77 6e 20 6f 70 74 69 6f _ "unknown optio
7f40: 6e 20 27 25 73 27 20 69 6e 20 73 6e 69 74 5f 6d n '%s' in snit_m
7f50: 65 73 73 61 67 65 42 6f 78 22 20 24 6f 70 74 5d essageBox" $opt]
7f60: 0a 09 7d 0a 09 69 6e 63 72 20 69 0a 09 73 65 74 ..}..incr i..set
7f70: 20 6f 70 74 73 28 24 6f 70 74 29 20 5b 6c 69 6e opts($opt) [lin
7f80: 64 65 78 20 24 61 72 67 73 20 24 69 5d 0a 20 20 dex $args $i].
7f90: 20 20 7d 0a 0a 20 20 20 20 69 66 20 7b 20 24 6f }.. if { $o
7fa0: 70 74 73 28 2d 64 6f 5f 6e 6f 74 5f 61 73 6b 5f pts(-do_not_ask_
7fb0: 61 67 61 69 6e 29 20 7d 20 7b 0a 09 69 66 20 7b again) } {..if {
7fc0: 20 24 6f 70 74 73 28 2d 74 79 70 65 29 20 6e 69 $opts(-type) ni
7fd0: 20 22 6f 6b 20 6f 6b 63 61 6e 63 65 6c 20 79 65 "ok okcancel ye
7fe0: 73 6e 6f 20 79 65 73 6e 6f 63 61 6e 63 65 6c 22 sno yesnocancel"
7ff0: 20 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 } {.. error
8000: 22 65 72 72 6f 72 2e 20 6f 70 74 69 6f 6e 20 2d "error. option -
8010: 64 6f 5f 6e 6f 74 5f 61 73 6b 5f 61 67 61 69 6e do_not_ask_again
8020: 20 63 61 6e 20 6f 6e 6c 79 20 62 65 20 75 73 65 can only be use
8030: 64 20 66 6f 72 20 74 79 70 65 73 20 27 6f 6b 27 d for types 'ok'
8040: 2c 27 6f 6b 63 61 6e 63 65 6c 27 2c 27 79 65 73 ,'okcancel','yes
8050: 6e 6f 27 20 61 6e 64 20 27 79 65 73 6e 6f 63 61 no' and 'yesnoca
8060: 6e 63 65 6c 27 22 0a 09 7d 0a 09 73 65 74 20 64 ncel'"..}..set d
8070: 20 5b 64 69 61 6c 6f 67 77 69 6e 5f 73 6e 69 74 [dialogwin_snit
8080: 20 67 69 76 65 5f 74 79 70 65 75 73 65 72 76 61 give_typeuserva
8090: 72 5f 76 61 6c 75 65 20 64 6f 5f 6e 6f 74 5f 61 r_value do_not_a
80a0: 73 6b 5f 61 67 61 69 6e 20 22 22 5d 0a 09 69 66 sk_again ""]..if
80b0: 20 7b 20 24 6f 70 74 73 28 2d 64 6f 5f 6e 6f 74 { $opts(-do_not
80c0: 5f 61 73 6b 5f 61 67 61 69 6e 5f 6b 65 79 29 20 _ask_again_key)
80d0: 65 71 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 73 eq "" } {.. s
80e0: 65 74 20 6f 70 74 73 28 2d 64 6f 5f 6e 6f 74 5f et opts(-do_not_
80f0: 61 73 6b 5f 61 67 61 69 6e 5f 6b 65 79 29 20 24 ask_again_key) $
8100: 6f 70 74 73 28 2d 6d 65 73 73 61 67 65 29 0a 09 opts(-message)..
8110: 7d 0a 09 69 66 20 7b 20 5b 64 69 63 74 20 65 78 }..if { [dict ex
8120: 69 73 74 73 20 24 64 20 24 6f 70 74 73 28 2d 64 ists $d $opts(-d
8130: 6f 5f 6e 6f 74 5f 61 73 6b 5f 61 67 61 69 6e 5f o_not_ask_again_
8140: 6b 65 79 29 5d 20 7d 20 7b 0a 09 20 20 20 20 72 key)] } {.. r
8150: 65 74 75 72 6e 20 5b 64 69 63 74 20 67 65 74 20 eturn [dict get
8160: 24 64 20 24 6f 70 74 73 28 2d 64 6f 5f 6e 6f 74 $d $opts(-do_not
8170: 5f 61 73 6b 5f 61 67 61 69 6e 5f 6b 65 79 29 5d _ask_again_key)]
8180: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 77 ..}. }. sw
8190: 69 74 63 68 20 2d 2d 20 24 6f 70 74 73 28 2d 74 itch -- $opts(-t
81a0: 79 70 65 29 20 7b 0a 09 61 62 6f 72 74 72 65 74 ype) {..abortret
81b0: 72 79 69 67 6e 6f 72 65 20 7b 0a 09 20 20 20 20 ryignore {..
81c0: 73 65 74 20 72 65 74 62 75 74 73 20 5b 6c 69 73 set retbuts [lis
81d0: 74 20 61 62 6f 72 74 20 72 65 74 72 79 20 69 67 t abort retry ig
81e0: 6e 6f 72 65 5d 0a 09 20 20 20 20 73 65 74 20 62 nore].. set b
81f0: 75 74 73 20 5b 6c 69 73 74 20 5b 5f 20 41 62 6f uts [list [_ Abo
8200: 72 74 5d 20 5b 5f 20 52 65 74 72 79 5d 20 5b 5f rt] [_ Retry] [_
8210: 20 49 67 6e 6f 72 65 5d 5d 0a 09 7d 0a 09 6f 6b Ignore]]..}..ok
8220: 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 74 62 {.. set retb
8230: 75 74 73 20 5b 6c 69 73 74 20 6f 6b 5d 0a 09 20 uts [list ok]..
8240: 20 20 20 73 65 74 20 62 75 74 73 20 5b 6c 69 73 set buts [lis
8250: 74 20 5b 5f 20 4f 4b 5d 5d 0a 09 7d 0a 09 6f 6b t [_ OK]]..}..ok
8260: 63 61 6e 63 65 6c 20 7b 0a 09 20 20 20 20 73 65 cancel {.. se
8270: 74 20 72 65 74 62 75 74 73 20 5b 6c 69 73 74 20 t retbuts [list
8280: 6f 6b 20 63 61 6e 63 65 6c 5d 0a 09 20 20 20 20 ok cancel]..
8290: 73 65 74 20 62 75 74 73 20 5b 6c 69 73 74 20 5b set buts [list [
82a0: 5f 20 4f 4b 5d 20 5b 5f 20 43 61 6e 63 65 6c 5d _ OK] [_ Cancel]
82b0: 5d 0a 09 7d 0a 09 72 65 74 72 79 63 61 6e 63 65 ]..}..retrycance
82c0: 6c 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 74 l {.. set ret
82d0: 62 75 74 73 20 5b 6c 69 73 74 20 72 65 74 72 79 buts [list retry
82e0: 20 63 61 6e 63 65 6c 5d 0a 09 20 20 20 20 73 65 cancel].. se
82f0: 74 20 62 75 74 73 20 5b 6c 69 73 74 20 5b 5f 20 t buts [list [_
8300: 52 65 74 72 79 5d 20 5b 5f 20 43 61 6e 63 65 6c Retry] [_ Cancel
8310: 5d 5d 0a 09 7d 0a 09 79 65 73 6e 6f 20 7b 0a 09 ]]..}..yesno {..
8320: 20 20 20 20 73 65 74 20 72 65 74 62 75 74 73 20 set retbuts
8330: 5b 6c 69 73 74 20 79 65 73 20 6e 6f 5d 0a 09 20 [list yes no]..
8340: 20 20 20 73 65 74 20 62 75 74 73 20 5b 6c 69 73 set buts [lis
8350: 74 20 5b 5f 20 59 65 73 5d 20 5b 5f 20 4e 6f 5d t [_ Yes] [_ No]
8360: 5d 0a 09 7d 0a 09 79 65 73 6e 6f 63 61 6e 63 65 ]..}..yesnocance
8370: 6c 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 74 l {.. set ret
8380: 62 75 74 73 20 5b 6c 69 73 74 20 79 65 73 20 6e buts [list yes n
8390: 6f 20 63 61 6e 63 65 6c 5d 0a 09 20 20 20 20 73 o cancel].. s
83a0: 65 74 20 62 75 74 73 20 5b 6c 69 73 74 20 5b 5f et buts [list [_
83b0: 20 59 65 73 5d 20 5b 5f 20 4e 6f 5d 20 5b 5f 20 Yes] [_ No] [_
83c0: 43 61 6e 63 65 6c 5d 5d 0a 09 7d 0a 09 64 65 66 Cancel]]..}..def
83d0: 61 75 6c 74 20 7b 0a 09 20 20 20 20 65 72 72 6f ault {.. erro
83e0: 72 20 5b 5f 20 22 75 6e 6b 6e 6f 77 6e 20 74 79 r [_ "unknown ty
83f0: 70 65 3a 20 27 25 73 27 20 69 6e 20 73 6e 69 74 pe: '%s' in snit
8400: 5f 6d 65 73 73 61 67 65 42 6f 78 22 20 24 6f 70 _messageBox" $op
8410: 74 73 28 2d 74 79 70 65 29 5d 0a 09 7d 0a 20 20 ts(-type)]..}.
8420: 20 20 7d 0a 0a 20 20 20 20 69 66 20 7b 20 24 6f }.. if { $o
8430: 70 74 73 28 2d 64 65 66 61 75 6c 74 29 20 3d 3d pts(-default) ==
8440: 20 22 22 20 7d 20 7b 0a 09 73 65 74 20 6f 70 74 "" } {..set opt
8450: 73 28 2d 64 65 66 61 75 6c 74 70 6f 73 29 20 30 s(-defaultpos) 0
8460: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 . } else {..s
8470: 65 74 20 6f 70 74 73 28 2d 64 65 66 61 75 6c 74 et opts(-default
8480: 70 6f 73 29 20 5b 6c 73 65 61 72 63 68 20 2d 72 pos) [lsearch -r
8490: 65 67 65 78 70 20 24 72 65 74 62 75 74 73 20 22 egexp $retbuts "
84a0: 28 3f 69 71 29 24 6f 70 74 73 28 2d 64 65 66 61 (?iq)$opts(-defa
84b0: 75 6c 74 29 22 5d 0a 09 69 66 20 7b 20 24 6f 70 ult)"]..if { $op
84c0: 74 73 28 2d 64 65 66 61 75 6c 74 70 6f 73 29 20 ts(-defaultpos)
84d0: 3d 3d 20 2d 31 20 7d 20 7b 0a 09 20 20 20 20 65 == -1 } {.. e
84e0: 72 72 6f 72 20 5b 5f 20 22 62 61 64 20 64 65 66 rror [_ "bad def
84f0: 61 75 6c 74 20 6f 70 74 69 6f 6e 3a 20 27 25 73 ault option: '%s
8500: 27 20 69 6e 20 73 6e 69 74 5f 6d 65 73 73 61 67 ' in snit_messag
8510: 65 42 6f 78 22 20 24 6f 70 74 73 28 2d 64 65 66 eBox" $opts(-def
8520: 61 75 6c 74 29 5d 0a 09 7d 0a 20 20 20 20 7d 0a ault)]..}. }.
8530: 0a 20 20 20 20 69 66 20 7b 20 24 6f 70 74 73 28 . if { $opts(
8540: 2d 70 61 72 65 6e 74 29 20 65 71 20 22 2e 22 20 -parent) eq "."
8550: 7d 20 7b 0a 09 73 65 74 20 77 20 2e 25 41 55 54 } {..set w .%AUT
8560: 4f 25 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a O%. } else {.
8570: 09 73 65 74 20 77 20 24 6f 70 74 73 28 2d 70 61 .set w $opts(-pa
8580: 72 65 6e 74 29 2e 25 41 55 54 4f 25 0a 20 20 20 rent).%AUTO%.
8590: 20 7d 0a 20 20 20 20 73 65 74 20 77 20 5b 64 69 }. set w [di
85a0: 61 6c 6f 67 77 69 6e 5f 73 6e 69 74 20 24 77 20 alogwin_snit $w
85b0: 2d 74 69 74 6c 65 20 24 6f 70 74 73 28 2d 74 69 -title $opts(-ti
85c0: 74 6c 65 29 20 2d 6d 6f 72 65 62 75 74 74 6f 6e tle) -morebutton
85d0: 73 20 24 62 75 74 73 20 5c 0a 09 20 20 20 20 20 s $buts \..
85e0: 20 20 2d 6f 6b 6e 61 6d 65 20 2d 20 2d 63 61 6e -okname - -can
85f0: 63 65 6c 6e 61 6d 65 20 2d 20 2d 74 72 61 6e 73 celname - -trans
8600: 69 65 6e 74 20 31 5d 0a 20 20 20 20 73 65 74 20 ient 1]. set
8610: 66 20 5b 24 77 20 67 69 76 65 66 72 61 6d 65 5d f [$w giveframe]
8620: 0a 0a 20 20 20 20 73 65 74 20 69 63 6f 6e 73 20 .. set icons
8630: 5b 64 69 63 74 20 63 72 65 61 74 65 20 5c 0a 09 [dict create \..
8640: 20 20 20 20 71 75 65 73 74 69 6f 6e 20 22 71 75 question "qu
8650: 65 73 74 69 6f 6e 2d 33 32 2e 70 6e 67 22 20 5c estion-32.png" \
8660: 0a 09 20 20 20 20 77 61 72 6e 69 6e 67 20 22 77 .. warning "w
8670: 61 72 6e 69 6e 67 2d 33 32 2e 70 6e 67 22 20 5c arning-32.png" \
8680: 0a 09 20 20 20 20 65 72 72 6f 72 20 22 65 72 72 .. error "err
8690: 6f 72 2d 33 32 2e 70 6e 67 22 20 5c 0a 09 20 20 or-32.png" \..
86a0: 20 20 69 6e 66 6f 20 22 69 6e 66 6f 2d 33 32 2e info "info-32.
86b0: 70 6e 67 22 5d 0a 20 20 20 20 0a 20 20 20 20 69 png"]. . i
86c0: 66 20 7b 20 5b 64 69 63 74 20 65 78 69 73 74 73 f { [dict exists
86d0: 20 24 69 63 6f 6e 73 20 24 6f 70 74 73 28 2d 69 $icons $opts(-i
86e0: 63 6f 6e 29 5d 20 7d 20 7b 0a 09 73 65 74 20 6f con)] } {..set o
86f0: 70 74 73 28 2d 69 63 6f 6e 29 20 5b 64 69 63 74 pts(-icon) [dict
8700: 20 67 65 74 20 24 69 63 6f 6e 73 20 24 6f 70 74 get $icons $opt
8710: 73 28 2d 69 63 6f 6e 29 5d 0a 20 20 20 20 7d 0a s(-icon)]. }.
8720: 20 20 20 20 74 74 6b 3a 3a 6c 61 62 65 6c 20 24 ttk::label $
8730: 66 2e 6c 31 20 2d 69 6d 61 67 65 20 5b 47 65 74 f.l1 -image [Get
8740: 49 6d 61 67 65 20 24 6f 70 74 73 28 2d 69 63 6f Image $opts(-ico
8750: 6e 29 5d 0a 20 20 20 20 69 66 20 7b 20 5b 77 69 n)]. if { [wi
8760: 6e 66 6f 20 73 63 72 65 65 6e 77 69 64 74 68 20 nfo screenwidth
8770: 2e 5d 20 3c 20 33 30 30 20 7d 20 7b 0a 09 73 65 .] < 300 } {..se
8780: 74 20 77 72 61 70 6c 65 6e 67 74 68 20 31 2e 35 t wraplength 1.5
8790: 69 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 i. } else {..
87a0: 73 65 74 20 77 72 61 70 6c 65 6e 67 74 68 20 33 set wraplength 3
87b0: 69 0a 20 20 20 20 7d 0a 20 20 20 20 74 74 6b 3a i. }. ttk:
87c0: 3a 6c 61 62 65 6c 20 24 66 2e 6d 73 67 20 2d 6a :label $f.msg -j
87d0: 75 73 74 69 66 79 20 6c 65 66 74 20 2d 74 65 78 ustify left -tex
87e0: 74 20 24 6f 70 74 73 28 2d 6d 65 73 73 61 67 65 t $opts(-message
87f0: 29 20 2d 77 72 61 70 6c 65 6e 67 74 68 20 24 77 ) -wraplength $w
8800: 72 61 70 6c 65 6e 67 74 68 0a 0a 20 20 20 20 67 raplength.. g
8810: 72 69 64 20 24 66 2e 6c 31 20 24 66 2e 6d 73 67 rid $f.l1 $f.msg
8820: 20 2d 73 74 69 63 6b 79 20 6e 77 0a 20 20 20 20 -sticky nw.
8830: 67 72 69 64 20 63 6f 6e 66 69 67 75 72 65 20 24 grid configure $
8840: 66 2e 6d 73 67 20 2d 70 61 64 78 20 35 20 2d 70 f.msg -padx 5 -p
8850: 61 64 79 20 35 0a 0a 20 20 20 20 69 66 20 7b 20 ady 5.. if {
8860: 24 6f 70 74 73 28 2d 64 6f 5f 6e 6f 74 5f 61 73 $opts(-do_not_as
8870: 6b 5f 61 67 61 69 6e 29 20 7d 20 7b 0a 09 74 74 k_again) } {..tt
8880: 6b 3a 3a 63 68 65 63 6b 62 75 74 74 6f 6e 20 24 k::checkbutton $
8890: 66 2e 63 62 31 20 2d 74 65 78 74 20 5b 5f 20 22 f.cb1 -text [_ "
88a0: 44 6f 20 6e 6f 74 20 73 68 6f 77 20 61 67 61 69 Do not show agai
88b0: 6e 20 66 6f 72 20 74 68 69 73 20 73 65 73 73 69 n for this sessi
88c0: 6f 6e 22 5d 20 2d 76 61 72 69 61 62 6c 65 20 5c on"] -variable \
88d0: 0a 09 20 20 20 20 5b 24 77 20 67 69 76 65 5f 75 .. [$w give_u
88e0: 73 65 72 76 61 72 20 64 6f 5f 6e 6f 74 5f 61 73 servar do_not_as
88f0: 6b 5f 61 67 61 69 6e 20 30 5d 0a 09 67 72 69 64 k_again 0]..grid
8900: 20 24 66 2e 63 62 31 20 2d 20 2d 73 74 69 63 6b $f.cb1 - -stick
8910: 79 20 77 0a 20 20 20 20 7d 0a 20 20 20 20 0a 20 y w. }. .
8920: 20 20 20 64 69 63 74 20 66 6f 72 20 22 62 69 6e dict for "bin
8930: 64 69 6e 67 20 62 75 74 22 20 24 6f 70 74 73 28 ding but" $opts(
8940: 2d 61 63 63 64 69 63 74 29 20 7b 0a 09 73 65 74 -accdict) {..set
8950: 20 70 6f 73 20 5b 6c 73 65 61 72 63 68 20 2d 72 pos [lsearch -r
8960: 65 67 65 78 70 20 24 72 65 74 62 75 74 73 20 22 egexp $retbuts "
8970: 28 3f 69 71 29 24 62 75 74 22 5d 0a 09 69 66 20 (?iq)$but"]..if
8980: 7b 20 24 70 6f 73 20 3d 3d 20 2d 31 20 7d 20 7b { $pos == -1 } {
8990: 0a 09 20 20 20 20 65 72 72 6f 72 20 5b 5f 20 22 .. error [_ "
89a0: 62 61 64 20 62 69 6e 64 69 6e 67 20 6f 70 74 69 bad binding opti
89b0: 6f 6e 20 62 75 74 74 6f 6e 3a 20 27 25 73 27 20 on button: '%s'
89c0: 69 6e 20 73 6e 69 74 5f 6d 65 73 73 61 67 65 42 in snit_messageB
89d0: 6f 78 22 20 24 62 75 74 5d 0a 09 7d 0a 09 62 69 ox" $but]..}..bi
89e0: 6e 64 20 24 77 20 24 62 69 6e 64 69 6e 67 20 5b nd $w $binding [
89f0: 6c 69 73 74 20 24 77 20 69 6e 76 6f 6b 65 62 75 list $w invokebu
8a00: 74 74 6f 6e 20 5b 65 78 70 72 20 7b 24 70 6f 73 tton [expr {$pos
8a10: 2b 32 7d 5d 20 30 5d 0a 20 20 20 20 7d 0a 0a 20 +2}] 0]. }..
8a20: 20 20 20 24 77 20 66 6f 63 75 73 62 75 74 74 6f $w focusbutto
8a30: 6e 20 5b 65 78 70 72 20 24 6f 70 74 73 28 2d 64 n [expr $opts(-d
8a40: 65 66 61 75 6c 74 70 6f 73 29 2b 32 5d 0a 20 20 efaultpos)+2].
8a50: 20 20 73 65 74 20 61 63 74 69 6f 6e 20 5b 24 77 set action [$w
8a60: 20 63 72 65 61 74 65 77 69 6e 64 6f 77 5d 0a 0a createwindow]..
8a70: 20 20 20 20 69 66 20 7b 20 24 6f 70 74 73 28 2d if { $opts(-
8a80: 64 6f 5f 6e 6f 74 5f 61 73 6b 5f 61 67 61 69 6e do_not_ask_again
8a90: 29 20 26 26 20 5b 24 77 20 67 69 76 65 5f 75 73 ) && [$w give_us
8aa0: 65 72 76 61 72 5f 76 61 6c 75 65 20 64 6f 5f 6e ervar_value do_n
8ab0: 6f 74 5f 61 73 6b 5f 61 67 61 69 6e 5d 20 7d 20 ot_ask_again] }
8ac0: 7b 0a 09 73 65 74 20 64 6f 5f 6e 6f 74 5f 61 73 {..set do_not_as
8ad0: 6b 5f 61 67 61 69 6e 20 31 0a 20 20 20 20 7d 20 k_again 1. }
8ae0: 65 6c 73 65 20 7b 0a 09 73 65 74 20 64 6f 5f 6e else {..set do_n
8af0: 6f 74 5f 61 73 6b 5f 61 67 61 69 6e 20 30 0a 20 ot_ask_again 0.
8b00: 20 20 20 7d 0a 20 20 20 20 64 65 73 74 72 6f 79 }. destroy
8b10: 20 24 77 0a 0a 20 20 20 20 73 77 69 74 63 68 20 $w.. switch
8b20: 2d 2d 20 24 61 63 74 69 6f 6e 20 7b 0a 09 2d 31 -- $action {..-1
8b30: 20 2d 20 30 20 7b 0a 09 20 20 20 20 69 66 20 7b - 0 {.. if {
8b40: 20 5b 6c 73 65 61 72 63 68 20 2d 65 78 61 63 74 [lsearch -exact
8b50: 20 24 62 75 74 73 20 5b 5f 20 43 61 6e 63 65 6c $buts [_ Cancel
8b60: 5d 5d 20 21 3d 20 2d 31 20 7d 20 7b 0a 09 09 72 ]] != -1 } {...r
8b70: 65 74 75 72 6e 20 63 61 6e 63 65 6c 0a 09 20 20 eturn cancel..
8b80: 20 20 7d 0a 09 20 20 20 20 72 65 74 75 72 6e 20 }.. return
8b90: 5b 6c 69 6e 64 65 78 20 24 72 65 74 62 75 74 73 [lindex $retbuts
8ba0: 20 65 6e 64 5d 0a 09 7d 0a 09 64 65 66 61 75 6c end]..}..defaul
8bb0: 74 20 7b 0a 09 20 20 20 20 73 65 74 20 69 70 6f t {.. set ipo
8bc0: 73 20 5b 65 78 70 72 20 7b 24 61 63 74 69 6f 6e s [expr {$action
8bd0: 2d 32 7d 5d 0a 09 20 20 20 20 69 66 20 7b 20 5b -2}].. if { [
8be0: 6c 69 6e 64 65 78 20 24 72 65 74 62 75 74 73 20 lindex $retbuts
8bf0: 24 69 70 6f 73 5d 20 6e 65 20 22 63 61 6e 63 65 $ipos] ne "cance
8c00: 6c 22 20 26 26 20 24 64 6f 5f 6e 6f 74 5f 61 73 l" && $do_not_as
8c10: 6b 5f 61 67 61 69 6e 20 7d 20 7b 0a 09 09 73 65 k_again } {...se
8c20: 74 20 64 20 5b 64 69 61 6c 6f 67 77 69 6e 5f 73 t d [dialogwin_s
8c30: 6e 69 74 20 67 69 76 65 5f 74 79 70 65 75 73 65 nit give_typeuse
8c40: 72 76 61 72 5f 76 61 6c 75 65 20 64 6f 5f 6e 6f rvar_value do_no
8c50: 74 5f 61 73 6b 5f 61 67 61 69 6e 20 22 22 5d 0a t_ask_again ""].
8c60: 09 09 69 66 20 7b 20 24 6f 70 74 73 28 2d 64 6f ..if { $opts(-do
8c70: 5f 6e 6f 74 5f 61 73 6b 5f 61 67 61 69 6e 5f 6b _not_ask_again_k
8c80: 65 79 29 20 65 71 20 22 22 20 7d 20 7b 0a 09 09 ey) eq "" } {...
8c90: 20 20 20 20 73 65 74 20 6f 70 74 73 28 2d 64 6f set opts(-do
8ca0: 5f 6e 6f 74 5f 61 73 6b 5f 61 67 61 69 6e 5f 6b _not_ask_again_k
8cb0: 65 79 29 20 24 6f 70 74 73 28 2d 6d 65 73 73 61 ey) $opts(-messa
8cc0: 67 65 29 0a 09 09 7d 0a 09 09 64 69 63 74 20 73 ge)...}...dict s
8cd0: 65 74 20 64 20 24 6f 70 74 73 28 2d 64 6f 5f 6e et d $opts(-do_n
8ce0: 6f 74 5f 61 73 6b 5f 61 67 61 69 6e 5f 6b 65 79 ot_ask_again_key
8cf0: 29 20 5b 6c 69 6e 64 65 78 20 24 72 65 74 62 75 ) [lindex $retbu
8d00: 74 73 20 24 69 70 6f 73 5d 0a 09 09 64 69 61 6c ts $ipos]...dial
8d10: 6f 67 77 69 6e 5f 73 6e 69 74 20 73 65 74 5f 74 ogwin_snit set_t
8d20: 79 70 65 75 73 65 72 76 61 72 5f 76 61 6c 75 65 ypeuservar_value
8d30: 20 64 6f 5f 6e 6f 74 5f 61 73 6b 5f 61 67 61 69 do_not_ask_agai
8d40: 6e 20 24 64 0a 09 20 20 20 20 7d 0a 09 20 20 20 n $d.. }..
8d50: 20 72 65 74 75 72 6e 20 5b 6c 69 6e 64 65 78 20 return [lindex
8d60: 24 72 65 74 62 75 74 73 20 24 69 70 6f 73 5d 0a $retbuts $ipos].
8d70: 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 .}. }.}..proc
8d80: 20 74 6b 5f 64 69 61 6c 6f 67 5f 73 6e 69 74 20 tk_dialog_snit
8d90: 7b 77 20 74 69 74 6c 65 20 74 65 78 74 20 74 65 {w title text te
8da0: 78 74 73 6d 61 6c 6c 20 62 69 74 6d 61 70 20 69 xtsmall bitmap i
8db0: 6d 61 67 65 20 64 65 66 61 75 6c 74 20 61 72 67 mage default arg
8dc0: 73 7d 20 7b 0a 20 20 20 20 69 66 20 7b 20 24 77 s} {. if { $w
8dd0: 20 3d 3d 20 22 22 20 7d 20 7b 0a 09 73 65 74 20 == "" } {..set
8de0: 70 61 72 65 6e 74 20 22 2e 22 0a 20 20 20 20 7d parent ".". }
8df0: 20 65 6c 73 65 20 7b 20 72 65 67 73 75 62 20 7b else { regsub {
8e00: 5b 2e 5d 5b 5e 2e 5d 2a 24 7d 20 24 77 20 7b 7d [.][^.]*$} $w {}
8e10: 20 70 61 72 65 6e 74 20 7d 0a 20 20 20 20 69 66 parent }. if
8e20: 20 7b 24 70 61 72 65 6e 74 20 3d 3d 20 22 22 7d {$parent == ""}
8e30: 20 7b 0a 09 73 65 74 20 70 61 72 65 6e 74 20 22 {..set parent "
8e40: 2e 22 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 .". }. ret
8e50: 75 72 6e 20 5b 65 76 61 6c 20 5b 6c 69 73 74 20 urn [eval [list
8e60: 74 6b 5f 64 69 61 6c 6f 67 5f 73 6e 69 74 31 20 tk_dialog_snit1
8e70: 24 70 61 72 65 6e 74 20 24 74 69 74 6c 65 20 24 $parent $title $
8e80: 74 65 78 74 20 24 74 65 78 74 73 6d 61 6c 6c 20 text $textsmall
8e90: 24 69 6d 61 67 65 20 24 64 65 66 61 75 6c 74 5d $image $default]
8ea0: 20 5c 0a 09 09 24 61 72 67 73 5d 0a 7d 0a 0a 70 \...$args].}..p
8eb0: 72 6f 63 20 74 6b 5f 64 69 61 6c 6f 67 5f 73 6e roc tk_dialog_sn
8ec0: 69 74 31 20 7b 20 70 61 72 65 6e 74 20 74 69 74 it1 { parent tit
8ed0: 6c 65 20 74 65 78 74 20 74 65 78 74 73 6d 61 6c le text textsmal
8ee0: 6c 20 69 6d 61 67 65 20 64 65 66 61 75 6c 74 20 l image default
8ef0: 61 72 67 73 7d 20 7b 0a 0a 20 20 20 20 69 66 20 args} {.. if
8f00: 7b 20 24 70 61 72 65 6e 74 20 65 71 20 22 2e 22 { $parent eq "."
8f10: 20 7d 20 7b 0a 09 73 65 74 20 77 20 2e 25 41 55 } {..set w .%AU
8f20: 54 4f 25 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b TO%. } else {
8f30: 0a 09 73 65 74 20 77 20 24 70 61 72 65 6e 74 2e ..set w $parent.
8f40: 25 41 55 54 4f 25 0a 20 20 20 20 7d 0a 20 20 20 %AUTO%. }.
8f50: 20 73 65 74 20 77 20 5b 64 69 61 6c 6f 67 77 69 set w [dialogwi
8f60: 6e 5f 73 6e 69 74 20 24 77 20 2d 74 69 74 6c 65 n_snit $w -title
8f70: 20 24 74 69 74 6c 65 20 2d 6d 6f 72 65 62 75 74 $title -morebut
8f80: 74 6f 6e 73 20 24 61 72 67 73 20 5c 0a 09 20 20 tons $args \..
8f90: 20 20 20 20 20 2d 6f 6b 6e 61 6d 65 20 2d 20 2d -okname - -
8fa0: 63 61 6e 63 65 6c 6e 61 6d 65 20 2d 5d 0a 20 20 cancelname -].
8fb0: 20 20 73 65 74 20 66 20 5b 24 77 20 67 69 76 65 set f [$w give
8fc0: 66 72 61 6d 65 5d 0a 0a 20 20 20 20 6c 61 62 65 frame].. labe
8fd0: 6c 20 24 66 2e 6c 31 20 2d 69 6d 61 67 65 20 24 l $f.l1 -image $
8fe0: 69 6d 61 67 65 0a 20 20 20 20 6c 61 62 65 6c 20 image. label
8ff0: 24 66 2e 6d 73 67 20 2d 6a 75 73 74 69 66 79 20 $f.msg -justify
9000: 6c 65 66 74 20 2d 74 65 78 74 20 24 74 65 78 74 left -text $text
9010: 20 2d 77 72 61 70 6c 65 6e 67 74 68 20 33 69 0a -wraplength 3i.
9020: 0a 20 20 20 20 67 72 69 64 20 24 66 2e 6c 31 20 . grid $f.l1
9030: 24 66 2e 6d 73 67 20 2d 73 74 69 63 6b 79 20 6e $f.msg -sticky n
9040: 77 0a 20 20 20 20 67 72 69 64 20 63 6f 6e 66 69 w. grid confi
9050: 67 75 72 65 20 24 66 2e 6d 73 67 20 2d 70 61 64 gure $f.msg -pad
9060: 78 20 35 20 2d 70 61 64 79 20 35 0a 0a 20 20 20 x 5 -pady 5..
9070: 20 69 66 20 7b 20 24 74 65 78 74 73 6d 61 6c 6c if { $textsmall
9080: 20 6e 65 20 22 22 20 7d 20 7b 0a 09 73 65 74 20 ne "" } {..set
9090: 73 69 7a 65 20 5b 65 78 70 72 20 7b 5b 66 6f 6e size [expr {[fon
90a0: 74 20 61 63 74 75 61 6c 20 5b 24 66 2e 6d 73 67 t actual [$f.msg
90b0: 20 63 67 65 74 20 2d 66 6f 6e 74 5d 20 2d 73 69 cget -font] -si
90c0: 7a 65 5d 2d 32 7d 5d 0a 09 6c 61 62 65 6c 20 24 ze]-2}]..label $
90d0: 66 2e 74 73 20 2d 74 65 78 74 20 24 74 65 78 74 f.ts -text $text
90e0: 73 6d 61 6c 6c 20 2d 66 6f 6e 74 20 22 2d 73 69 small -font "-si
90f0: 7a 65 20 24 73 69 7a 65 22 0a 09 67 72 69 64 20 ze $size"..grid
9100: 24 66 2e 74 73 20 2d 20 73 74 69 63 6b 79 20 6e $f.ts - sticky n
9110: 77 0a 20 20 20 20 7d 0a 0a 20 20 20 20 24 77 20 w. }.. $w
9120: 66 6f 63 75 73 62 75 74 74 6f 6e 20 5b 65 78 70 focusbutton [exp
9130: 72 20 24 64 65 66 61 75 6c 74 2b 32 5d 0a 20 20 r $default+2].
9140: 20 20 73 65 74 20 61 63 74 69 6f 6e 20 5b 24 77 set action [$w
9150: 20 63 72 65 61 74 65 77 69 6e 64 6f 77 5d 0a 0a createwindow]..
9160: 20 20 20 20 64 65 73 74 72 6f 79 20 24 77 0a 0a destroy $w..
9170: 20 20 20 20 73 77 69 74 63 68 20 2d 2d 20 24 61 switch -- $a
9180: 63 74 69 6f 6e 20 7b 0a 09 2d 31 20 2d 20 30 20 ction {..-1 - 0
9190: 7b 0a 09 20 20 20 20 72 65 74 75 72 6e 20 2d 31 {.. return -1
91a0: 0a 09 7d 0a 09 64 65 66 61 75 6c 74 20 7b 0a 09 ..}..default {..
91b0: 20 20 20 20 72 65 74 75 72 6e 20 5b 65 78 70 72 return [expr
91c0: 20 7b 24 61 63 74 69 6f 6e 2d 32 7d 5d 0a 09 7d {$action-2}]..}
91d0: 0a 20 20 20 20 7d 0a 7d 0a 0a 0a 0a 23 2d 2d 2d . }.}....#---
91e0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
91f0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
9200: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
9210: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
9220: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 23 20 -------------.#
9230: 20 20 20 20 64 69 61 6c 6f 67 77 69 6e 5f 73 6e dialogwin_sn
9240: 69 74 0a 23 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d it.#------------
9250: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
9260: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
9270: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
9280: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
9290: 2d 2d 2d 2d 0a 0a 23 20 4e 4f 54 45 3a 20 65 78 ----..# NOTE: ex
92a0: 61 6d 70 6c 65 73 20 61 74 20 74 68 65 20 65 6e amples at the en
92b0: 64 0a 0a 23 20 73 74 79 6c 65 3a 20 72 69 64 67 d..# style: ridg
92c0: 65 66 72 61 6d 65 20 6f 72 20 73 65 70 61 72 61 eframe or separa
92d0: 74 6f 72 0a 23 20 65 6e 74 72 79 74 79 70 65 3a tor.# entrytype:
92e0: 20 65 6e 74 72 79 20 6f 72 20 6e 6f 6e 65 64 69 entry or nonedi
92f0: 74 61 62 6c 65 5f 65 6e 74 72 79 20 6f 72 20 70 table_entry or p
9300: 61 73 73 77 6f 72 64 0a 23 20 2d 63 61 6c 6c 62 assword.# -callb
9310: 61 63 6b 3a 20 63 61 6c 6c 73 20 66 75 6e 63 74 ack: calls funct
9320: 69 6f 6e 20 77 68 65 6e 20 75 73 65 72 20 70 72 ion when user pr
9330: 65 73 73 65 73 20 61 20 62 75 74 74 6f 6e 2e 20 esses a button.
9340: 41 64 64 73 20 61 72 67 75 6d 65 6e 74 20 24 77 Adds argument $w
9350: 0a 0a 73 6e 69 74 3a 3a 77 69 64 67 65 74 20 64 ..snit::widget d
9360: 69 61 6c 6f 67 77 69 6e 5f 73 6e 69 74 20 7b 0a ialogwin_snit {.
9370: 20 20 20 20 6f 70 74 69 6f 6e 20 2d 74 69 74 6c option -titl
9380: 65 20 22 22 0a 20 20 20 20 6f 70 74 69 6f 6e 20 e "". option
9390: 2d 73 74 79 6c 65 20 73 65 70 61 72 61 74 6f 72 -style separator
93a0: 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d 67 72 61 . option -gra
93b0: 62 20 31 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d b 1. option -
93c0: 74 72 61 6e 73 69 65 6e 74 20 30 0a 20 20 20 20 transient 0.
93d0: 6f 70 74 69 6f 6e 20 2d 63 61 6c 6c 62 61 63 6b option -callback
93e0: 20 22 22 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d "". option -
93f0: 6d 6f 72 65 62 75 74 74 6f 6e 73 20 22 22 0a 20 morebuttons "".
9400: 20 20 20 6f 70 74 69 6f 6e 20 2d 6f 6b 6e 61 6d option -oknam
9410: 65 20 22 22 0a 20 20 20 20 6f 70 74 69 6f 6e 20 e "". option
9420: 2d 63 61 6e 63 65 6c 6e 61 6d 65 20 22 22 0a 20 -cancelname "".
9430: 20 20 20 6f 70 74 69 6f 6e 20 2d 67 65 6f 6d 65 option -geome
9440: 74 72 79 20 22 22 0a 20 20 20 20 6f 70 74 69 6f try "". optio
9450: 6e 20 2d 6d 69 6e 77 69 64 74 68 20 22 22 0a 20 n -minwidth "".
9460: 20 20 20 6f 70 74 69 6f 6e 20 2d 6d 69 6e 68 65 option -minhe
9470: 69 67 68 74 20 22 22 0a 0a 20 20 20 20 6f 70 74 ight "".. opt
9480: 69 6f 6e 20 2d 65 6e 74 72 79 74 79 70 65 20 22 ion -entrytype "
9490: 22 20 3b 23 20 65 6e 74 72 79 2c 70 61 73 73 77 " ;# entry,passw
94a0: 6f 72 64 2c 6e 6f 6e 65 64 69 74 61 62 6c 65 5f ord,noneditable_
94b0: 65 6e 74 72 79 0a 20 20 20 20 6f 70 74 69 6f 6e entry. option
94c0: 20 2d 65 6e 74 72 79 74 65 78 74 20 22 22 0a 20 -entrytext "".
94d0: 20 20 20 6f 70 74 69 6f 6e 20 2d 65 6e 74 72 79 option -entry
94e0: 6c 61 62 65 6c 20 22 22 0a 20 20 20 20 6f 70 74 label "". opt
94f0: 69 6f 6e 20 2d 65 6e 74 72 79 64 65 66 61 75 6c ion -entrydefaul
9500: 74 20 22 22 0a 20 20 20 20 6f 70 74 69 6f 6e 20 t "". option
9510: 2d 65 6e 74 72 79 76 61 6c 75 65 73 20 22 22 0a -entryvalues "".
9520: 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d 72 65 70 . option -rep
9530: 65 61 74 5f 61 6e 73 77 65 72 5f 63 68 65 63 6b eat_answer_check
9540: 20 30 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d 66 0. option -f
9550: 72 61 6d 65 5f 67 72 69 64 5f 63 6d 64 20 22 22 rame_grid_cmd ""
9560: 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d 74 6f 70 . option -top
9570: 6c 65 76 65 6c 5f 63 6d 64 20 22 22 0a 20 20 20 level_cmd "".
9580: 20 6f 70 74 69 6f 6e 20 2d 73 68 6f 77 5f 66 72 option -show_fr
9590: 61 6d 65 5f 74 6f 70 6c 65 76 65 6c 5f 74 6f 67 ame_toplevel_tog
95a0: 67 6c 65 20 31 0a 20 20 20 20 6f 70 74 69 6f 6e gle 1. option
95b0: 20 2d 66 72 61 6d 65 5f 74 6f 70 6c 65 76 65 6c -frame_toplevel
95c0: 20 74 6f 70 6c 65 76 65 6c 0a 20 20 20 20 6f 70 toplevel. op
95d0: 74 69 6f 6e 20 2d 74 6f 70 62 75 74 74 6f 6e 73 tion -topbuttons
95e0: 20 30 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d 64 0. option -d
95f0: 6f 63 6b 6d 65 6e 75 20 22 22 0a 0a 20 20 20 20 ockmenu ""..
9600: 69 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 if { $::tcl_plat
9610: 66 6f 72 6d 28 6f 73 29 20 6e 65 20 22 44 61 72 form(os) ne "Dar
9620: 77 69 6e 22 20 7d 20 7b 0a 09 68 75 6c 6c 74 79 win" } {..hullty
9630: 70 65 20 66 72 61 6d 65 0a 20 20 20 20 7d 20 65 pe frame. } e
9640: 6c 73 65 20 7b 0a 09 68 75 6c 6c 74 79 70 65 20 lse {..hulltype
9650: 74 6f 70 6c 65 76 65 6c 0a 20 20 20 20 7d 0a 20 toplevel. }.
9660: 20 20 20 64 65 6c 65 67 61 74 65 20 6d 65 74 68 delegate meth
9670: 6f 64 20 2a 20 74 6f 20 68 75 6c 6c 0a 20 20 20 od * to hull.
9680: 20 64 65 6c 65 67 61 74 65 20 6f 70 74 69 6f 6e delegate option
9690: 20 2a 20 74 6f 20 68 75 6c 6c 0a 0a 20 20 20 20 * to hull..
96a0: 76 61 72 69 61 62 6c 65 20 61 63 74 69 6f 6e 20 variable action
96b0: 2d 31 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 -1. variable
96c0: 6f 6c 64 47 72 61 62 20 22 22 0a 20 20 20 20 76 oldGrab "". v
96d0: 61 72 69 61 62 6c 65 20 6f 6c 64 46 6f 63 75 73 ariable oldFocus
96e0: 20 22 22 0a 20 20 20 20 76 61 72 69 61 62 6c 65 "". variable
96f0: 20 67 72 61 62 53 74 61 74 75 73 0a 20 20 20 20 grabStatus.
9700: 76 61 72 69 61 62 6c 65 20 65 6e 74 72 79 76 61 variable entryva
9710: 6c 75 65 0a 20 20 20 20 76 61 72 69 61 62 6c 65 lue. variable
9720: 20 72 65 70 65 61 74 5f 6d 79 5f 61 6e 73 77 65 repeat_my_answe
9730: 72 20 30 0a 20 20 20 20 76 61 72 69 61 62 6c 65 r 0. variable
9740: 20 75 73 65 72 76 61 72 0a 20 20 20 20 76 61 72 uservar. var
9750: 69 61 62 6c 65 20 74 79 70 65 75 73 65 72 76 61 iable typeuserva
9760: 72 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 74 r. variable t
9770: 72 61 63 65 73 20 22 22 0a 20 20 20 20 76 61 72 races "". var
9780: 69 61 62 6c 65 20 64 65 73 74 72 6f 79 5f 68 61 iable destroy_ha
9790: 6e 64 6c 65 72 73 20 22 22 0a 0a 20 20 20 20 63 ndlers "".. c
97a0: 6f 6e 73 74 72 75 63 74 6f 72 20 61 72 67 73 20 onstructor args
97b0: 7b 0a 09 24 73 65 6c 66 20 63 6f 6e 66 69 67 75 {..$self configu
97c0: 72 65 6c 69 73 74 20 24 61 72 67 73 0a 0a 09 69 relist $args...i
97d0: 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 66 72 f { $options(-fr
97e0: 61 6d 65 5f 74 6f 70 6c 65 76 65 6c 29 20 65 71 ame_toplevel) eq
97f0: 20 22 74 6f 70 6c 65 76 65 6c 22 20 7d 20 7b 0a "toplevel" } {.
9800: 09 20 20 20 20 69 66 20 7b 20 24 3a 3a 74 63 6c . if { $::tcl
9810: 5f 70 6c 61 74 66 6f 72 6d 28 6f 73 29 20 6e 65 _platform(os) ne
9820: 20 22 44 61 72 77 69 6e 22 20 7d 20 7b 0a 09 09 "Darwin" } {...
9830: 77 6d 20 6d 61 6e 61 67 65 20 24 77 69 6e 0a 09 wm manage $win..
9840: 20 20 20 20 7d 0a 09 20 20 20 20 77 6d 20 77 69 }.. wm wi
9850: 74 68 64 72 61 77 20 24 77 69 6e 0a 09 7d 0a 09 thdraw $win..}..
9860: 69 66 20 7b 30 26 26 20 5b 69 6e 66 6f 20 63 6f if {0&& [info co
9870: 6d 6d 61 6e 64 73 20 74 74 6b 3a 3a 62 75 74 74 mmands ttk::butt
9880: 6f 6e 5d 20 65 71 20 22 22 20 7d 20 7b 0a 09 20 on] eq "" } {..
9890: 20 20 20 73 65 74 20 62 75 74 74 6f 6e 5f 63 6d set button_cm
98a0: 64 20 62 75 74 74 6f 6e 0a 09 20 20 20 20 73 65 d button.. se
98b0: 74 20 6c 61 62 65 6c 5f 63 6d 64 20 6c 61 62 65 t label_cmd labe
98c0: 6c 0a 09 20 20 20 20 73 65 74 20 65 6e 74 72 79 l.. set entry
98d0: 5f 63 6d 64 20 65 6e 74 72 79 0a 09 20 20 20 20 _cmd entry..
98e0: 73 65 74 20 63 6f 6d 62 6f 5f 63 6d 64 20 43 6f set combo_cmd Co
98f0: 6d 62 6f 42 6f 78 0a 09 20 20 20 20 73 65 74 20 mboBox.. set
9900: 66 72 61 6d 65 5f 63 6d 64 20 66 72 61 6d 65 0a frame_cmd frame.
9910: 09 20 20 20 20 73 65 74 20 63 68 65 63 6b 62 75 . set checkbu
9920: 74 74 6f 6e 5f 63 6d 64 20 63 68 65 63 6b 62 75 tton_cmd checkbu
9930: 74 74 6f 6e 0a 09 20 20 20 20 73 65 74 20 72 61 tton.. set ra
9940: 64 69 6f 62 75 74 74 6f 6e 5f 63 6d 64 20 72 61 diobutton_cmd ra
9950: 64 69 6f 62 75 74 74 6f 6e 0a 09 7d 20 65 6c 73 diobutton..} els
9960: 65 20 7b 0a 09 20 20 20 20 73 65 74 20 62 75 74 e {.. set but
9970: 74 6f 6e 5f 63 6d 64 20 74 74 6b 3a 3a 62 75 74 ton_cmd ttk::but
9980: 74 6f 6e 0a 09 20 20 20 20 73 65 74 20 6c 61 62 ton.. set lab
9990: 65 6c 5f 63 6d 64 20 74 74 6b 3a 3a 6c 61 62 65 el_cmd ttk::labe
99a0: 6c 0a 09 20 20 20 20 73 65 74 20 65 6e 74 72 79 l.. set entry
99b0: 5f 63 6d 64 20 74 74 6b 3a 3a 65 6e 74 72 79 0a _cmd ttk::entry.
99c0: 09 20 20 20 20 73 65 74 20 63 6f 6d 62 6f 5f 63 . set combo_c
99d0: 6d 64 20 74 74 6b 3a 3a 63 6f 6d 62 6f 62 6f 78 md ttk::combobox
99e0: 0a 09 20 20 20 20 73 65 74 20 66 72 61 6d 65 5f .. set frame_
99f0: 63 6d 64 20 74 74 6b 3a 3a 66 72 61 6d 65 0a 09 cmd ttk::frame..
9a00: 20 20 20 20 73 65 74 20 63 68 65 63 6b 62 75 74 set checkbut
9a10: 74 6f 6e 5f 63 6d 64 20 74 74 6b 3a 3a 63 68 65 ton_cmd ttk::che
9a20: 63 6b 62 75 74 74 6f 6e 0a 09 20 20 20 20 73 65 ckbutton.. se
9a30: 74 20 72 61 64 69 6f 62 75 74 74 6f 6e 5f 63 6d t radiobutton_cm
9a40: 64 20 74 74 6b 3a 3a 72 61 64 69 6f 62 75 74 74 d ttk::radiobutt
9a50: 6f 6e 0a 09 7d 0a 09 69 66 20 7b 20 24 6f 70 74 on..}..if { $opt
9a60: 69 6f 6e 73 28 2d 6f 6b 6e 61 6d 65 29 20 65 71 ions(-okname) eq
9a70: 20 22 22 20 7d 20 7b 20 73 65 74 20 6f 70 74 69 "" } { set opti
9a80: 6f 6e 73 28 2d 6f 6b 6e 61 6d 65 29 20 5b 5f 20 ons(-okname) [_
9a90: 22 4f 6b 22 5d 20 7d 0a 09 69 66 20 7b 20 24 6f "Ok"] }..if { $o
9aa0: 70 74 69 6f 6e 73 28 2d 63 61 6e 63 65 6c 6e 61 ptions(-cancelna
9ab0: 6d 65 29 20 65 71 20 22 22 20 7d 20 7b 0a 09 20 me) eq "" } {..
9ac0: 20 20 20 73 65 74 20 6f 70 74 69 6f 6e 73 28 2d set options(-
9ad0: 63 61 6e 63 65 6c 6e 61 6d 65 29 20 5b 5f 20 22 cancelname) [_ "
9ae0: 43 61 6e 63 65 6c 22 5d 0a 09 0a 09 20 20 20 20 Cancel"]....
9af0: 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 6f if { $options(-o
9b00: 6b 6e 61 6d 65 29 20 65 71 20 22 2d 22 20 26 26 kname) eq "-" &&
9b10: 20 24 6f 70 74 69 6f 6e 73 28 2d 6d 6f 72 65 62 $options(-moreb
9b20: 75 74 74 6f 6e 73 29 20 65 71 20 22 22 20 7d 20 uttons) eq "" }
9b30: 7b 0a 09 09 73 65 74 20 6f 70 74 69 6f 6e 73 28 {...set options(
9b40: 2d 63 61 6e 63 65 6c 6e 61 6d 65 29 20 5b 5f 20 -cancelname) [_
9b50: 22 43 6c 6f 73 65 22 5d 0a 09 20 20 20 20 7d 0a "Close"].. }.
9b60: 09 7d 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e .}..if { $option
9b70: 73 28 2d 66 72 61 6d 65 5f 67 72 69 64 5f 63 6d s(-frame_grid_cm
9b80: 64 29 20 65 71 20 22 22 20 7d 20 7b 0a 09 20 20 d) eq "" } {..
9b90: 20 20 73 65 74 20 73 68 6f 77 5f 66 72 61 6d 65 set show_frame
9ba0: 5f 74 6f 70 6c 65 76 65 6c 5f 74 6f 67 67 6c 65 _toplevel_toggle
9bb0: 20 30 0a 09 20 20 20 20 73 65 74 20 74 6f 70 62 0.. set topb
9bc0: 75 74 74 6f 6e 73 20 30 0a 09 7d 20 65 6c 73 65 uttons 0..} else
9bd0: 20 7b 0a 09 20 20 20 20 73 65 74 20 73 68 6f 77 {.. set show
9be0: 5f 66 72 61 6d 65 5f 74 6f 70 6c 65 76 65 6c 5f _frame_toplevel_
9bf0: 74 6f 67 67 6c 65 20 24 6f 70 74 69 6f 6e 73 28 toggle $options(
9c00: 2d 73 68 6f 77 5f 66 72 61 6d 65 5f 74 6f 70 6c -show_frame_topl
9c10: 65 76 65 6c 5f 74 6f 67 67 6c 65 29 0a 09 20 20 evel_toggle)..
9c20: 20 20 73 65 74 20 74 6f 70 62 75 74 74 6f 6e 73 set topbuttons
9c30: 20 24 6f 70 74 69 6f 6e 73 28 2d 74 6f 70 62 75 $options(-topbu
9c40: 74 74 6f 6e 73 29 0a 09 7d 0a 09 73 65 74 20 63 ttons)..}..set c
9c50: 75 72 72 65 6e 74 5f 72 6f 77 20 2d 31 0a 09 69 urrent_row -1..i
9c60: 66 20 7b 20 24 74 6f 70 62 75 74 74 6f 6e 73 20 f { $topbuttons
9c70: 7c 7c 20 24 73 68 6f 77 5f 66 72 61 6d 65 5f 74 || $show_frame_t
9c80: 6f 70 6c 65 76 65 6c 5f 74 6f 67 67 6c 65 20 7d oplevel_toggle }
9c90: 20 7b 0a 09 20 20 20 20 74 74 6b 3a 3a 66 72 61 {.. ttk::fra
9ca0: 6d 65 20 24 77 69 6e 2e 66 30 0a 09 20 20 20 20 me $win.f0..
9cb0: 69 66 20 7b 20 24 73 68 6f 77 5f 66 72 61 6d 65 if { $show_frame
9cc0: 5f 74 6f 70 6c 65 76 65 6c 5f 74 6f 67 67 6c 65 _toplevel_toggle
9cd0: 20 7d 20 7b 0a 09 09 66 72 61 6d 65 20 24 77 69 } {...frame $wi
9ce0: 6e 2e 66 30 2e 63 20 2d 62 61 63 6b 67 72 6f 75 n.f0.c -backgrou
9cf0: 6e 64 20 23 38 38 30 30 30 30 20 2d 62 64 20 31 nd #880000 -bd 1
9d00: 20 2d 72 65 6c 69 65 66 20 73 6f 6c 69 64 20 2d -relief solid -
9d10: 68 65 69 67 68 74 20 34 20 5c 0a 09 09 20 20 20 height 4 \...
9d20: 20 2d 63 75 72 73 6f 72 20 68 61 6e 64 32 0a 09 -cursor hand2..
9d30: 09 62 69 6e 64 20 24 77 69 6e 2e 66 30 2e 63 20 .bind $win.f0.c
9d40: 3c 42 75 74 74 6f 6e 52 65 6c 65 61 73 65 2d 31 <ButtonRelease-1
9d50: 3e 20 5b 6d 79 6d 65 74 68 6f 64 20 74 6f 6f 67 > [mymethod toog
9d60: 6c 65 5f 66 72 61 6d 65 5f 74 6f 70 6c 65 76 65 le_frame_topleve
9d70: 6c 5d 0a 09 09 62 69 6e 64 20 24 77 69 6e 2e 66 l]...bind $win.f
9d80: 30 2e 63 20 3c 42 75 74 74 6f 6e 52 65 6c 65 61 0.c <ButtonRelea
9d90: 73 65 2d 33 3e 20 5b 6d 79 6d 65 74 68 6f 64 20 se-3> [mymethod
9da0: 63 6f 6e 74 65 78 74 75 61 6c 5f 64 6f 63 6b 5f contextual_dock_
9db0: 6d 65 6e 75 20 25 58 20 25 59 5d 0a 0a 09 09 74 menu %X %Y]....t
9dc0: 6f 6f 6c 74 69 70 3a 3a 74 6f 6f 6c 74 69 70 20 ooltip::tooltip
9dd0: 24 77 69 6e 2e 66 30 2e 63 20 5b 5f 20 22 50 72 $win.f0.c [_ "Pr
9de0: 65 73 73 20 68 65 72 65 20 74 6f 20 64 6f 63 6b ess here to dock
9df0: 20 6f 72 20 75 6e 64 6f 63 6b 20 74 68 65 20 77 or undock the w
9e00: 69 6e 64 6f 77 22 5d 0a 09 09 0a 09 09 67 72 69 indow"]......gri
9e10: 64 20 24 77 69 6e 2e 66 30 2e 63 20 2d 73 74 69 d $win.f0.c -sti
9e20: 63 6b 79 20 65 77 20 2d 72 6f 77 20 30 20 2d 63 cky ew -row 0 -c
9e30: 6f 6c 75 6d 6e 20 30 0a 09 20 20 20 20 7d 0a 09 olumn 0.. }..
9e40: 20 20 20 20 67 72 69 64 20 63 6f 6c 75 6d 6e 63 grid columnc
9e50: 6f 6e 66 69 67 75 72 65 20 24 77 69 6e 2e 66 30 onfigure $win.f0
9e60: 20 30 20 2d 77 65 69 67 68 74 20 31 0a 0a 09 20 0 -weight 1...
9e70: 20 20 20 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 if { $options
9e80: 28 2d 74 6f 70 62 75 74 74 6f 6e 73 29 20 7d 20 (-topbuttons) }
9e90: 7b 0a 09 09 74 74 6b 3a 3a 66 72 61 6d 65 20 24 {...ttk::frame $
9ea0: 77 69 6e 2e 66 30 2e 62 75 74 73 0a 09 09 73 65 win.f0.buts...se
9eb0: 74 20 63 6f 6c 20 30 0a 09 09 69 66 20 7b 20 24 t col 0...if { $
9ec0: 6f 70 74 69 6f 6e 73 28 2d 6f 6b 6e 61 6d 65 29 options(-okname)
9ed0: 20 6e 65 20 22 2d 22 20 7d 20 7b 0a 09 09 20 20 ne "-" } {...
9ee0: 20 20 74 74 6b 3a 3a 62 75 74 74 6f 6e 20 24 77 ttk::button $w
9ef0: 69 6e 2e 66 30 2e 62 75 74 73 2e 62 31 20 2d 69 in.f0.buts.b1 -i
9f00: 6d 61 67 65 20 69 6d 67 3a 3a 6f 6b 2d 31 36 20 mage img::ok-16
9f10: 2d 63 6f 6d 6d 61 6e 64 20 5b 6d 79 6d 65 74 68 -command [mymeth
9f20: 6f 64 20 5f 61 70 70 6c 79 61 63 74 69 6f 6e 20 od _applyaction
9f30: 31 5d 20 5c 0a 09 09 20 20 20 20 20 20 20 20 2d 1] \... -
9f40: 73 74 79 6c 65 20 54 6f 6f 6c 62 75 74 74 6f 6e style Toolbutton
9f50: 0a 09 09 20 20 20 20 74 6f 6f 6c 74 69 70 3a 3a ... tooltip::
9f60: 74 6f 6f 6c 74 69 70 20 24 77 69 6e 2e 66 30 2e tooltip $win.f0.
9f70: 62 75 74 73 2e 62 31 20 24 6f 70 74 69 6f 6e 73 buts.b1 $options
9f80: 28 2d 6f 6b 6e 61 6d 65 29 0a 09 09 20 20 20 20 (-okname)...
9f90: 67 72 69 64 20 24 77 69 6e 2e 66 30 2e 62 75 74 grid $win.f0.but
9fa0: 73 2e 62 31 20 2d 72 6f 77 20 30 20 2d 63 6f 6c s.b1 -row 0 -col
9fb0: 75 6d 6e 20 24 63 6f 6c 0a 09 09 20 20 20 20 69 umn $col... i
9fc0: 6e 63 72 20 63 6f 6c 0a 09 09 7d 0a 09 09 69 66 ncr col...}...if
9fd0: 20 7b 20 5b 6c 6c 65 6e 67 74 68 20 24 6f 70 74 { [llength $opt
9fe0: 69 6f 6e 73 28 2d 6d 6f 72 65 62 75 74 74 6f 6e ions(-morebutton
9ff0: 73 29 5d 20 3d 3d 20 31 20 7d 20 7b 0a 09 09 20 s)] == 1 } {...
a000: 20 20 20 24 77 69 6e 2e 66 30 2e 62 75 74 73 2e $win.f0.buts.
a010: 62 31 20 63 6f 6e 66 69 67 75 72 65 20 2d 69 6d b1 configure -im
a020: 61 67 65 20 69 6d 67 3a 3a 6f 6b 2d 63 6c 6f 73 age img::ok-clos
a030: 65 2d 31 36 0a 09 09 20 20 20 20 74 74 6b 3a 3a e-16... ttk::
a040: 62 75 74 74 6f 6e 20 24 77 69 6e 2e 66 30 2e 62 button $win.f0.b
a050: 75 74 73 2e 62 32 20 2d 69 6d 61 67 65 20 69 6d uts.b2 -image im
a060: 67 3a 3a 6f 6b 2d 31 36 20 2d 63 6f 6d 6d 61 6e g::ok-16 -comman
a070: 64 20 5b 6d 79 6d 65 74 68 6f 64 20 5f 61 70 70 d [mymethod _app
a080: 6c 79 61 63 74 69 6f 6e 20 32 5d 20 5c 0a 09 09 lyaction 2] \...
a090: 20 20 20 20 20 20 20 20 2d 73 74 79 6c 65 20 54 -style T
a0a0: 6f 6f 6c 62 75 74 74 6f 6e 0a 09 09 20 20 20 20 oolbutton...
a0b0: 74 6f 6f 6c 74 69 70 3a 3a 74 6f 6f 6c 74 69 70 tooltip::tooltip
a0c0: 20 24 77 69 6e 2e 66 30 2e 62 75 74 73 2e 62 32 $win.f0.buts.b2
a0d0: 20 5b 6c 69 6e 64 65 78 20 24 6f 70 74 69 6f 6e [lindex $option
a0e0: 73 28 2d 6d 6f 72 65 62 75 74 74 6f 6e 73 29 20 s(-morebuttons)
a0f0: 30 5d 0a 09 09 20 20 20 20 67 72 69 64 20 24 77 0]... grid $w
a100: 69 6e 2e 66 30 2e 62 75 74 73 2e 62 32 20 2d 72 in.f0.buts.b2 -r
a110: 6f 77 20 30 20 2d 63 6f 6c 75 6d 6e 20 24 63 6f ow 0 -column $co
a120: 6c 0a 09 09 20 20 20 20 69 6e 63 72 20 63 6f 6c l... incr col
a130: 0a 09 09 7d 20 65 6c 73 65 69 66 20 7b 20 5b 6c ...} elseif { [l
a140: 6c 65 6e 67 74 68 20 24 6f 70 74 69 6f 6e 73 28 length $options(
a150: 2d 6d 6f 72 65 62 75 74 74 6f 6e 73 29 5d 20 7d -morebuttons)] }
a160: 20 7b 0a 09 09 20 20 20 20 74 74 6b 3a 3a 6d 65 {... ttk::me
a170: 6e 75 62 75 74 74 6f 6e 20 24 77 69 6e 2e 66 30 nubutton $win.f0
a180: 2e 62 75 74 73 2e 62 32 20 2d 69 6d 61 67 65 20 .buts.b2 -image
a190: 69 6d 67 3a 3a 6e 61 76 31 64 6f 77 6e 61 72 72 img::nav1downarr
a1a0: 6f 77 31 36 20 2d 6d 65 6e 75 20 24 77 69 6e 2e ow16 -menu $win.
a1b0: 66 30 2e 62 75 74 73 2e 62 32 2e 6d 20 5c 0a 09 f0.buts.b2.m \..
a1c0: 09 20 20 20 20 20 20 20 20 2d 73 74 79 6c 65 20 . -style
a1d0: 54 6f 6f 6c 62 75 74 74 6f 6e 0a 09 09 20 20 20 Toolbutton...
a1e0: 20 6d 65 6e 75 20 24 77 69 6e 2e 66 30 2e 62 75 menu $win.f0.bu
a1f0: 74 73 2e 62 32 2e 6d 20 2d 74 65 61 72 6f 66 66 ts.b2.m -tearoff
a200: 20 30 0a 09 09 20 20 20 20 73 65 74 20 69 61 63 0... set iac
a210: 74 69 6f 6e 20 32 0a 09 09 20 20 20 20 66 6f 72 tion 2... for
a220: 65 61 63 68 20 74 78 74 20 24 6f 70 74 69 6f 6e each txt $option
a230: 73 28 2d 6d 6f 72 65 62 75 74 74 6f 6e 73 29 20 s(-morebuttons)
a240: 7b 0a 09 09 20 20 20 20 20 20 20 20 24 77 69 6e {... $win
a250: 2e 66 30 2e 62 75 74 73 2e 62 32 2e 6d 20 61 64 .f0.buts.b2.m ad
a260: 64 20 63 6f 6d 6d 61 6e 64 20 2d 6c 61 62 65 6c d command -label
a270: 20 24 74 78 74 20 2d 63 6f 6d 6d 61 6e 64 20 5b $txt -command [
a280: 6d 79 6d 65 74 68 6f 64 20 5f 61 70 70 6c 79 61 mymethod _applya
a290: 63 74 69 6f 6e 20 24 69 61 63 74 69 6f 6e 5d 0a ction $iaction].
a2a0: 09 09 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 .. incr i
a2b0: 61 63 74 69 6f 6e 0a 09 09 20 20 20 20 7d 0a 09 action... }..
a2c0: 09 20 20 20 20 67 72 69 64 20 24 77 69 6e 2e 66 . grid $win.f
a2d0: 30 2e 62 75 74 73 2e 62 32 20 2d 72 6f 77 20 30 0.buts.b2 -row 0
a2e0: 20 2d 63 6f 6c 75 6d 6e 20 24 63 6f 6c 0a 09 09 -column $col...
a2f0: 20 20 20 20 69 6e 63 72 20 63 6f 6c 0a 09 09 7d incr col...}
a300: 0a 09 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 ...if { $options
a310: 28 2d 63 61 6e 63 65 6c 6e 61 6d 65 29 20 6e 65 (-cancelname) ne
a320: 20 22 2d 22 20 7d 20 7b 0a 09 09 20 20 20 20 74 "-" } {... t
a330: 74 6b 3a 3a 62 75 74 74 6f 6e 20 24 77 69 6e 2e tk::button $win.
a340: 66 30 2e 62 75 74 73 2e 62 33 20 2d 69 6d 61 67 f0.buts.b3 -imag
a350: 65 20 69 6d 67 3a 3a 66 69 6c 65 63 6c 6f 73 65 e img::fileclose
a360: 31 36 20 2d 63 6f 6d 6d 61 6e 64 20 5b 6d 79 6d 16 -command [mym
a370: 65 74 68 6f 64 20 5f 61 70 70 6c 79 61 63 74 69 ethod _applyacti
a380: 6f 6e 20 30 5d 20 5c 0a 09 09 20 20 20 20 20 20 on 0] \...
a390: 20 20 2d 73 74 79 6c 65 20 54 6f 6f 6c 62 75 74 -style Toolbut
a3a0: 74 6f 6e 0a 09 09 20 20 20 20 74 6f 6f 6c 74 69 ton... toolti
a3b0: 70 3a 3a 74 6f 6f 6c 74 69 70 20 24 77 69 6e 2e p::tooltip $win.
a3c0: 66 30 2e 62 75 74 73 2e 62 33 20 24 6f 70 74 69 f0.buts.b3 $opti
a3d0: 6f 6e 73 28 2d 63 61 6e 63 65 6c 6e 61 6d 65 29 ons(-cancelname)
a3e0: 0a 09 09 20 20 20 20 67 72 69 64 20 24 77 69 6e ... grid $win
a3f0: 2e 66 30 2e 62 75 74 73 2e 62 33 20 2d 72 6f 77 .f0.buts.b3 -row
a400: 20 30 20 2d 63 6f 6c 75 6d 6e 20 24 63 6f 6c 0a 0 -column $col.
a410: 09 09 20 20 20 20 69 6e 63 72 20 63 6f 6c 0a 09 .. incr col..
a420: 09 7d 0a 09 09 67 72 69 64 20 24 77 69 6e 2e 66 .}...grid $win.f
a430: 30 2e 62 75 74 73 20 2d 72 6f 77 20 30 20 2d 63 0.buts -row 0 -c
a440: 6f 6c 75 6d 6e 20 31 20 2d 73 74 69 63 6b 79 20 olumn 1 -sticky
a450: 65 20 2d 73 74 69 63 6b 79 20 65 77 0a 09 20 20 e -sticky ew..
a460: 20 20 7d 0a 09 20 20 20 20 67 72 69 64 20 24 77 }.. grid $w
a470: 69 6e 2e 66 30 20 2d 73 74 69 63 6b 79 20 65 77 in.f0 -sticky ew
a480: 20 2d 70 61 64 78 20 32 20 2d 70 61 64 79 20 30 -padx 2 -pady 0
a490: 0a 09 20 20 20 20 69 6e 63 72 20 63 75 72 72 65 .. incr curre
a4a0: 6e 74 5f 72 6f 77 0a 09 7d 20 65 6c 73 65 20 7b nt_row..} else {
a4b0: 0a 09 20 20 20 20 73 65 74 20 6f 70 74 69 6f 6e .. set option
a4c0: 73 28 2d 74 6f 70 62 75 74 74 6f 6e 73 29 20 30 s(-topbuttons) 0
a4d0: 0a 09 7d 0a 09 73 77 69 74 63 68 20 24 6f 70 74 ..}..switch $opt
a4e0: 69 6f 6e 73 28 2d 73 74 79 6c 65 29 20 7b 0a 09 ions(-style) {..
a4f0: 20 20 20 20 72 69 64 67 65 66 72 61 6d 65 20 7b ridgeframe {
a500: 0a 09 09 24 66 72 61 6d 65 5f 63 6d 64 20 24 77 ...$frame_cmd $w
a510: 69 6e 2e 66 0a 09 09 63 61 74 63 68 20 7b 20 24 in.f...catch { $
a520: 77 69 6e 2e 66 20 63 6f 6e 66 69 67 75 72 65 20 win.f configure
a530: 2d 72 65 6c 69 65 66 20 72 69 64 67 65 20 2d 62 -relief ridge -b
a540: 64 20 32 20 7d 0a 09 09 66 72 61 6d 65 20 24 77 d 2 }...frame $w
a550: 69 6e 2e 62 75 74 73 0a 09 09 67 72 69 64 20 24 in.buts...grid $
a560: 77 69 6e 2e 66 20 2d 73 74 69 63 6b 79 20 65 77 win.f -sticky ew
a570: 6e 73 20 2d 70 61 64 78 20 32 20 2d 70 61 64 79 ns -padx 2 -pady
a580: 20 32 0a 09 09 69 6e 63 72 20 63 75 72 72 65 6e 2...incr curren
a590: 74 5f 72 6f 77 0a 09 09 67 72 69 64 20 24 77 69 t_row...grid $wi
a5a0: 6e 2e 62 75 74 73 20 2d 73 74 69 63 6b 79 20 65 n.buts -sticky e
a5b0: 77 0a 09 09 63 61 74 63 68 20 7b 20 67 72 69 64 w...catch { grid
a5c0: 20 61 6e 63 68 6f 72 20 24 77 69 6e 2e 62 75 74 anchor $win.but
a5d0: 73 20 63 65 6e 74 65 72 20 7d 0a 09 20 20 20 20 s center }..
a5e0: 7d 0a 09 20 20 20 20 73 65 70 61 72 61 74 6f 72 }.. separator
a5f0: 20 2d 20 73 65 70 61 72 61 74 6f 72 5f 72 69 67 - separator_rig
a600: 68 74 20 7b 0a 09 09 24 66 72 61 6d 65 5f 63 6d ht {...$frame_cm
a610: 64 20 24 77 69 6e 2e 66 0a 09 09 63 61 74 63 68 d $win.f...catch
a620: 20 7b 20 24 77 69 6e 2e 66 20 63 6f 6e 66 69 67 { $win.f config
a630: 75 72 65 20 2d 62 64 20 30 20 7d 0a 09 09 66 72 ure -bd 0 }...fr
a640: 61 6d 65 20 24 77 69 6e 2e 73 65 70 20 2d 62 64 ame $win.sep -bd
a650: 20 32 20 2d 72 65 6c 69 65 66 20 72 61 69 73 65 2 -relief raise
a660: 64 20 2d 68 65 69 67 68 74 20 32 0a 09 09 66 72 d -height 2...fr
a670: 61 6d 65 20 24 77 69 6e 2e 62 75 74 73 0a 09 09 ame $win.buts...
a680: 67 72 69 64 20 24 77 69 6e 2e 66 20 2d 73 74 69 grid $win.f -sti
a690: 63 6b 79 20 65 77 6e 73 20 2d 70 61 64 78 20 32 cky ewns -padx 2
a6a0: 20 2d 70 61 64 79 20 32 0a 09 09 69 6e 63 72 20 -pady 2...incr
a6b0: 63 75 72 72 65 6e 74 5f 72 6f 77 0a 09 09 67 72 current_row...gr
a6c0: 69 64 20 24 77 69 6e 2e 73 65 70 20 2d 73 74 69 id $win.sep -sti
a6d0: 63 6b 79 20 65 77 0a 09 09 67 72 69 64 20 24 77 cky ew...grid $w
a6e0: 69 6e 2e 62 75 74 73 20 2d 73 74 69 63 6b 79 20 in.buts -sticky
a6f0: 65 77 0a 09 09 63 61 74 63 68 20 7b 20 67 72 69 ew...catch { gri
a700: 64 20 61 6e 63 68 6f 72 20 24 77 69 6e 2e 62 75 d anchor $win.bu
a710: 74 73 20 63 65 6e 74 65 72 20 7d 0a 09 20 20 20 ts center }..
a720: 20 7d 0a 09 20 20 20 20 64 65 66 61 75 6c 74 20 }.. default
a730: 7b 0a 09 09 65 72 72 6f 72 20 22 65 72 72 6f 72 {...error "error
a740: 3a 20 6f 6e 6c 79 20 61 63 63 65 70 74 65 64 20 : only accepted
a750: 73 74 79 6c 65 73 20 72 69 64 67 65 66 72 61 6d styles ridgefram
a760: 65 20 61 6e 64 20 73 65 70 61 72 61 74 6f 72 22 e and separator"
a770: 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 24 77 69 6e .. }..}..$win
a780: 2e 62 75 74 73 20 63 6f 6e 66 20 2d 62 61 63 6b .buts conf -back
a790: 67 72 6f 75 6e 64 20 5b 43 43 43 6f 6c 6f 72 41 ground [CCColorA
a7a0: 63 74 69 76 6f 20 5b 24 77 69 6e 20 63 67 65 74 ctivo [$win cget
a7b0: 20 2d 62 61 63 6b 67 72 6f 75 6e 64 5d 5d 0a 09 -background]]..
a7c0: 0a 09 67 72 69 64 20 63 6f 6c 75 6d 6e 63 6f 6e ..grid columncon
a7d0: 66 69 67 75 72 65 20 24 77 69 6e 20 30 20 2d 77 figure $win 0 -w
a7e0: 65 69 67 68 74 20 31 0a 09 67 72 69 64 20 72 6f eight 1..grid ro
a7f0: 77 63 6f 6e 66 69 67 75 72 65 20 24 77 69 6e 20 wconfigure $win
a800: 24 63 75 72 72 65 6e 74 5f 72 6f 77 20 2d 77 65 $current_row -we
a810: 69 67 68 74 20 31 0a 0a 09 73 65 74 20 62 75 74 ight 1...set but
a820: 77 69 64 74 68 20 37 0a 09 69 66 20 7b 20 5b 73 width 7..if { [s
a830: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6f 70 tring length $op
a840: 74 69 6f 6e 73 28 2d 6f 6b 6e 61 6d 65 29 5d 20 tions(-okname)]
a850: 3e 20 24 62 75 74 77 69 64 74 68 20 7d 20 7b 0a > $butwidth } {.
a860: 09 20 20 20 20 73 65 74 20 62 75 74 77 69 64 74 . set butwidt
a870: 68 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 h [string length
a880: 20 24 6f 70 74 69 6f 6e 73 28 2d 6f 6b 6e 61 6d $options(-oknam
a890: 65 29 5d 0a 09 7d 0a 09 69 66 20 7b 20 5b 73 74 e)]..}..if { [st
a8a0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6f 70 74 ring length $opt
a8b0: 69 6f 6e 73 28 2d 63 61 6e 63 65 6c 6e 61 6d 65 ions(-cancelname
a8c0: 29 5d 20 3e 20 24 62 75 74 77 69 64 74 68 20 7d )] > $butwidth }
a8d0: 20 7b 0a 09 20 20 20 20 73 65 74 20 62 75 74 77 {.. set butw
a8e0: 69 64 74 68 20 5b 73 74 72 69 6e 67 20 6c 65 6e idth [string len
a8f0: 67 74 68 20 24 6f 70 74 69 6f 6e 73 28 2d 63 61 gth $options(-ca
a900: 6e 63 65 6c 6e 61 6d 65 29 5d 0a 09 7d 0a 09 66 ncelname)]..}..f
a910: 6f 72 65 61 63 68 20 69 20 24 6f 70 74 69 6f 6e oreach i $option
a920: 73 28 2d 6d 6f 72 65 62 75 74 74 6f 6e 73 29 20 s(-morebuttons)
a930: 7b 0a 09 20 20 20 20 69 66 20 7b 20 5b 73 74 72 {.. if { [str
a940: 69 6e 67 20 6c 65 6e 67 74 68 20 24 69 5d 20 3e ing length $i] >
a950: 20 24 62 75 74 77 69 64 74 68 20 7d 20 7b 20 73 $butwidth } { s
a960: 65 74 20 62 75 74 77 69 64 74 68 20 5b 73 74 72 et butwidth [str
a970: 69 6e 67 20 6c 65 6e 67 74 68 20 24 69 5d 20 7d ing length $i] }
a980: 0a 09 7d 0a 23 20 20 20 20 20 20 20 20 20 69 66 ..}.# if
a990: 20 7b 20 5b 63 61 74 63 68 20 7b 20 70 61 63 6b { [catch { pack
a9a0: 61 67 65 20 70 72 65 73 65 6e 74 20 74 69 6c 65 age present tile
a9b0: 20 7d 5d 20 3d 3d 20 30 20 7d 20 7b 0a 23 20 20 }] == 0 } {.#
a9c0: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 62 set b
a9d0: 75 74 77 69 64 74 68 20 5b 65 78 70 72 20 7b 2d utwidth [expr {-
a9e0: 31 2a 24 62 75 74 77 69 64 74 68 7d 5d 0a 23 20 1*$butwidth}].#
a9f0: 20 20 20 20 20 20 20 20 7d 0a 09 73 65 74 20 62 }..set b
aa00: 75 74 77 69 64 74 68 20 5b 65 78 70 72 20 7b 2d utwidth [expr {-
aa10: 31 2a 24 62 75 74 77 69 64 74 68 7d 5d 0a 09 73 1*$butwidth}]..s
aa20: 65 74 20 75 73 65 64 6c 65 74 74 65 72 73 20 22 et usedletters "
aa30: 22 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 "..if { $options
aa40: 28 2d 6f 6b 6e 61 6d 65 29 20 21 3d 20 22 2d 22 (-okname) != "-"
aa50: 20 7d 20 7b 0a 09 20 20 20 20 66 6f 72 20 7b 20 } {.. for {
aa60: 73 65 74 20 69 70 6f 73 20 30 20 7d 20 7b 20 24 set ipos 0 } { $
aa70: 69 70 6f 73 20 3c 20 5b 73 74 72 69 6e 67 20 6c ipos < [string l
aa80: 65 6e 67 74 68 20 24 6f 70 74 69 6f 6e 73 28 2d ength $options(-
aa90: 6f 6b 6e 61 6d 65 29 5d 20 7d 20 7b 20 69 6e 63 okname)] } { inc
aaa0: 72 20 69 70 6f 73 20 7d 20 7b 0a 09 09 73 65 74 r ipos } {...set
aab0: 20 6c 65 74 74 65 72 20 5b 73 74 72 69 6e 67 20 letter [string
aac0: 74 6f 6c 6f 77 65 72 20 5b 73 74 72 69 6e 67 20 tolower [string
aad0: 69 6e 64 65 78 20 24 6f 70 74 69 6f 6e 73 28 2d index $options(-
aae0: 6f 6b 6e 61 6d 65 29 20 24 69 70 6f 73 5d 5d 0a okname) $ipos]].
aaf0: 09 09 69 66 20 7b 20 5b 72 65 67 65 78 70 20 7b ..if { [regexp {
ab00: 5b 61 2d 7a 41 2d 5a 5d 7d 20 24 6c 65 74 74 65 [a-zA-Z]} $lette
ab10: 72 5d 20 26 26 20 5b 6c 73 65 61 72 63 68 20 24 r] && [lsearch $
ab20: 75 73 65 64 6c 65 74 74 65 72 73 20 24 6c 65 74 usedletters $let
ab30: 74 65 72 5d 20 3d 3d 20 2d 31 20 7d 20 7b 0a 09 ter] == -1 } {..
ab40: 09 20 20 20 20 62 72 65 61 6b 0a 09 09 7d 0a 09 . break...}..
ab50: 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 20 }.. if {
ab60: 24 69 70 6f 73 20 3c 20 5b 73 74 72 69 6e 67 20 $ipos < [string
ab70: 6c 65 6e 67 74 68 20 24 6f 70 74 69 6f 6e 73 28 length $options(
ab80: 2d 6f 6b 6e 61 6d 65 29 5d 20 7d 20 7b 0a 09 09 -okname)] } {...
ab90: 24 62 75 74 74 6f 6e 5f 63 6d 64 20 24 77 69 6e $button_cmd $win
aba0: 2e 62 75 74 73 2e 6f 6b 20 2d 74 65 78 74 20 24 .buts.ok -text $
abb0: 6f 70 74 69 6f 6e 73 28 2d 6f 6b 6e 61 6d 65 29 options(-okname)
abc0: 20 2d 77 69 64 74 68 20 24 62 75 74 77 69 64 74 -width $butwidt
abd0: 68 20 2d 75 6e 64 20 24 69 70 6f 73 20 2d 63 6f h -und $ipos -co
abe0: 6d 6d 61 6e 64 20 5c 0a 09 09 20 20 20 20 20 20 mmand \...
abf0: 20 20 5b 6d 79 6d 65 74 68 6f 64 20 5f 61 70 70 [mymethod _app
ac00: 6c 79 61 63 74 69 6f 6e 20 31 5d 0a 09 09 62 69 lyaction 1]...bi
ac10: 6e 64 20 24 77 69 6e 20 3c 41 6c 74 2d 24 6c 65 nd $win <Alt-$le
ac20: 74 74 65 72 3e 20 5b 6d 79 6d 65 74 68 6f 64 20 tter> [mymethod
ac30: 5f 62 75 74 74 6f 6e 5f 69 6e 76 6f 6b 65 20 24 _button_invoke $
ac40: 77 69 6e 2e 62 75 74 73 2e 6f 6b 5d 0a 09 09 62 win.buts.ok]...b
ac50: 69 6e 64 20 24 77 69 6e 2e 62 75 74 73 2e 6f 6b ind $win.buts.ok
ac60: 20 3c 52 65 74 75 72 6e 3e 20 22 5b 6d 79 6d 65 <Return> "[myme
ac70: 74 68 6f 64 20 5f 62 75 74 74 6f 6e 5f 69 6e 76 thod _button_inv
ac80: 6f 6b 65 20 24 77 69 6e 2e 62 75 74 73 2e 6f 6b oke $win.buts.ok
ac90: 5d 20 3b 62 72 65 61 6b 22 0a 09 09 6c 61 70 70 ] ;break"...lapp
aca0: 65 6e 64 20 75 73 65 64 6c 65 74 74 65 72 73 20 end usedletters
acb0: 24 6c 65 74 74 65 72 0a 09 09 73 65 74 20 77 69 $letter...set wi
acc0: 64 67 65 74 28 24 6c 65 74 74 65 72 29 20 24 77 dget($letter) $w
acd0: 69 6e 2e 62 75 74 73 2e 6f 6b 0a 09 20 20 20 20 in.buts.ok..
ace0: 7d 20 65 6c 73 65 20 7b 0a 09 09 24 62 75 74 74 } else {...$butt
acf0: 6f 6e 5f 63 6d 64 20 24 77 69 6e 2e 62 75 74 73 on_cmd $win.buts
ad00: 2e 6f 6b 20 2d 74 65 78 74 20 24 6f 70 74 69 6f .ok -text $optio
ad10: 6e 73 28 2d 6f 6b 6e 61 6d 65 29 20 2d 77 69 64 ns(-okname) -wid
ad20: 74 68 20 24 62 75 74 77 69 64 74 68 20 2d 63 6f th $butwidth -co
ad30: 6d 6d 61 6e 64 20 5c 0a 09 09 20 20 20 20 20 20 mmand \...
ad40: 20 20 5b 6d 79 6d 65 74 68 6f 64 20 5f 61 70 70 [mymethod _app
ad50: 6c 79 61 63 74 69 6f 6e 20 31 5d 0a 09 20 20 20 lyaction 1]..
ad60: 20 7d 0a 09 7d 0a 09 69 66 20 7b 20 24 6f 70 74 }..}..if { $opt
ad70: 69 6f 6e 73 28 2d 63 61 6e 63 65 6c 6e 61 6d 65 ions(-cancelname
ad80: 29 20 6e 65 20 22 2d 22 20 7d 20 7b 0a 09 20 20 ) ne "-" } {..
ad90: 20 20 66 6f 72 20 7b 20 73 65 74 20 69 70 6f 73 for { set ipos
ada0: 20 30 20 7d 20 7b 20 24 69 70 6f 73 20 3c 20 5b 0 } { $ipos < [
adb0: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6f string length $o
adc0: 70 74 69 6f 6e 73 28 2d 63 61 6e 63 65 6c 6e 61 ptions(-cancelna
add0: 6d 65 29 5d 20 7d 20 7b 20 69 6e 63 72 20 69 70 me)] } { incr ip
ade0: 6f 73 20 7d 20 7b 0a 09 09 73 65 74 20 6c 65 74 os } {...set let
adf0: 74 65 72 20 5b 73 74 72 69 6e 67 20 74 6f 6c 6f ter [string tolo
ae00: 77 65 72 20 5b 73 74 72 69 6e 67 20 69 6e 64 65 wer [string inde
ae10: 78 20 24 6f 70 74 69 6f 6e 73 28 2d 63 61 6e 63 x $options(-canc
ae20: 65 6c 6e 61 6d 65 29 20 24 69 70 6f 73 5d 5d 0a elname) $ipos]].
ae30: 09 09 69 66 20 7b 20 5b 72 65 67 65 78 70 20 7b ..if { [regexp {
ae40: 5b 61 2d 7a 41 2d 5a 5d 7d 20 24 6c 65 74 74 65 [a-zA-Z]} $lette
ae50: 72 5d 20 26 26 20 5b 6c 73 65 61 72 63 68 20 24 r] && [lsearch $
ae60: 75 73 65 64 6c 65 74 74 65 72 73 20 24 6c 65 74 usedletters $let
ae70: 74 65 72 5d 20 3d 3d 20 2d 31 20 7d 20 7b 0a 09 ter] == -1 } {..
ae80: 09 20 20 20 20 62 72 65 61 6b 0a 09 09 7d 0a 09 . break...}..
ae90: 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 20 }.. if {
aea0: 24 69 70 6f 73 20 3c 20 5b 73 74 72 69 6e 67 20 $ipos < [string
aeb0: 6c 65 6e 67 74 68 20 24 6f 70 74 69 6f 6e 73 28 length $options(
aec0: 2d 63 61 6e 63 65 6c 6e 61 6d 65 29 5d 20 7d 20 -cancelname)] }
aed0: 7b 0a 09 09 73 65 74 20 75 6e 64 65 72 6c 69 6e {...set underlin
aee0: 65 63 61 6e 63 65 6c 20 24 69 70 6f 73 0a 09 09 ecancel $ipos...
aef0: 6c 61 70 70 65 6e 64 20 75 73 65 64 6c 65 74 74 lappend usedlett
af00: 65 72 73 20 5b 73 74 72 69 6e 67 20 74 6f 6c 6f ers [string tolo
af10: 77 65 72 20 5b 73 74 72 69 6e 67 20 69 6e 64 65 wer [string inde
af20: 78 20 24 6f 70 74 69 6f 6e 73 28 2d 63 61 6e 63 x $options(-canc
af30: 65 6c 6e 61 6d 65 29 20 24 69 70 6f 73 5d 5d 0a elname) $ipos]].
af40: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 73 65 . } else { se
af50: 74 20 75 6e 64 65 72 6c 69 6e 65 63 61 6e 63 65 t underlinecance
af60: 6c 20 22 22 20 7d 0a 09 7d 0a 0a 09 73 65 74 20 l "" }..}...set
af70: 74 6f 67 72 69 64 20 22 22 0a 09 73 65 74 20 69 togrid ""..set i
af80: 61 63 74 69 6f 6e 20 32 0a 09 66 6f 72 65 61 63 action 2..foreac
af90: 68 20 69 20 24 6f 70 74 69 6f 6e 73 28 2d 6d 6f h i $options(-mo
afa0: 72 65 62 75 74 74 6f 6e 73 29 20 7b 0a 09 20 20 rebuttons) {..
afb0: 20 20 66 6f 72 20 7b 20 73 65 74 20 69 70 6f 73 for { set ipos
afc0: 20 30 20 7d 20 7b 20 24 69 70 6f 73 20 3c 20 5b 0 } { $ipos < [
afd0: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 69 string length $i
afe0: 5d 20 7d 20 7b 20 69 6e 63 72 20 69 70 6f 73 20 ] } { incr ipos
aff0: 7d 20 7b 0a 09 09 73 65 74 20 6c 65 74 74 65 72 } {...set letter
b000: 20 5b 73 74 72 69 6e 67 20 74 6f 6c 6f 77 65 72 [string tolower
b010: 20 5b 73 74 72 69 6e 67 20 69 6e 64 65 78 20 24 [string index $
b020: 69 20 24 69 70 6f 73 5d 5d 0a 09 09 69 66 20 7b i $ipos]]...if {
b030: 20 5b 72 65 67 65 78 70 20 7b 5b 61 2d 7a 41 2d [regexp {[a-zA-
b040: 5a 5d 7d 20 24 6c 65 74 74 65 72 5d 20 26 26 20 Z]} $letter] &&
b050: 5b 6c 73 65 61 72 63 68 20 24 75 73 65 64 6c 65 [lsearch $usedle
b060: 74 74 65 72 73 20 24 6c 65 74 74 65 72 5d 20 3d tters $letter] =
b070: 3d 20 2d 31 20 7d 20 7b 0a 09 09 20 20 20 20 62 = -1 } {... b
b080: 72 65 61 6b 0a 09 09 7d 0a 09 20 20 20 20 7d 0a reak...}.. }.
b090: 09 20 20 20 20 69 66 20 7b 20 24 69 70 6f 73 20 . if { $ipos
b0a0: 3c 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 < [string length
b0b0: 20 24 69 5d 20 7d 20 7b 0a 09 09 24 62 75 74 74 $i] } {...$butt
b0c0: 6f 6e 5f 63 6d 64 20 24 77 69 6e 2e 62 75 74 73 on_cmd $win.buts
b0d0: 2e 62 24 69 61 63 74 69 6f 6e 20 2d 74 65 78 74 .b$iaction -text
b0e0: 20 24 69 20 2d 77 69 64 74 68 20 24 62 75 74 77 $i -width $butw
b0f0: 69 64 74 68 20 2d 75 6e 64 20 24 69 70 6f 73 20 idth -und $ipos
b100: 5c 0a 09 09 20 20 20 20 2d 63 6f 6d 6d 61 6e 64 \... -command
b110: 20 5b 6d 79 6d 65 74 68 6f 64 20 5f 61 70 70 6c [mymethod _appl
b120: 79 61 63 74 69 6f 6e 20 24 69 61 63 74 69 6f 6e yaction $iaction
b130: 5d 0a 09 09 62 69 6e 64 20 24 77 69 6e 20 3c 41 ]...bind $win <A
b140: 6c 74 2d 24 6c 65 74 74 65 72 3e 20 20 5b 6d 79 lt-$letter> [my
b150: 6d 65 74 68 6f 64 20 5f 62 75 74 74 6f 6e 5f 69 method _button_i
b160: 6e 76 6f 6b 65 20 24 77 69 6e 2e 62 75 74 73 2e nvoke $win.buts.
b170: 62 24 69 61 63 74 69 6f 6e 5d 0a 09 09 62 69 6e b$iaction]...bin
b180: 64 20 24 77 69 6e 2e 62 75 74 73 2e 62 24 69 61 d $win.buts.b$ia
b190: 63 74 69 6f 6e 20 3c 52 65 74 75 72 6e 3e 20 22 ction <Return> "
b1a0: 5b 6d 79 6d 65 74 68 6f 64 20 5f 62 75 74 74 6f [mymethod _butto
b1b0: 6e 5f 69 6e 76 6f 6b 65 20 24 77 69 6e 2e 62 75 n_invoke $win.bu
b1c0: 74 73 2e 62 24 69 61 63 74 69 6f 6e 5d 20 3b 62 ts.b$iaction] ;b
b1d0: 72 65 61 6b 22 0a 09 09 6c 61 70 70 65 6e 64 20 reak"...lappend
b1e0: 75 73 65 64 6c 65 74 74 65 72 73 20 24 6c 65 74 usedletters $let
b1f0: 74 65 72 0a 09 09 73 65 74 20 77 69 64 67 65 74 ter...set widget
b200: 28 24 6c 65 74 74 65 72 29 20 24 77 69 6e 2e 62 ($letter) $win.b
b210: 75 74 73 2e 62 24 69 61 63 74 69 6f 6e 0a 09 20 uts.b$iaction..
b220: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 24 62 } else {...$b
b230: 75 74 74 6f 6e 5f 63 6d 64 20 24 77 69 6e 2e 62 utton_cmd $win.b
b240: 75 74 73 2e 62 24 69 61 63 74 69 6f 6e 20 2d 74 uts.b$iaction -t
b250: 65 78 74 20 24 69 20 2d 77 69 64 74 68 20 24 62 ext $i -width $b
b260: 75 74 77 69 64 74 68 20 20 5c 0a 09 09 20 20 20 utwidth \...
b270: 20 2d 63 6f 6d 6d 61 6e 64 20 5b 6d 79 6d 65 74 -command [mymet
b280: 68 6f 64 20 5f 61 70 70 6c 79 61 63 74 69 6f 6e hod _applyaction
b290: 20 24 69 61 63 74 69 6f 6e 5d 0a 09 20 20 20 20 $iaction]..
b2a0: 7d 0a 09 20 20 20 20 6c 61 70 70 65 6e 64 20 74 }.. lappend t
b2b0: 6f 67 72 69 64 20 24 77 69 6e 2e 62 75 74 73 2e ogrid $win.buts.
b2c0: 62 24 69 61 63 74 69 6f 6e 0a 09 20 20 20 20 69 b$iaction.. i
b2d0: 6e 63 72 20 69 61 63 74 69 6f 6e 0a 09 7d 0a 09 ncr iaction..}..
b2e0: 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 63 if { $options(-c
b2f0: 61 6e 63 65 6c 6e 61 6d 65 29 20 6e 65 20 22 2d ancelname) ne "-
b300: 22 20 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 " } {.. if {
b310: 24 75 6e 64 65 72 6c 69 6e 65 63 61 6e 63 65 6c $underlinecancel
b320: 20 21 3d 20 22 22 20 7d 20 7b 0a 09 09 24 62 75 != "" } {...$bu
b330: 74 74 6f 6e 5f 63 6d 64 20 24 77 69 6e 2e 62 75 tton_cmd $win.bu
b340: 74 73 2e 63 61 6e 63 65 6c 20 2d 74 65 78 74 20 ts.cancel -text
b350: 24 6f 70 74 69 6f 6e 73 28 2d 63 61 6e 63 65 6c $options(-cancel
b360: 6e 61 6d 65 29 20 2d 77 69 64 74 68 20 24 62 75 name) -width $bu
b370: 74 77 69 64 74 68 20 5c 0a 09 09 20 20 20 20 2d twidth \... -
b380: 75 6e 64 20 24 75 6e 64 65 72 6c 69 6e 65 63 61 und $underlineca
b390: 6e 63 65 6c 20 2d 63 6f 6d 6d 61 6e 64 20 5b 6d ncel -command [m
b3a0: 79 6d 65 74 68 6f 64 20 5f 61 70 70 6c 79 61 63 ymethod _applyac
b3b0: 74 69 6f 6e 20 30 5d 0a 09 09 73 65 74 20 6c 65 tion 0]...set le
b3c0: 74 74 65 72 20 5b 73 74 72 69 6e 67 20 74 6f 6c tter [string tol
b3d0: 6f 77 65 72 20 5b 73 74 72 69 6e 67 20 69 6e 64 ower [string ind
b3e0: 65 78 20 24 6f 70 74 69 6f 6e 73 28 2d 63 61 6e ex $options(-can
b3f0: 63 65 6c 6e 61 6d 65 29 20 24 75 6e 64 65 72 6c celname) $underl
b400: 69 6e 65 63 61 6e 63 65 6c 5d 5d 0a 09 09 62 69 inecancel]]...bi
b410: 6e 64 20 24 77 69 6e 20 3c 41 6c 74 2d 24 6c 65 nd $win <Alt-$le
b420: 74 74 65 72 3e 20 5b 6d 79 6d 65 74 68 6f 64 20 tter> [mymethod
b430: 5f 62 75 74 74 6f 6e 5f 69 6e 76 6f 6b 65 20 24 _button_invoke $
b440: 77 69 6e 2e 62 75 74 73 2e 63 61 6e 63 65 6c 5d win.buts.cancel]
b450: 0a 09 09 62 69 6e 64 20 24 77 69 6e 2e 62 75 74 ...bind $win.but
b460: 73 2e 63 61 6e 63 65 6c 20 3c 52 65 74 75 72 6e s.cancel <Return
b470: 3e 20 22 5b 6d 79 6d 65 74 68 6f 64 20 5f 62 75 > "[mymethod _bu
b480: 74 74 6f 6e 5f 69 6e 76 6f 6b 65 20 24 77 69 6e tton_invoke $win
b490: 2e 62 75 74 73 2e 63 61 6e 63 65 6c 5d 20 3b 62 .buts.cancel] ;b
b4a0: 72 65 61 6b 22 0a 09 09 73 65 74 20 77 69 64 67 reak"...set widg
b4b0: 65 74 28 24 6c 65 74 74 65 72 29 20 24 77 69 6e et($letter) $win
b4c0: 2e 62 75 74 73 2e 63 61 6e 63 65 6c 0a 09 20 20 .buts.cancel..
b4d0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 24 62 75 } else {...$bu
b4e0: 74 74 6f 6e 5f 63 6d 64 20 24 77 69 6e 2e 62 75 tton_cmd $win.bu
b4f0: 74 73 2e 63 61 6e 63 65 6c 20 2d 74 65 78 74 20 ts.cancel -text
b500: 24 6f 70 74 69 6f 6e 73 28 2d 63 61 6e 63 65 6c $options(-cancel
b510: 6e 61 6d 65 29 20 2d 77 69 64 74 68 20 24 62 75 name) -width $bu
b520: 74 77 69 64 74 68 20 5c 0a 09 09 20 20 20 20 2d twidth \... -
b530: 63 6f 6d 6d 61 6e 64 20 5b 6d 79 6d 65 74 68 6f command [mymetho
b540: 64 20 5f 61 70 70 6c 79 61 63 74 69 6f 6e 20 30 d _applyaction 0
b550: 5d 0a 09 20 20 20 20 7d 0a 09 7d 0a 0a 09 69 66 ].. }..}...if
b560: 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 6f 6b 6e { $options(-okn
b570: 61 6d 65 29 20 6e 65 20 22 2d 22 20 7d 20 7b 0a ame) ne "-" } {.
b580: 09 20 20 20 20 73 65 74 20 74 6f 67 72 69 64 20 . set togrid
b590: 22 24 77 69 6e 2e 62 75 74 73 2e 6f 6b 20 24 74 "$win.buts.ok $t
b5a0: 6f 67 72 69 64 22 0a 09 7d 0a 09 69 66 20 7b 20 ogrid"..}..if {
b5b0: 24 6f 70 74 69 6f 6e 73 28 2d 63 61 6e 63 65 6c $options(-cancel
b5c0: 6e 61 6d 65 29 20 6e 65 20 20 22 2d 22 20 7d 20 name) ne "-" }
b5d0: 7b 0a 09 20 20 20 20 73 65 74 20 74 6f 67 72 69 {.. set togri
b5e0: 64 20 22 24 74 6f 67 72 69 64 20 24 77 69 6e 2e d "$togrid $win.
b5f0: 62 75 74 73 2e 63 61 6e 63 65 6c 22 0a 09 7d 0a buts.cancel"..}.
b600: 09 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 ...if { $options
b610: 28 2d 72 65 70 65 61 74 5f 61 6e 73 77 65 72 5f (-repeat_answer_
b620: 63 68 65 63 6b 29 20 7d 20 7b 0a 09 20 20 20 20 check) } {..
b630: 63 68 65 63 6b 62 75 74 74 6f 6e 20 24 77 69 6e checkbutton $win
b640: 2e 62 75 74 73 2e 72 65 70 65 61 74 20 2d 74 65 .buts.repeat -te
b650: 78 74 20 5b 5f 20 22 52 65 70 65 61 74 20 6d 79 xt [_ "Repeat my
b660: 20 61 6e 73 77 65 72 22 5d 20 5c 0a 09 09 2d 76 answer"] \...-v
b670: 61 72 69 61 62 6c 65 20 5b 6d 79 76 61 72 20 72 ariable [myvar r
b680: 65 70 65 61 74 5f 6d 79 5f 61 6e 73 77 65 72 5d epeat_my_answer]
b690: 0a 09 20 20 20 20 24 77 69 6e 2e 62 75 74 73 2e .. $win.buts.
b6a0: 72 65 70 65 61 74 20 63 6f 6e 66 69 67 75 72 65 repeat configure
b6b0: 20 2d 62 61 63 6b 67 72 6f 75 6e 64 20 5b 43 43 -background [CC
b6c0: 43 6f 6c 6f 72 41 63 74 69 76 6f 20 5b 24 77 69 ColorActivo [$wi
b6d0: 6e 20 63 67 65 74 20 2d 62 61 63 6b 67 72 6f 75 n cget -backgrou
b6e0: 6e 64 5d 5d 0a 09 7d 0a 09 69 66 20 7b 20 5b 6c nd]]..}..if { [l
b6f0: 6c 65 6e 67 74 68 20 24 74 6f 67 72 69 64 5d 20 length $togrid]
b700: 7d 20 7b 0a 09 20 20 20 20 67 72 69 64 20 7b 2a } {.. grid {*
b710: 7d 24 74 6f 67 72 69 64 20 2d 70 61 64 78 20 32 }$togrid -padx 2
b720: 20 2d 70 61 64 79 20 34 0a 09 7d 20 65 6c 73 65 -pady 4..} else
b730: 20 7b 0a 09 20 20 20 20 63 61 74 63 68 20 7b 0a {.. catch {.
b740: 09 09 67 72 69 64 20 66 6f 72 67 65 74 20 24 77 ..grid forget $w
b750: 69 6e 2e 62 75 74 73 0a 09 09 67 72 69 64 20 66 in.buts...grid f
b760: 6f 72 67 65 74 20 24 77 69 6e 2e 73 65 70 0a 09 orget $win.sep..
b770: 20 20 20 20 7d 0a 09 7d 0a 09 69 66 20 7b 20 24 }..}..if { $
b780: 6f 70 74 69 6f 6e 73 28 2d 72 65 70 65 61 74 5f options(-repeat_
b790: 61 6e 73 77 65 72 5f 63 68 65 63 6b 29 20 7d 20 answer_check) }
b7a0: 7b 0a 09 20 20 20 20 67 72 69 64 20 7b 2a 7d 24 {.. grid {*}$
b7b0: 74 6f 67 72 69 64 20 2d 72 6f 77 20 31 0a 09 20 togrid -row 1..
b7c0: 20 20 20 67 72 69 64 20 24 77 69 6e 2e 62 75 74 grid $win.but
b7d0: 73 2e 72 65 70 65 61 74 20 7b 2a 7d 5b 6c 72 65 s.repeat {*}[lre
b7e0: 70 65 61 74 20 5b 65 78 70 72 20 7b 5b 6c 6c 65 peat [expr {[lle
b7f0: 6e 67 74 68 20 24 74 6f 67 72 69 64 5d 2d 31 7d ngth $togrid]-1}
b800: 5d 20 2d 5d 20 5c 0a 09 09 2d 73 74 69 63 6b 79 ] -] \...-sticky
b810: 20 77 20 2d 70 61 64 78 20 32 20 2d 70 61 64 79 w -padx 2 -pady
b820: 20 32 20 2d 72 6f 77 20 30 0a 09 0a 23 20 20 20 2 -row 0...#
b830: 20 20 20 20 20 20 20 20 20 67 72 69 64 20 24 77 grid $w
b840: 69 6e 2e 62 75 74 73 2e 72 65 70 65 61 74 20 2d in.buts.repeat -
b850: 72 6f 77 20 30 20 2d 63 6f 6c 75 6d 6e 20 5b 6c row 0 -column [l
b860: 6c 65 6e 67 74 68 20 24 74 6f 67 72 69 64 5d 20 length $togrid]
b870: 2d 73 74 69 63 6b 79 20 77 20 2d 70 61 64 78 20 -sticky w -padx
b880: 32 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 20 2.#
b890: 67 72 69 64 20 24 77 69 6e 2e 62 75 74 73 2e 72 grid $win.buts.r
b8a0: 65 70 65 61 74 20 7b 2a 7d 5b 6c 72 65 70 65 61 epeat {*}[lrepea
b8b0: 74 20 5b 65 78 70 72 20 7b 5b 6c 6c 65 6e 67 74 t [expr {[llengt
b8c0: 68 20 24 74 6f 67 72 69 64 5d 2d 31 7d 5d 20 2d h $togrid]-1}] -
b8d0: 5d 20 5c 0a 23 20 20 20 20 20 20 20 20 20 20 20 ] \.#
b8e0: 20 20 20 20 20 20 2d 73 74 69 63 6b 79 20 77 20 -sticky w
b8f0: 2d 70 61 64 78 20 32 20 2d 70 61 64 79 20 32 0a -padx 2 -pady 2.
b900: 09 7d 0a 09 73 77 69 74 63 68 20 2d 2d 20 24 6f .}..switch -- $o
b910: 70 74 69 6f 6e 73 28 2d 73 74 79 6c 65 29 20 7b ptions(-style) {
b920: 0a 09 20 20 20 20 22 73 65 70 61 72 61 74 6f 72 .. "separator
b930: 5f 72 69 67 68 74 22 20 7b 0a 09 09 67 72 69 64 _right" {...grid
b940: 20 63 6f 6e 66 69 67 75 72 65 20 7b 2a 7d 24 74 configure {*}$t
b950: 6f 67 72 69 64 20 2d 73 74 69 63 6b 79 20 65 0a ogrid -sticky e.
b960: 09 09 67 72 69 64 20 63 6f 6c 75 6d 6e 63 6f 6e ..grid columncon
b970: 66 69 67 75 72 65 20 24 77 69 6e 2e 62 75 74 73 figure $win.buts
b980: 20 30 20 2d 77 65 69 67 68 74 20 31 0a 09 20 20 0 -weight 1..
b990: 20 20 7d 0a 09 7d 0a 09 69 66 20 7b 20 24 6f 70 }..}..if { $op
b9a0: 74 69 6f 6e 73 28 2d 6f 6b 6e 61 6d 65 29 20 21 tions(-okname) !
b9b0: 3d 20 22 2d 22 20 7d 20 7b 0a 09 20 20 20 20 66 = "-" } {.. f
b9c0: 6f 63 75 73 20 24 77 69 6e 2e 62 75 74 73 2e 6f ocus $win.buts.o
b9d0: 6b 0a 09 7d 20 65 6c 73 65 69 66 20 7b 20 24 6f k..} elseif { $o
b9e0: 70 74 69 6f 6e 73 28 2d 63 61 6e 63 65 6c 6e 61 ptions(-cancelna
b9f0: 6d 65 29 20 21 3d 20 22 2d 22 20 7d 20 7b 0a 09 me) != "-" } {..
ba00: 20 20 20 20 66 6f 63 75 73 20 24 77 69 6e 2e 62 focus $win.b
ba10: 75 74 73 2e 63 61 6e 63 65 6c 0a 09 7d 0a 0a 09 uts.cancel..}...
ba20: 66 6f 72 65 61 63 68 20 69 20 24 74 6f 67 72 69 foreach i $togri
ba30: 64 20 7b 0a 09 20 20 20 20 66 6f 72 65 61 63 68 d {.. foreach
ba40: 20 6c 65 74 74 65 72 20 24 75 73 65 64 6c 65 74 letter $usedlet
ba50: 74 65 72 73 20 7b 0a 09 09 62 69 6e 64 20 24 69 ters {...bind $i
ba60: 20 3c 4b 65 79 2d 24 6c 65 74 74 65 72 3e 20 5b <Key-$letter> [
ba70: 6d 79 6d 65 74 68 6f 64 20 5f 62 75 74 74 6f 6e mymethod _button
ba80: 5f 69 6e 76 6f 6b 65 20 24 77 69 64 67 65 74 28 _invoke $widget(
ba90: 24 6c 65 74 74 65 72 29 5d 0a 09 09 62 69 6e 64 $letter)]...bind
baa0: 20 24 69 20 3c 43 6f 6e 74 72 6f 6c 2d 24 6c 65 $i <Control-$le
bab0: 74 74 65 72 3e 20 7b 20 63 6f 6e 74 69 6e 75 65 tter> { continue
bac0: 20 7d 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 69 66 }.. }..}..if
bad0: 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 63 61 6e { $options(-can
bae0: 63 65 6c 6e 61 6d 65 29 20 6e 65 20 22 2d 22 20 celname) ne "-"
baf0: 7d 20 7b 0a 09 20 20 20 20 62 69 6e 64 20 24 77 } {.. bind $w
bb00: 69 6e 20 3c 45 73 63 61 70 65 3e 20 5b 6d 79 6d in <Escape> [mym
bb10: 65 74 68 6f 64 20 5f 62 75 74 74 6f 6e 5f 69 6e ethod _button_in
bb20: 76 6f 6b 65 20 24 77 69 6e 2e 62 75 74 73 2e 63 voke $win.buts.c
bb30: 61 6e 63 65 6c 5d 0a 09 20 20 20 20 62 69 6e 64 ancel].. bind
bb40: 20 24 77 69 6e 2e 62 75 74 73 2e 63 61 6e 63 65 $win.buts.cance
bb50: 6c 20 3c 52 65 74 75 72 6e 3e 20 22 5b 6d 79 6d l <Return> "[mym
bb60: 65 74 68 6f 64 20 5f 62 75 74 74 6f 6e 5f 69 6e ethod _button_in
bb70: 76 6f 6b 65 20 24 77 69 6e 2e 62 75 74 73 2e 63 voke $win.buts.c
bb80: 61 6e 63 65 6c 5d 20 3b 62 72 65 61 6b 22 0a 09 ancel] ;break"..
bb90: 20 20 20 20 69 66 20 7b 20 24 6f 70 74 69 6f 6e if { $option
bba0: 73 28 2d 66 72 61 6d 65 5f 74 6f 70 6c 65 76 65 s(-frame_topleve
bbb0: 6c 29 20 65 71 20 22 74 6f 70 6c 65 76 65 6c 22 l) eq "toplevel"
bbc0: 20 7d 20 7b 0a 09 09 77 6d 20 70 72 6f 74 6f 63 } {...wm protoc
bbd0: 6f 6c 20 24 77 69 6e 20 57 4d 5f 44 45 4c 45 54 ol $win WM_DELET
bbe0: 45 5f 57 49 4e 44 4f 57 20 5b 6d 79 6d 65 74 68 E_WINDOW [mymeth
bbf0: 6f 64 20 5f 62 75 74 74 6f 6e 5f 69 6e 76 6f 6b od _button_invok
bc00: 65 20 24 77 69 6e 2e 62 75 74 73 2e 63 61 6e 63 e $win.buts.canc
bc10: 65 6c 5d 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c el].. }..} el
bc20: 73 65 20 7b 0a 09 20 20 20 20 62 69 6e 64 20 24 se {.. bind $
bc30: 77 69 6e 20 3c 45 73 63 61 70 65 3e 20 5b 6d 79 win <Escape> [my
bc40: 6d 65 74 68 6f 64 20 5f 61 70 70 6c 79 61 63 74 method _applyact
bc50: 69 6f 6e 20 2d 31 5d 0a 09 20 20 20 20 69 66 20 ion -1].. if
bc60: 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 66 72 61 6d { $options(-fram
bc70: 65 5f 74 6f 70 6c 65 76 65 6c 29 20 65 71 20 22 e_toplevel) eq "
bc80: 74 6f 70 6c 65 76 65 6c 22 20 7d 20 7b 0a 09 09 toplevel" } {...
bc90: 77 6d 20 70 72 6f 74 6f 63 6f 6c 20 24 77 69 6e wm protocol $win
bca0: 20 57 4d 5f 44 45 4c 45 54 45 5f 57 49 4e 44 4f WM_DELETE_WINDO
bcb0: 57 20 5b 6d 79 6d 65 74 68 6f 64 20 5f 61 70 70 W [mymethod _app
bcc0: 6c 79 61 63 74 69 6f 6e 20 2d 31 5d 0a 09 20 20 lyaction -1]..
bcd0: 20 20 7d 0a 09 7d 0a 0a 09 69 66 20 7b 20 24 6f }..}...if { $o
bce0: 70 74 69 6f 6e 73 28 2d 65 6e 74 72 79 74 65 78 ptions(-entrytex
bcf0: 74 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 20 20 t) ne "" } {..
bd00: 20 20 69 66 20 7b 20 5b 77 69 6e 66 6f 20 73 63 if { [winfo sc
bd10: 72 65 65 6e 77 69 64 74 68 20 2e 5d 20 3c 20 33 reenwidth .] < 3
bd20: 30 30 20 7d 20 7b 0a 09 09 73 65 74 20 77 72 61 00 } {...set wra
bd30: 70 6c 65 6e 67 74 68 20 31 30 30 0a 09 20 20 20 plength 100..
bd40: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 } else {...set
bd50: 77 72 61 70 6c 65 6e 67 74 68 20 33 30 30 0a 09 wraplength 300..
bd60: 20 20 20 20 7d 0a 09 20 20 20 20 24 6c 61 62 65 }.. $labe
bd70: 6c 5f 63 6d 64 20 24 77 69 6e 2e 66 2e 6c 30 20 l_cmd $win.f.l0
bd80: 2d 74 65 78 74 20 24 6f 70 74 69 6f 6e 73 28 2d -text $options(-
bd90: 65 6e 74 72 79 74 65 78 74 29 20 2d 77 72 61 70 entrytext) -wrap
bda0: 6c 65 6e 67 74 68 20 24 77 72 61 70 6c 65 6e 67 length $wrapleng
bdb0: 74 68 20 5c 0a 09 09 2d 6a 75 73 74 69 66 79 20 th \...-justify
bdc0: 6c 65 66 74 0a 09 20 20 20 20 67 72 69 64 20 24 left.. grid $
bdd0: 77 69 6e 2e 66 2e 6c 30 20 2d 20 2d 73 74 69 63 win.f.l0 - -stic
bde0: 6b 79 20 77 20 2d 70 61 64 79 20 22 32 20 35 22 ky w -pady "2 5"
bdf0: 0a 09 7d 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f ..}..if { $optio
be00: 6e 73 28 2d 65 6e 74 72 79 74 79 70 65 29 20 6e ns(-entrytype) n
be10: 65 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 24 6c e "" } {.. $l
be20: 61 62 65 6c 5f 63 6d 64 20 24 77 69 6e 2e 66 2e abel_cmd $win.f.
be30: 6c 20 2d 74 65 78 74 20 24 6f 70 74 69 6f 6e 73 l -text $options
be40: 28 2d 65 6e 74 72 79 6c 61 62 65 6c 29 0a 09 20 (-entrylabel)..
be50: 20 20 20 73 77 69 74 63 68 20 24 6f 70 74 69 6f switch $optio
be60: 6e 73 28 2d 65 6e 74 72 79 74 79 70 65 29 20 7b ns(-entrytype) {
be70: 0a 09 09 65 6e 74 72 79 20 7b 0a 09 09 20 20 20 ...entry {...
be80: 20 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d if { $options(-
be90: 65 6e 74 72 79 76 61 6c 75 65 73 29 20 65 71 20 entryvalues) eq
bea0: 22 22 20 7d 20 7b 0a 09 09 20 20 20 20 20 20 20 "" } {...
beb0: 20 24 65 6e 74 72 79 5f 63 6d 64 20 24 77 69 6e $entry_cmd $win
bec0: 2e 66 2e 65 20 2d 74 65 78 74 76 61 72 69 61 62 .f.e -textvariab
bed0: 6c 65 20 5b 76 61 72 6e 61 6d 65 20 65 6e 74 72 le [varname entr
bee0: 79 76 61 6c 75 65 5d 20 2d 77 69 64 74 68 20 34 yvalue] -width 4
bef0: 30 0a 09 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0... } else {
bf00: 0a 09 09 20 20 20 20 20 20 20 20 24 63 6f 6d 62 ... $comb
bf10: 6f 5f 63 6d 64 20 24 77 69 6e 2e 66 2e 65 20 2d o_cmd $win.f.e -
bf20: 74 65 78 74 76 61 72 69 61 62 6c 65 20 5b 76 61 textvariable [va
bf30: 72 6e 61 6d 65 20 65 6e 74 72 79 76 61 6c 75 65 rname entryvalue
bf40: 5d 20 2d 77 69 64 74 68 20 34 30 20 5c 0a 09 09 ] -width 40 \...
bf50: 20 20 20 20 20 20 20 20 20 20 20 20 2d 76 61 6c -val
bf60: 75 65 73 20 24 6f 70 74 69 6f 6e 73 28 2d 65 6e ues $options(-en
bf70: 74 72 79 76 61 6c 75 65 73 29 0a 09 09 20 20 20 tryvalues)...
bf80: 20 7d 0a 09 09 7d 0a 09 09 70 61 73 73 77 6f 72 }...}...passwor
bf90: 64 20 7b 0a 09 09 20 20 20 20 24 65 6e 74 72 79 d {... $entry
bfa0: 5f 63 6d 64 20 24 77 69 6e 2e 66 2e 65 20 2d 74 _cmd $win.f.e -t
bfb0: 65 78 74 76 61 72 69 61 62 6c 65 20 5b 76 61 72 extvariable [var
bfc0: 6e 61 6d 65 20 65 6e 74 72 79 76 61 6c 75 65 5d name entryvalue]
bfd0: 20 2d 77 69 64 74 68 20 34 30 20 2d 73 68 6f 77 -width 40 -show
bfe0: 20 2a 0a 09 09 7d 0a 09 09 6e 6f 6e 65 64 69 74 *...}...nonedit
bff0: 61 62 6c 65 5f 65 6e 74 72 79 20 7b 0a 09 09 20 able_entry {...
c000: 20 20 20 69 66 20 7b 20 5b 6c 6c 65 6e 67 74 68 if { [llength
c010: 20 24 6f 70 74 69 6f 6e 73 28 2d 65 6e 74 72 79 $options(-entry
c020: 76 61 6c 75 65 73 29 5d 20 3d 3d 20 32 20 26 26 values)] == 2 &&
c030: 20 5b 73 74 72 69 6e 67 20 69 73 20 62 6f 6f 6c [string is bool
c040: 65 61 6e 20 5b 6c 69 6e 64 65 78 20 24 6f 70 74 ean [lindex $opt
c050: 69 6f 6e 73 28 2d 65 6e 74 72 79 76 61 6c 75 65 ions(-entryvalue
c060: 73 29 20 30 5d 5d 20 26 26 0a 09 09 20 20 20 20 s) 0]] &&...
c070: 20 20 20 20 5b 73 74 72 69 6e 67 20 69 73 20 62 [string is b
c080: 6f 6f 6c 65 61 6e 20 5b 6c 69 6e 64 65 78 20 24 oolean [lindex $
c090: 6f 70 74 69 6f 6e 73 28 2d 65 6e 74 72 79 76 61 options(-entryva
c0a0: 6c 75 65 73 29 20 31 5d 5d 20 7d 20 7b 0a 09 09 lues) 1]] } {...
c0b0: 20 20 20 20 20 20 20 20 64 65 73 74 72 6f 79 20 destroy
c0c0: 20 24 77 69 6e 2e 66 2e 6c 0a 09 09 20 20 20 20 $win.f.l...
c0d0: 20 20 20 20 24 63 68 65 63 6b 62 75 74 74 6f 6e $checkbutton
c0e0: 5f 63 6d 64 20 24 77 69 6e 2e 66 2e 6c 20 2d 74 _cmd $win.f.l -t
c0f0: 65 78 74 20 24 6f 70 74 69 6f 6e 73 28 2d 65 6e ext $options(-en
c100: 74 72 79 6c 61 62 65 6c 29 20 2d 76 61 72 69 61 trylabel) -varia
c110: 62 6c 65 20 5b 76 61 72 6e 61 6d 65 20 65 6e 74 ble [varname ent
c120: 72 79 76 61 6c 75 65 5d 0a 09 09 20 20 20 20 20 ryvalue]...
c130: 20 20 20 24 66 72 61 6d 65 5f 63 6d 64 20 24 77 $frame_cmd $w
c140: 69 6e 2e 66 2e 65 0a 09 09 20 20 20 20 7d 20 65 in.f.e... } e
c150: 6c 73 65 69 66 20 7b 20 5b 6c 6c 65 6e 67 74 68 lseif { [llength
c160: 20 24 6f 70 74 69 6f 6e 73 28 2d 65 6e 74 72 79 $options(-entry
c170: 76 61 6c 75 65 73 29 5d 20 3c 3d 20 35 20 7d 20 values)] <= 5 }
c180: 7b 0a 09 09 20 20 20 20 20 20 20 20 73 65 74 20 {... set
c190: 66 72 20 5b 24 66 72 61 6d 65 5f 63 6d 64 20 24 fr [$frame_cmd $
c1a0: 77 69 6e 2e 66 2e 65 5d 0a 09 09 20 20 20 20 20 win.f.e]...
c1b0: 20 20 20 73 65 74 20 69 64 78 20 30 0a 09 09 20 set idx 0...
c1c0: 20 20 20 20 20 20 20 66 6f 72 65 61 63 68 20 69 foreach i
c1d0: 20 24 6f 70 74 69 6f 6e 73 28 2d 65 6e 74 72 79 $options(-entry
c1e0: 76 61 6c 75 65 73 29 20 7b 0a 09 09 20 20 20 20 values) {...
c1f0: 20 20 20 20 20 20 20 20 24 72 61 64 69 6f 62 75 $radiobu
c200: 74 74 6f 6e 5f 63 6d 64 20 24 66 72 2e 72 24 69 tton_cmd $fr.r$i
c210: 64 78 20 2d 74 65 78 74 20 24 69 20 2d 76 61 72 dx -text $i -var
c220: 69 61 62 6c 65 20 5b 76 61 72 6e 61 6d 65 20 65 iable [varname e
c230: 6e 74 72 79 76 61 6c 75 65 5d 20 5c 0a 09 09 20 ntryvalue] \...
c240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d -
c250: 76 61 6c 75 65 20 24 69 0a 09 09 20 20 20 20 20 value $i...
c260: 20 20 20 20 20 20 20 67 72 69 64 20 24 66 72 2e grid $fr.
c270: 72 24 69 64 78 20 2d 73 74 69 63 6b 79 20 77 20 r$idx -sticky w
c280: 2d 70 61 64 78 20 32 20 2d 70 61 64 79 20 32 0a -padx 2 -pady 2.
c290: 09 09 20 20 20 20 20 20 20 20 20 20 20 20 69 6e .. in
c2a0: 63 72 20 69 64 78 0a 09 09 20 20 20 20 20 20 20 cr idx...
c2b0: 20 7d 0a 09 09 20 20 20 20 7d 20 65 6c 73 65 20 }... } else
c2c0: 7b 0a 09 09 20 20 20 20 20 20 20 20 24 63 6f 6d {... $com
c2d0: 62 6f 5f 63 6d 64 20 24 77 69 6e 2e 66 2e 65 20 bo_cmd $win.f.e
c2e0: 2d 74 65 78 74 76 61 72 69 61 62 6c 65 20 5b 76 -textvariable [v
c2f0: 61 72 6e 61 6d 65 20 65 6e 74 72 79 76 61 6c 75 arname entryvalu
c300: 65 5d 20 2d 77 69 64 74 68 20 34 30 20 5c 0a 09 e] -width 40 \..
c310: 09 20 20 20 20 20 20 20 20 2d 76 61 6c 75 65 73 . -values
c320: 20 24 6f 70 74 69 6f 6e 73 28 2d 65 6e 74 72 79 $options(-entry
c330: 76 61 6c 75 65 73 29 20 2d 73 74 61 74 65 20 72 values) -state r
c340: 65 61 64 6f 6e 6c 79 0a 09 09 20 20 20 20 7d 0a eadonly... }.
c350: 09 09 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 ..}.. }..
c360: 73 65 74 20 65 6e 74 72 79 76 61 6c 75 65 20 24 set entryvalue $
c370: 6f 70 74 69 6f 6e 73 28 2d 65 6e 74 72 79 64 65 options(-entryde
c380: 66 61 75 6c 74 29 0a 09 0a 09 20 20 20 20 67 72 fault).... gr
c390: 69 64 20 24 77 69 6e 2e 66 2e 6c 20 24 77 69 6e id $win.f.l $win
c3a0: 2e 66 2e 65 20 2d 73 74 69 63 6b 79 20 77 20 2d .f.e -sticky w -
c3b0: 70 61 64 78 20 33 20 2d 70 61 64 79 20 33 0a 09 padx 3 -pady 3..
c3c0: 20 20 20 20 67 72 69 64 20 63 6f 6e 66 69 67 75 grid configu
c3d0: 72 65 20 24 77 69 6e 2e 66 2e 65 20 2d 73 74 69 re $win.f.e -sti
c3e0: 63 6b 79 20 65 77 0a 09 20 20 20 20 67 72 69 64 cky ew.. grid
c3f0: 20 63 6f 6c 75 6d 6e 63 6f 6e 66 69 67 75 72 65 columnconfigure
c400: 20 24 77 69 6e 2e 66 20 31 20 2d 77 65 69 67 68 $win.f 1 -weigh
c410: 74 20 31 0a 0a 09 20 20 20 20 69 66 20 7b 20 5b t 1... if { [
c420: 77 69 6e 66 6f 20 65 78 69 73 74 73 20 24 77 69 winfo exists $wi
c430: 6e 2e 66 2e 6c 30 5d 20 7d 20 7b 0a 09 09 75 70 n.f.l0] } {...up
c440: 64 61 74 65 20 69 64 6c 65 74 61 73 6b 73 0a 09 date idletasks..
c450: 09 24 77 69 6e 2e 66 2e 6c 30 20 63 6f 6e 66 69 .$win.f.l0 confi
c460: 67 75 72 65 20 2d 77 72 61 70 6c 65 6e 67 74 68 gure -wraplength
c470: 20 5b 65 78 70 72 20 7b 5b 77 69 6e 66 6f 20 72 [expr {[winfo r
c480: 65 71 77 69 64 74 68 20 24 77 69 6e 2e 66 5d 2d eqwidth $win.f]-
c490: 35 7d 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 5}].. }..
c4a0: 69 66 20 7b 20 5b 77 69 6e 66 6f 20 63 6c 61 73 if { [winfo clas
c4b0: 73 20 24 77 69 6e 2e 66 2e 65 5d 20 6e 69 20 22 s $win.f.e] ni "
c4c0: 54 46 72 61 6d 65 20 46 72 61 6d 65 22 20 7d 20 TFrame Frame" }
c4d0: 7b 0a 09 09 74 6b 3a 3a 54 61 62 54 6f 57 69 6e {...tk::TabToWin
c4e0: 64 6f 77 20 24 77 69 6e 2e 66 2e 65 0a 09 20 20 dow $win.f.e..
c4f0: 20 20 7d 0a 09 20 20 20 20 62 69 6e 64 20 24 77 }.. bind $w
c500: 69 6e 20 3c 52 65 74 75 72 6e 3e 20 5b 6d 79 6d in <Return> [mym
c510: 65 74 68 6f 64 20 69 6e 76 6f 6b 65 6f 6b 5d 0a ethod invokeok].
c520: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 64 65 73 .}. }. des
c530: 74 72 75 63 74 6f 72 20 7b 0a 09 73 65 74 20 61 tructor {..set a
c540: 63 74 69 6f 6e 20 2d 31 0a 0a 09 69 66 20 7b 20 ction -1...if {
c550: 24 6f 6c 64 47 72 61 62 20 6e 65 20 22 22 20 7d $oldGrab ne "" }
c560: 20 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 5b 69 {.. if { [i
c570: 6e 66 6f 20 65 78 69 73 74 73 20 67 72 61 62 53 nfo exists grabS
c580: 74 61 74 75 73 5d 20 26 26 20 24 67 72 61 62 53 tatus] && $grabS
c590: 74 61 74 75 73 20 6e 65 20 22 67 6c 6f 62 61 6c tatus ne "global
c5a0: 22 20 7d 20 7b 0a 09 09 69 66 20 7b 20 5b 77 69 " } {...if { [wi
c5b0: 6e 66 6f 20 65 78 69 73 74 73 20 24 6f 6c 64 47 nfo exists $oldG
c5c0: 72 61 62 5d 20 26 26 20 5b 77 69 6e 66 6f 20 69 rab] && [winfo i
c5d0: 73 6d 61 70 70 65 64 20 24 6f 6c 64 47 72 61 62 smapped $oldGrab
c5e0: 5d 20 7d 20 7b 20 67 72 61 62 20 24 6f 6c 64 47 ] } { grab $oldG
c5f0: 72 61 62 20 7d 0a 09 20 20 20 20 7d 20 65 6c 73 rab }.. } els
c600: 65 20 7b 0a 09 09 69 66 20 7b 20 5b 77 69 6e 66 e {...if { [winf
c610: 6f 20 65 78 69 73 74 73 20 24 6f 6c 64 47 72 61 o exists $oldGra
c620: 62 5d 20 26 26 20 5b 77 69 6e 66 6f 20 69 73 6d b] && [winfo ism
c630: 61 70 70 65 64 20 24 6f 6c 64 47 72 61 62 5d 20 apped $oldGrab]
c640: 7d 20 7b 20 67 72 61 62 20 2d 67 6c 6f 62 61 6c } { grab -global
c650: 20 24 6f 6c 64 47 72 61 62 20 7d 0a 09 20 20 20 $oldGrab }..
c660: 20 7d 0a 09 7d 0a 09 63 61 74 63 68 20 7b 20 66 }..}..catch { f
c670: 6f 63 75 73 20 24 6f 6c 64 46 6f 63 75 73 20 7d ocus $oldFocus }
c680: 0a 09 66 6f 72 65 61 63 68 20 69 20 24 74 72 61 ..foreach i $tra
c690: 63 65 73 20 7b 0a 09 20 20 20 20 74 72 61 63 65 ces {.. trace
c6a0: 20 72 65 6d 6f 76 65 20 76 61 72 69 61 62 6c 65 remove variable
c6b0: 20 7b 2a 7d 24 69 0a 09 7d 0a 09 66 6f 72 65 61 {*}$i..}..forea
c6c0: 63 68 20 69 20 24 64 65 73 74 72 6f 79 5f 68 61 ch i $destroy_ha
c6d0: 6e 64 6c 65 72 73 20 7b 0a 09 20 20 20 20 75 70 ndlers {.. up
c6e0: 6c 65 76 65 6c 20 23 30 20 24 69 0a 09 7d 0a 20 level #0 $i..}.
c6f0: 20 20 20 7d 0a 20 20 20 20 6f 6e 63 6f 6e 66 69 }. onconfi
c700: 67 75 72 65 20 2d 74 69 74 6c 65 20 7b 76 61 6c gure -title {val
c710: 75 65 7d 20 7b 0a 09 73 65 74 20 6f 70 74 69 6f ue} {..set optio
c720: 6e 73 28 2d 74 69 74 6c 65 29 20 24 76 61 6c 75 ns(-title) $valu
c730: 65 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 e..if { $options
c740: 28 2d 66 72 61 6d 65 5f 74 6f 70 6c 65 76 65 6c (-frame_toplevel
c750: 29 20 65 71 20 22 74 6f 70 6c 65 76 65 6c 22 20 ) eq "toplevel"
c760: 7d 20 7b 0a 09 20 20 20 20 23 20 63 61 74 63 68 } {.. # catch
c770: 20 69 73 20 68 65 72 65 20 61 73 20 77 69 6e 20 is here as win
c780: 69 73 20 61 20 66 72 61 6d 65 20 69 6e 20 73 6f is a frame in so
c790: 6d 65 20 63 61 73 65 73 0a 09 20 20 20 20 63 61 me cases.. ca
c7a0: 74 63 68 20 7b 20 77 6d 20 74 69 74 6c 65 20 24 tch { wm title $
c7b0: 77 69 6e 20 24 6f 70 74 69 6f 6e 73 28 2d 74 69 win $options(-ti
c7c0: 74 6c 65 29 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a tle) }..}. }.
c7d0: 20 20 20 20 6d 65 74 68 6f 64 20 67 69 76 65 66 method givef
c7e0: 72 61 6d 65 20 7b 7d 20 7b 0a 09 72 65 74 75 72 rame {} {..retur
c7f0: 6e 20 24 77 69 6e 2e 66 0a 20 20 20 20 7d 0a 20 n $win.f. }.
c800: 20 20 20 6d 65 74 68 6f 64 20 67 69 76 65 66 72 method givefr
c810: 61 6d 65 5f 62 61 63 6b 67 72 6f 75 6e 64 20 7b ame_background {
c820: 7d 20 7b 0a 09 73 65 74 20 65 72 72 20 5b 63 61 } {..set err [ca
c830: 74 63 68 20 7b 20 24 77 69 6e 2e 66 20 63 67 65 tch { $win.f cge
c840: 74 20 2d 62 61 63 6b 67 72 6f 75 6e 64 20 7d 20 t -background }
c850: 62 67 5d 0a 09 69 66 20 7b 20 24 65 72 72 20 7d bg]..if { $err }
c860: 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 79 6c {.. set styl
c870: 65 20 5b 24 77 69 6e 2e 66 20 63 67 65 74 20 2d e [$win.f cget -
c880: 73 74 79 6c 65 5d 0a 09 20 20 20 20 69 66 20 7b style].. if {
c890: 20 24 73 74 79 6c 65 20 65 71 20 22 22 20 7d 20 $style eq "" }
c8a0: 7b 20 73 65 74 20 73 74 79 6c 65 20 5b 77 69 6e { set style [win
c8b0: 66 6f 20 63 6c 61 73 73 20 24 77 69 6e 2e 66 5d fo class $win.f]
c8c0: 20 7d 0a 09 20 20 20 20 73 65 74 20 65 72 72 20 }.. set err
c8d0: 5b 63 61 74 63 68 20 7b 20 74 74 6b 3a 3a 73 74 [catch { ttk::st
c8e0: 79 6c 65 20 6c 6f 6f 6b 75 70 20 24 73 74 79 6c yle lookup $styl
c8f0: 65 20 2d 62 61 63 6b 67 72 6f 75 6e 64 20 7d 20 e -background }
c900: 62 67 5d 0a 09 20 20 20 20 69 66 20 7b 20 24 65 bg].. if { $e
c910: 72 72 20 7d 20 7b 20 73 65 74 20 62 67 20 77 68 rr } { set bg wh
c920: 69 74 65 20 7d 0a 09 7d 0a 09 72 65 74 75 72 6e ite }..}..return
c930: 20 24 62 67 0a 20 20 20 20 7d 0a 20 20 20 20 6d $bg. }. m
c940: 65 74 68 6f 64 20 69 6e 76 6f 6b 65 6f 6b 20 7b ethod invokeok {
c950: 20 7b 20 76 69 73 69 62 6c 65 20 31 20 7d 20 7d { visible 1 } }
c960: 20 7b 0a 09 69 66 20 7b 20 21 5b 77 69 6e 66 6f {..if { ![winfo
c970: 20 65 78 69 73 74 73 20 24 77 69 6e 2e 62 75 74 exists $win.but
c980: 73 2e 6f 6b 5d 20 7d 20 7b 20 72 65 74 75 72 6e s.ok] } { return
c990: 20 7d 0a 09 0a 09 69 66 20 7b 20 24 76 69 73 69 }....if { $visi
c9a0: 62 6c 65 20 7d 20 7b 0a 09 20 20 20 20 24 73 65 ble } {.. $se
c9b0: 6c 66 20 5f 62 75 74 74 6f 6e 5f 69 6e 76 6f 6b lf _button_invok
c9c0: 65 20 24 77 69 6e 2e 62 75 74 73 2e 6f 6b 0a 09 e $win.buts.ok..
c9d0: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 24 77 } else {.. $w
c9e0: 69 6e 2e 62 75 74 73 2e 6f 6b 20 69 6e 76 6f 6b in.buts.ok invok
c9f0: 65 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6d e..}. }. m
ca00: 65 74 68 6f 64 20 69 6e 76 6f 6b 65 63 61 6e 63 ethod invokecanc
ca10: 65 6c 20 7b 20 7b 20 76 69 73 69 62 6c 65 20 31 el { { visible 1
ca20: 20 7d 20 7d 20 7b 0a 09 69 66 20 7b 20 21 5b 77 } } {..if { ![w
ca30: 69 6e 66 6f 20 65 78 69 73 74 73 20 24 77 69 6e info exists $win
ca40: 2e 62 75 74 73 2e 63 61 6e 63 65 6c 5d 20 7d 20 .buts.cancel] }
ca50: 7b 20 72 65 74 75 72 6e 20 7d 0a 09 0a 09 69 66 { return }....if
ca60: 20 7b 20 24 76 69 73 69 62 6c 65 20 7d 20 7b 0a { $visible } {.
ca70: 09 20 20 20 20 24 73 65 6c 66 20 5f 62 75 74 74 . $self _butt
ca80: 6f 6e 5f 69 6e 76 6f 6b 65 20 24 77 69 6e 2e 62 on_invoke $win.b
ca90: 75 74 73 2e 63 61 6e 63 65 6c 0a 09 7d 20 65 6c uts.cancel..} el
caa0: 73 65 20 7b 0a 09 20 20 20 20 24 77 69 6e 2e 62 se {.. $win.b
cab0: 75 74 73 2e 63 61 6e 63 65 6c 20 69 6e 76 6f 6b uts.cancel invok
cac0: 65 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6d e..}. }. m
cad0: 65 74 68 6f 64 20 69 6e 76 6f 6b 65 62 75 74 74 ethod invokebutt
cae0: 6f 6e 20 7b 20 6e 75 6d 20 7b 20 76 69 73 69 62 on { num { visib
caf0: 6c 65 20 31 20 7d 20 7d 20 7b 0a 09 69 66 20 7b le 1 } } {..if {
cb00: 20 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 ![winfo exists
cb10: 24 77 69 6e 2e 62 75 74 73 5d 20 7d 20 7b 20 72 $win.buts] } { r
cb20: 65 74 75 72 6e 20 7d 0a 0a 09 69 66 20 7b 20 24 eturn }...if { $
cb30: 6e 75 6d 20 3c 20 32 20 7d 20 7b 0a 09 20 20 20 num < 2 } {..
cb40: 20 65 72 72 6f 72 20 22 65 72 72 6f 72 20 69 6e error "error in
cb50: 20 64 69 61 6c 6f 67 77 69 6e 5f 73 6e 69 74 20 dialogwin_snit
cb60: 69 6e 76 6f 6b 65 62 75 74 74 6f 6e 20 6e 75 6d invokebutton num
cb70: 3c 32 22 0a 09 7d 0a 09 66 6f 72 65 61 63 68 20 <2"..}..foreach
cb80: 69 20 5b 77 69 6e 66 6f 20 63 68 69 6c 64 72 65 i [winfo childre
cb90: 6e 20 24 77 69 6e 2e 62 75 74 73 5d 20 7b 0a 09 n $win.buts] {..
cba0: 20 20 20 20 69 66 20 7b 20 5b 72 65 67 65 78 70 if { [regexp
cbb0: 20 22 5c 5c 6d 24 6e 75 6d 5c 5c 4d 22 20 5b 24 "\\m$num\\M" [$
cbc0: 69 20 63 67 65 74 20 2d 63 6f 6d 6d 61 6e 64 5d i cget -command]
cbd0: 5d 20 7d 20 7b 0a 09 09 69 66 20 7b 20 24 76 69 ] } {...if { $vi
cbe0: 73 69 62 6c 65 20 7d 20 7b 0a 09 09 20 20 20 20 sible } {...
cbf0: 24 73 65 6c 66 20 5f 62 75 74 74 6f 6e 5f 69 6e $self _button_in
cc00: 76 6f 6b 65 20 24 69 0a 09 09 7d 20 65 6c 73 65 voke $i...} else
cc10: 20 7b 0a 09 09 20 20 20 20 24 69 20 69 6e 76 6f {... $i invo
cc20: 6b 65 0a 09 09 7d 0a 09 09 72 65 74 75 72 6e 0a ke...}...return.
cc30: 09 20 20 20 20 7d 0a 09 7d 0a 09 65 72 72 6f 72 . }..}..error
cc40: 20 22 65 72 72 6f 72 20 69 6e 20 64 69 61 6c 6f "error in dialo
cc50: 67 77 69 6e 5f 73 6e 69 74 20 69 6e 76 6f 6b 65 gwin_snit invoke
cc60: 62 75 74 74 6f 6e 20 6e 75 6d 20 62 61 64 22 0a button num bad".
cc70: 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 }. method
cc80: 20 66 6f 63 75 73 6f 6b 20 7b 7d 20 7b 0a 09 69 focusok {} {..i
cc90: 66 20 7b 20 21 5b 77 69 6e 66 6f 20 65 78 69 73 f { ![winfo exis
cca0: 74 73 20 24 77 69 6e 2e 62 75 74 73 2e 6f 6b 5d ts $win.buts.ok]
ccb0: 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a 09 66 } { return }..f
ccc0: 6f 63 75 73 20 24 77 69 6e 2e 62 75 74 73 2e 6f ocus $win.buts.o
ccd0: 6b 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 k. }. meth
cce0: 6f 64 20 66 6f 63 75 73 63 61 6e 63 65 6c 20 7b od focuscancel {
ccf0: 7d 20 7b 0a 09 69 66 20 7b 20 21 5b 77 69 6e 66 } {..if { ![winf
cd00: 6f 20 65 78 69 73 74 73 20 24 77 69 6e 2e 62 75 o exists $win.bu
cd10: 74 73 2e 63 61 6e 63 65 6c 5d 20 7d 20 7b 20 72 ts.cancel] } { r
cd20: 65 74 75 72 6e 20 7d 0a 09 66 6f 63 75 73 20 24 eturn }..focus $
cd30: 77 69 6e 2e 62 75 74 73 2e 63 61 6e 63 65 6c 0a win.buts.cancel.
cd40: 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 }. method
cd50: 20 66 6f 63 75 73 62 75 74 74 6f 6e 20 7b 20 6e focusbutton { n
cd60: 75 6d 20 7d 20 7b 0a 09 0a 09 69 66 20 7b 20 24 um } {....if { $
cd70: 6e 75 6d 20 3c 20 32 20 7d 20 7b 0a 09 20 20 20 num < 2 } {..
cd80: 20 65 72 72 6f 72 20 22 65 72 72 6f 72 20 69 6e error "error in
cd90: 20 64 69 61 6c 6f 67 77 69 6e 5f 73 6e 69 74 20 dialogwin_snit
cda0: 66 6f 63 75 73 62 75 74 74 6f 6e 20 6e 75 6d 20 focusbutton num
cdb0: 6d 75 73 74 20 62 65 20 3e 20 32 22 0a 09 7d 0a must be > 2"..}.
cdc0: 09 66 6f 72 65 61 63 68 20 69 20 5b 77 69 6e 66 .foreach i [winf
cdd0: 6f 20 63 68 69 6c 64 72 65 6e 20 24 77 69 6e 2e o children $win.
cde0: 62 75 74 73 5d 20 7b 0a 09 20 20 20 20 69 66 20 buts] {.. if
cdf0: 7b 20 5b 72 65 67 65 78 70 20 22 5c 5c 6d 24 6e { [regexp "\\m$n
ce00: 75 6d 5c 5c 4d 22 20 5b 24 69 20 63 67 65 74 20 um\\M" [$i cget
ce10: 2d 63 6f 6d 6d 61 6e 64 5d 5d 20 7d 20 7b 0a 09 -command]] } {..
ce20: 09 66 6f 63 75 73 20 24 69 0a 09 09 72 65 74 75 .focus $i...retu
ce30: 72 6e 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 65 72 rn.. }..}..er
ce40: 72 6f 72 20 22 65 72 72 6f 72 20 69 6e 20 64 69 ror "error in di
ce50: 61 6c 6f 67 77 69 6e 5f 73 6e 69 74 20 66 6f 63 alogwin_snit foc
ce60: 75 73 62 75 74 74 6f 6e 20 6e 75 6d 20 62 61 64 usbutton num bad
ce70: 22 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 ". }. meth
ce80: 6f 64 20 65 6e 61 62 6c 65 6f 6b 20 7b 7d 20 7b od enableok {} {
ce90: 0a 09 69 66 20 7b 20 21 5b 77 69 6e 66 6f 20 65 ..if { ![winfo e
cea0: 78 69 73 74 73 20 24 77 69 6e 2e 62 75 74 73 2e xists $win.buts.
ceb0: 6f 6b 5d 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d ok] } { return }
cec0: 0a 09 24 77 69 6e 2e 62 75 74 73 2e 6f 6b 20 63 ..$win.buts.ok c
ced0: 6f 6e 66 69 67 75 72 65 20 2d 73 74 61 74 65 20 onfigure -state
cee0: 6e 6f 72 6d 61 6c 0a 20 20 20 20 7d 0a 20 20 20 normal. }.
cef0: 20 6d 65 74 68 6f 64 20 65 6e 61 62 6c 65 63 61 method enableca
cf00: 6e 63 65 6c 20 7b 7d 20 7b 0a 09 69 66 20 7b 20 ncel {} {..if {
cf10: 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 24 ![winfo exists $
cf20: 77 69 6e 2e 62 75 74 73 2e 63 61 6e 63 65 6c 5d win.buts.cancel]
cf30: 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a 09 24 } { return }..$
cf40: 77 69 6e 2e 62 75 74 73 2e 63 61 6e 63 65 6c 20 win.buts.cancel
cf50: 63 6f 6e 66 69 67 75 72 65 20 2d 73 74 61 74 65 configure -state
cf60: 20 6e 6f 72 6d 61 6c 0a 20 20 20 20 7d 0a 20 20 normal. }.
cf70: 20 20 6d 65 74 68 6f 64 20 65 6e 61 62 6c 65 62 method enableb
cf80: 75 74 74 6f 6e 20 7b 20 6e 75 6d 20 7d 20 7b 0a utton { num } {.
cf90: 09 0a 09 69 66 20 7b 20 24 6e 75 6d 20 3c 20 32 ...if { $num < 2
cfa0: 20 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 } {.. error
cfb0: 22 65 72 72 6f 72 20 69 6e 20 64 69 61 6c 6f 67 "error in dialog
cfc0: 77 69 6e 5f 73 6e 69 74 20 65 6e 61 62 6c 65 62 win_snit enableb
cfd0: 75 74 74 6f 6e 20 6e 75 6d 20 6d 75 73 74 20 62 utton num must b
cfe0: 65 20 3e 20 32 22 0a 09 7d 0a 09 66 6f 72 65 61 e > 2"..}..forea
cff0: 63 68 20 69 20 5b 77 69 6e 66 6f 20 63 68 69 6c ch i [winfo chil
d000: 64 72 65 6e 20 24 77 69 6e 2e 62 75 74 73 5d 20 dren $win.buts]
d010: 7b 0a 09 20 20 20 20 69 66 20 7b 20 5b 72 65 67 {.. if { [reg
d020: 65 78 70 20 22 5c 5c 6d 24 6e 75 6d 5c 5c 4d 22 exp "\\m$num\\M"
d030: 20 5b 24 69 20 63 67 65 74 20 2d 63 6f 6d 6d 61 [$i cget -comma
d040: 6e 64 5d 5d 20 7d 20 7b 0a 09 09 24 69 20 63 6f nd]] } {...$i co
d050: 6e 66 69 67 75 72 65 20 2d 73 74 61 74 65 20 6e nfigure -state n
d060: 6f 72 6d 61 6c 0a 09 09 72 65 74 75 72 6e 0a 09 ormal...return..
d070: 20 20 20 20 7d 0a 09 7d 0a 09 65 72 72 6f 72 20 }..}..error
d080: 22 65 72 72 6f 72 20 69 6e 20 64 69 61 6c 6f 67 "error in dialog
d090: 77 69 6e 5f 73 6e 69 74 20 65 6e 61 62 6c 65 62 win_snit enableb
d0a0: 75 74 74 6f 6e 20 6e 75 6d 20 62 61 64 22 0a 20 utton num bad".
d0b0: 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 }. method
d0c0: 64 69 73 61 62 6c 65 6f 6b 20 7b 7d 20 7b 0a 09 disableok {} {..
d0d0: 69 66 20 7b 20 21 5b 77 69 6e 66 6f 20 65 78 69 if { ![winfo exi
d0e0: 73 74 73 20 24 77 69 6e 2e 62 75 74 73 2e 6f 6b sts $win.buts.ok
d0f0: 5d 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a 09 ] } { return }..
d100: 24 77 69 6e 2e 62 75 74 73 2e 6f 6b 20 63 6f 6e $win.buts.ok con
d110: 66 69 67 75 72 65 20 2d 73 74 61 74 65 20 64 69 figure -state di
d120: 73 61 62 6c 65 64 0a 20 20 20 20 7d 0a 20 20 20 sabled. }.
d130: 20 6d 65 74 68 6f 64 20 64 69 73 61 62 6c 65 63 method disablec
d140: 61 6e 63 65 6c 20 7b 7d 20 7b 0a 09 69 66 20 7b ancel {} {..if {
d150: 20 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 ![winfo exists
d160: 24 77 69 6e 2e 62 75 74 73 2e 63 61 6e 63 65 6c $win.buts.cancel
d170: 5d 20 7d 20 7b 20 72 65 74 75 72 6e 20 7d 0a 09 ] } { return }..
d180: 24 77 69 6e 2e 62 75 74 73 2e 63 61 6e 63 65 6c $win.buts.cancel
d190: 20 63 6f 6e 66 69 67 75 72 65 20 2d 73 74 61 74 configure -stat
d1a0: 65 20 64 69 73 61 62 6c 65 64 0a 20 20 20 20 7d e disabled. }
d1b0: 0a 20 20 20 20 6d 65 74 68 6f 64 20 64 69 73 61 . method disa
d1c0: 62 6c 65 62 75 74 74 6f 6e 20 7b 20 6e 75 6d 20 blebutton { num
d1d0: 7d 20 7b 0a 09 0a 09 69 66 20 7b 20 24 6e 75 6d } {....if { $num
d1e0: 20 3c 20 32 20 7d 20 7b 0a 09 20 20 20 20 65 72 < 2 } {.. er
d1f0: 72 6f 72 20 22 65 72 72 6f 72 20 69 6e 20 64 69 ror "error in di
d200: 61 6c 6f 67 77 69 6e 5f 73 6e 69 74 20 64 69 73 alogwin_snit dis
d210: 61 62 6c 65 62 75 74 74 6f 6e 20 6e 75 6d 20 6d ablebutton num m
d220: 75 73 74 20 62 65 20 3e 20 32 22 0a 09 7d 0a 09 ust be > 2"..}..
d230: 66 6f 72 65 61 63 68 20 69 20 5b 77 69 6e 66 6f foreach i [winfo
d240: 20 63 68 69 6c 64 72 65 6e 20 24 77 69 6e 2e 62 children $win.b
d250: 75 74 73 5d 20 7b 0a 09 20 20 20 20 69 66 20 7b uts] {.. if {
d260: 20 5b 72 65 67 65 78 70 20 22 5c 5c 6d 24 6e 75 [regexp "\\m$nu
d270: 6d 5c 5c 4d 22 20 5b 24 69 20 63 67 65 74 20 2d m\\M" [$i cget -
d280: 63 6f 6d 6d 61 6e 64 5d 5d 20 7d 20 7b 0a 09 09 command]] } {...
d290: 24 69 20 63 6f 6e 66 69 67 75 72 65 20 2d 73 74 $i configure -st
d2a0: 61 74 65 20 64 69 73 61 62 6c 65 64 0a 09 09 72 ate disabled...r
d2b0: 65 74 75 72 6e 0a 09 20 20 20 20 7d 0a 09 7d 0a eturn.. }..}.
d2c0: 09 65 72 72 6f 72 20 22 65 72 72 6f 72 20 69 6e .error "error in
d2d0: 20 64 69 61 6c 6f 67 77 69 6e 5f 73 6e 69 74 20 dialogwin_snit
d2e0: 64 69 73 61 62 6c 65 62 75 74 74 6f 6e 20 6e 75 disablebutton nu
d2f0: 6d 20 62 61 64 22 0a 20 20 20 20 7d 0a 20 20 20 m bad". }.
d300: 20 6d 65 74 68 6f 64 20 5f 62 75 74 74 6f 6e 5f method _button_
d310: 69 6e 76 6f 6b 65 20 7b 20 77 20 7d 20 7b 0a 09 invoke { w } {..
d320: 69 66 20 7b 20 5b 77 69 6e 66 6f 20 63 6c 61 73 if { [winfo clas
d330: 73 20 24 77 5d 20 65 71 20 22 54 42 75 74 74 6f s $w] eq "TButto
d340: 6e 22 20 7d 20 7b 0a 09 20 20 20 20 24 77 20 69 n" } {.. $w i
d350: 6e 73 74 61 74 65 20 21 64 69 73 61 62 6c 65 64 nstate !disabled
d360: 20 7b 0a 09 09 24 77 20 73 74 61 74 65 20 70 72 {...$w state pr
d370: 65 73 73 65 64 0a 09 09 75 70 64 61 74 65 20 69 essed...update i
d380: 64 6c 65 74 61 73 6b 73 0a 09 09 61 66 74 65 72 dletasks...after
d390: 20 31 30 30 0a 09 09 24 77 20 73 74 61 74 65 20 100...$w state
d3a0: 21 70 72 65 73 73 65 64 0a 09 09 75 70 64 61 74 !pressed...updat
d3b0: 65 20 69 64 6c 65 74 61 73 6b 73 0a 09 09 75 70 e idletasks...up
d3c0: 6c 65 76 65 6c 20 23 30 20 5b 6c 69 73 74 20 24 level #0 [list $
d3d0: 77 20 69 6e 76 6f 6b 65 5d 0a 09 20 20 20 20 7d w invoke].. }
d3e0: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
d3f0: 69 66 20 7b 5b 24 77 20 63 67 65 74 20 2d 73 74 if {[$w cget -st
d400: 61 74 65 5d 20 6e 65 20 22 64 69 73 61 62 6c 65 ate] ne "disable
d410: 64 22 7d 20 7b 0a 09 09 73 65 74 20 6f 6c 64 52 d"} {...set oldR
d420: 65 6c 69 65 66 20 5b 24 77 20 63 67 65 74 20 2d elief [$w cget -
d430: 72 65 6c 69 65 66 5d 0a 09 09 73 65 74 20 6f 6c relief]...set ol
d440: 64 53 74 61 74 65 20 5b 24 77 20 63 67 65 74 20 dState [$w cget
d450: 2d 73 74 61 74 65 5d 0a 09 09 24 77 20 63 6f 6e -state]...$w con
d460: 66 69 67 75 72 65 20 2d 73 74 61 74 65 20 61 63 figure -state ac
d470: 74 69 76 65 20 2d 72 65 6c 69 65 66 20 73 75 6e tive -relief sun
d480: 6b 65 6e 0a 09 09 75 70 64 61 74 65 20 69 64 6c ken...update idl
d490: 65 74 61 73 6b 73 0a 09 09 61 66 74 65 72 20 31 etasks...after 1
d4a0: 30 30 0a 09 09 24 77 20 63 6f 6e 66 69 67 75 72 00...$w configur
d4b0: 65 20 2d 73 74 61 74 65 20 24 6f 6c 64 53 74 61 e -state $oldSta
d4c0: 74 65 20 2d 72 65 6c 69 65 66 20 24 6f 6c 64 52 te -relief $oldR
d4d0: 65 6c 69 65 66 0a 09 09 75 70 6c 65 76 65 6c 20 elief...uplevel
d4e0: 23 30 20 5b 6c 69 73 74 20 24 77 20 69 6e 76 6f #0 [list $w invo
d4f0: 6b 65 5d 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 ke].. }..}.
d500: 20 20 7d 0a 0a 20 20 20 20 6d 65 74 68 6f 64 20 }.. method
d510: 63 68 61 6e 67 65 62 75 74 74 6f 6e 6f 70 74 69 changebuttonopti
d520: 6f 6e 73 20 7b 20 6e 75 6d 20 61 72 67 73 20 7d ons { num args }
d530: 20 7b 0a 09 69 66 20 7b 20 24 6e 75 6d 20 3d 3d {..if { $num ==
d540: 20 30 20 7d 20 7b 0a 09 20 20 20 20 65 76 61 6c 0 } {.. eval
d550: 20 5b 6c 69 73 74 20 24 77 69 6e 2e 62 75 74 73 [list $win.buts
d560: 2e 63 61 6e 63 65 6c 20 63 6f 6e 66 69 67 75 72 .cancel configur
d570: 65 5d 20 24 61 72 67 73 0a 09 7d 20 65 6c 73 65 e] $args..} else
d580: 69 66 20 7b 20 24 6e 75 6d 20 3d 3d 20 31 20 7d if { $num == 1 }
d590: 20 7b 0a 09 20 20 20 20 65 76 61 6c 20 5b 6c 69 {.. eval [li
d5a0: 73 74 20 24 77 69 6e 2e 62 75 74 73 2e 6f 6b 20 st $win.buts.ok
d5b0: 63 6f 6e 66 69 67 75 72 65 5d 20 24 61 72 67 73 configure] $args
d5c0: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
d5d0: 66 6f 72 65 61 63 68 20 69 20 5b 77 69 6e 66 6f foreach i [winfo
d5e0: 20 63 68 69 6c 64 72 65 6e 20 24 77 69 6e 2e 62 children $win.b
d5f0: 75 74 73 5d 20 7b 0a 09 09 69 66 20 7b 20 5b 72 uts] {...if { [r
d600: 65 67 65 78 70 20 22 5c 5c 6d 24 6e 75 6d 5c 5c egexp "\\m$num\\
d610: 4d 22 20 5b 24 69 20 63 67 65 74 20 2d 63 6f 6d M" [$i cget -com
d620: 6d 61 6e 64 5d 5d 20 7d 20 7b 0a 09 09 20 20 20 mand]] } {...
d630: 20 65 76 61 6c 20 5b 6c 69 73 74 20 24 69 20 63 eval [list $i c
d640: 6f 6e 66 69 67 75 72 65 5d 20 24 61 72 67 73 0a onfigure] $args.
d650: 09 09 20 20 20 20 72 65 74 75 72 6e 0a 09 09 7d .. return...}
d660: 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 65 72 72 .. }.. err
d670: 6f 72 20 22 65 72 72 6f 72 20 69 6e 20 64 69 61 or "error in dia
d680: 6c 6f 67 77 69 6e 5f 73 6e 69 74 20 63 68 61 6e logwin_snit chan
d690: 67 65 62 75 74 74 6f 6e 6f 70 74 69 6f 6e 73 20 gebuttonoptions
d6a0: 6e 75 6d 20 62 61 64 22 0a 09 7d 0a 20 20 20 20 num bad"..}.
d6b0: 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 63 68 61 }. method cha
d6c0: 6e 67 65 62 75 74 74 6f 6e 67 72 69 64 6f 70 74 ngebuttongridopt
d6d0: 69 6f 6e 73 20 7b 20 6e 75 6d 20 61 72 67 73 20 ions { num args
d6e0: 7d 20 7b 0a 09 69 66 20 7b 20 24 6e 75 6d 20 3d } {..if { $num =
d6f0: 3d 20 30 20 7d 20 7b 0a 09 20 20 20 20 65 76 61 = 0 } {.. eva
d700: 6c 20 5b 6c 69 73 74 20 67 72 69 64 20 63 6f 6e l [list grid con
d710: 66 69 67 75 72 65 20 24 77 69 6e 2e 62 75 74 73 figure $win.buts
d720: 2e 63 61 6e 63 65 6c 5d 20 24 61 72 67 73 0a 09 .cancel] $args..
d730: 7d 20 65 6c 73 65 69 66 20 7b 20 24 6e 75 6d 20 } elseif { $num
d740: 3d 3d 20 31 20 7d 20 7b 0a 09 20 20 20 20 65 76 == 1 } {.. ev
d750: 61 6c 20 5b 6c 69 73 74 20 67 72 69 64 20 63 6f al [list grid co
d760: 6e 66 69 67 75 72 65 20 24 77 69 6e 2e 62 75 74 nfigure $win.but
d770: 73 2e 6f 6b 5d 20 24 61 72 67 73 0a 09 7d 20 65 s.ok] $args..} e
d780: 6c 73 65 20 7b 0a 09 20 20 20 20 66 6f 72 65 61 lse {.. forea
d790: 63 68 20 69 20 5b 77 69 6e 66 6f 20 63 68 69 6c ch i [winfo chil
d7a0: 64 72 65 6e 20 24 77 69 6e 2e 62 75 74 73 5d 20 dren $win.buts]
d7b0: 7b 0a 09 09 69 66 20 7b 20 5b 72 65 67 65 78 70 {...if { [regexp
d7c0: 20 22 5c 5c 6d 24 6e 75 6d 5c 5c 4d 22 20 5b 24 "\\m$num\\M" [$
d7d0: 69 20 63 67 65 74 20 2d 63 6f 6d 6d 61 6e 64 5d i cget -command]
d7e0: 5d 20 7d 20 7b 0a 09 09 20 20 20 20 65 76 61 6c ] } {... eval
d7f0: 20 5b 6c 69 73 74 20 67 72 69 64 20 63 6f 6e 66 [list grid conf
d800: 69 67 75 72 65 20 24 69 5d 20 24 61 72 67 73 0a igure $i] $args.
d810: 09 09 20 20 20 20 72 65 74 75 72 6e 0a 09 09 7d .. return...}
d820: 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 65 72 72 .. }.. err
d830: 6f 72 20 22 65 72 72 6f 72 20 69 6e 20 64 69 61 or "error in dia
d840: 6c 6f 67 77 69 6e 5f 73 6e 69 74 20 63 68 61 6e logwin_snit chan
d850: 67 65 62 75 74 74 6f 6e 67 72 69 64 6f 70 74 69 gebuttongridopti
d860: 6f 6e 73 20 6e 75 6d 20 62 61 64 22 0a 09 7d 0a ons num bad"..}.
d870: 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 }. method
d880: 20 73 68 6f 77 68 69 64 65 62 75 74 74 6f 6e 20 showhidebutton
d890: 7b 20 6e 75 6d 20 77 68 61 74 20 7d 20 7b 0a 09 { num what } {..
d8a0: 69 66 20 7b 20 24 6e 75 6d 20 3d 3d 20 30 20 7d if { $num == 0 }
d8b0: 20 7b 0a 09 20 20 20 20 73 65 74 20 20 62 20 24 {.. set b $
d8c0: 77 69 6e 2e 62 75 74 73 2e 63 61 6e 63 65 6c 0a win.buts.cancel.
d8d0: 09 7d 20 65 6c 73 65 69 66 20 7b 20 24 6e 75 6d .} elseif { $num
d8e0: 20 3d 3d 20 31 20 7d 20 7b 0a 09 20 20 20 20 73 == 1 } {.. s
d8f0: 65 74 20 62 20 24 77 69 6e 2e 62 75 74 73 2e 6f et b $win.buts.o
d900: 6b 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 k..} else {..
d910: 20 66 6f 72 65 61 63 68 20 69 20 5b 77 69 6e 66 foreach i [winf
d920: 6f 20 63 68 69 6c 64 72 65 6e 20 24 77 69 6e 2e o children $win.
d930: 62 75 74 73 5d 20 7b 0a 09 09 69 66 20 7b 20 5b buts] {...if { [
d940: 72 65 67 65 78 70 20 22 5c 5c 6d 24 6e 75 6d 5c regexp "\\m$num\
d950: 5c 4d 22 20 5b 24 69 20 63 67 65 74 20 2d 63 6f \M" [$i cget -co
d960: 6d 6d 61 6e 64 5d 5d 20 7d 20 7b 0a 09 09 20 20 mmand]] } {...
d970: 20 20 73 65 74 20 62 20 24 69 0a 09 09 20 20 20 set b $i...
d980: 20 62 72 65 61 6b 0a 09 09 7d 0a 09 20 20 20 20 break...}..
d990: 7d 0a 09 7d 0a 09 73 77 69 74 63 68 20 24 77 68 }..}..switch $wh
d9a0: 61 74 20 7b 0a 09 20 20 20 20 73 68 6f 77 20 7b at {.. show {
d9b0: 20 67 72 69 64 20 24 62 20 7d 0a 09 20 20 20 20 grid $b }..
d9c0: 68 69 64 65 20 7b 0a 09 09 73 65 74 20 69 20 5b hide {...set i [
d9d0: 67 72 69 64 20 69 6e 66 6f 20 24 62 5d 0a 09 09 grid info $b]...
d9e0: 69 66 20 7b 20 24 69 20 65 71 20 22 22 20 7d 20 if { $i eq "" }
d9f0: 7b 20 72 65 74 75 72 6e 20 7d 0a 09 09 67 72 69 { return }...gri
da00: 64 20 63 6f 6c 75 6d 6e 63 6f 6e 66 69 67 75 72 d columnconfigur
da10: 65 20 24 77 69 6e 2e 62 75 74 73 20 5b 64 69 63 e $win.buts [dic
da20: 74 20 67 65 74 20 24 69 20 2d 63 6f 6c 75 6d 6e t get $i -column
da30: 5d 20 5c 0a 09 09 20 20 20 20 2d 6d 69 6e 73 69 ] \... -minsi
da40: 7a 65 20 5b 77 69 6e 66 6f 20 77 69 64 74 68 20 ze [winfo width
da50: 24 62 5d 0a 09 09 67 72 69 64 20 72 65 6d 6f 76 $b]...grid remov
da60: 65 20 24 62 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 e $b.. }..}.
da70: 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 }. method
da80: 63 6f 6e 74 65 78 74 75 61 6c 5f 64 6f 63 6b 5f contextual_dock_
da90: 6d 65 6e 75 20 7b 20 78 20 79 20 7d 20 7b 0a 20 menu { x y } {.
daa0: 20 20 20 20 0a 09 64 65 73 74 72 6f 79 20 24 77 ..destroy $w
dab0: 69 6e 2e 64 6f 63 6b 6d 65 6e 75 0a 09 73 65 74 in.dockmenu..set
dac0: 20 6d 65 6e 75 20 5b 6d 65 6e 75 20 24 77 69 6e menu [menu $win
dad0: 2e 64 6f 63 6b 6d 65 6e 75 20 2d 74 65 61 72 6f .dockmenu -tearo
dae0: 66 66 20 30 5d 0a 09 24 6d 65 6e 75 20 61 64 64 ff 0]..$menu add
daf0: 20 63 6f 6d 6d 61 6e 64 20 2d 6c 61 62 65 6c 20 command -label
db00: 5b 5f 20 22 54 6f 67 67 6c 65 20 64 6f 63 6b 2f [_ "Toggle dock/
db10: 75 6e 64 6f 63 6b 22 5d 20 2d 63 6f 6d 6d 61 6e undock"] -comman
db20: 64 20 5c 0a 09 20 20 20 20 5b 6d 79 6d 65 74 68 d \.. [mymeth
db30: 6f 64 20 74 6f 6f 67 6c 65 5f 66 72 61 6d 65 5f od toogle_frame_
db40: 74 6f 70 6c 65 76 65 6c 5d 0a 20 20 0a 09 69 66 toplevel]. ..if
db50: 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 64 6f 63 { $options(-doc
db60: 6b 6d 65 6e 75 29 20 6e 65 20 22 22 20 7d 20 7b kmenu) ne "" } {
db70: 0a 09 20 20 20 20 24 6d 65 6e 75 20 61 64 64 20 .. $menu add
db80: 73 65 70 61 72 61 74 6f 72 0a 09 20 20 20 20 66 separator.. f
db90: 6f 72 65 61 63 68 20 64 20 24 6f 70 74 69 6f 6e oreach d $option
dba0: 73 28 2d 64 6f 63 6b 6d 65 6e 75 29 20 7b 0a 09 s(-dockmenu) {..
dbb0: 09 24 6d 65 6e 75 20 61 64 64 20 7b 2a 7d 24 64 .$menu add {*}$d
dbc0: 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 74 6b 5f 70 .. }..}..tk_p
dbd0: 6f 70 75 70 20 24 6d 65 6e 75 20 24 78 20 24 79 opup $menu $x $y
dbe0: 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 0. }. met
dbf0: 68 6f 64 20 74 6f 6f 6c 74 69 70 5f 62 75 74 74 hod tooltip_butt
dc00: 6f 6e 20 7b 20 6e 75 6d 20 61 72 67 73 20 7d 20 on { num args }
dc10: 7b 0a 09 0a 09 70 61 63 6b 61 67 65 20 72 65 71 {....package req
dc20: 75 69 72 65 20 74 6f 6f 6c 74 69 70 0a 09 69 66 uire tooltip..if
dc30: 20 7b 20 24 6e 75 6d 20 3d 3d 20 30 20 7d 20 7b { $num == 0 } {
dc40: 0a 09 20 20 20 20 73 65 74 20 20 62 20 24 77 69 .. set b $wi
dc50: 6e 2e 62 75 74 73 2e 63 61 6e 63 65 6c 0a 09 7d n.buts.cancel..}
dc60: 20 65 6c 73 65 69 66 20 7b 20 24 6e 75 6d 20 3d elseif { $num =
dc70: 3d 20 31 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 = 1 } {.. set
dc80: 20 62 20 24 77 69 6e 2e 62 75 74 73 2e 6f 6b 0a b $win.buts.ok.
dc90: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 66 .} else {.. f
dca0: 6f 72 65 61 63 68 20 69 20 5b 77 69 6e 66 6f 20 oreach i [winfo
dcb0: 63 68 69 6c 64 72 65 6e 20 24 77 69 6e 2e 62 75 children $win.bu
dcc0: 74 73 5d 20 7b 0a 09 09 69 66 20 7b 20 5b 72 65 ts] {...if { [re
dcd0: 67 65 78 70 20 22 5c 5c 6d 24 6e 75 6d 5c 5c 4d gexp "\\m$num\\M
dce0: 22 20 5b 24 69 20 63 67 65 74 20 2d 63 6f 6d 6d " [$i cget -comm
dcf0: 61 6e 64 5d 5d 20 7d 20 7b 0a 09 09 20 20 20 20 and]] } {...
dd00: 73 65 74 20 62 20 24 69 0a 09 09 20 20 20 20 62 set b $i... b
dd10: 72 65 61 6b 0a 09 09 7d 0a 09 20 20 20 20 7d 0a reak...}.. }.
dd20: 09 7d 0a 09 69 66 20 7b 20 5b 6c 6c 65 6e 67 74 .}..if { [llengt
dd30: 68 20 24 61 72 67 73 5d 20 3d 3d 20 31 20 7d 20 h $args] == 1 }
dd40: 7b 0a 09 20 20 20 20 74 6f 6f 6c 74 69 70 3a 3a {.. tooltip::
dd50: 74 6f 6f 6c 74 69 70 20 24 62 20 5b 6c 69 6e 64 tooltip $b [lind
dd60: 65 78 20 24 61 72 67 73 20 30 5d 0a 09 7d 20 65 ex $args 0]..} e
dd70: 6c 73 65 69 66 20 7b 20 5b 6c 6c 65 6e 67 74 68 lseif { [llength
dd80: 20 24 61 72 67 73 5d 20 3e 20 31 20 7d 20 7b 0a $args] > 1 } {.
dd90: 09 20 20 20 20 65 72 72 6f 72 20 22 65 72 72 6f . error "erro
dda0: 72 20 69 6e 20 74 6f 6f 6c 74 69 70 5f 62 75 74 r in tooltip_but
ddb0: 74 6f 6e 20 61 72 67 75 6d 65 6e 74 73 22 0a 09 ton arguments"..
ddc0: 7d 0a 09 72 65 74 75 72 6e 20 5b 74 6f 6f 6c 74 }..return [toolt
ddd0: 69 70 3a 3a 74 6f 6f 6c 74 69 70 20 24 62 5d 0a ip::tooltip $b].
dde0: 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 }. method
ddf0: 20 63 72 65 61 74 65 77 69 6e 64 6f 77 20 7b 7d createwindow {}
de00: 20 7b 0a 09 24 73 65 6c 66 20 63 72 65 61 74 65 {..$self create
de10: 77 69 6e 64 6f 77 6e 6f 77 61 69 74 0a 09 69 66 windownowait..if
de20: 20 7b 20 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 { ![winfo exist
de30: 73 20 24 77 69 6e 5d 20 7d 20 7b 20 72 65 74 75 s $win] } { retu
de40: 72 6e 20 7d 0a 09 72 65 74 75 72 6e 20 5b 24 73 rn }..return [$s
de50: 65 6c 66 20 77 61 69 74 66 6f 72 77 69 6e 64 6f elf waitforwindo
de60: 77 20 30 5d 0a 20 20 20 20 7d 0a 20 20 20 20 6d w 0]. }. m
de70: 65 74 68 6f 64 20 74 6f 6f 67 6c 65 5f 66 72 61 ethod toogle_fra
de80: 6d 65 5f 74 6f 70 6c 65 76 65 6c 20 7b 7d 20 7b me_toplevel {} {
de90: 0a 09 73 77 69 74 63 68 20 24 6f 70 74 69 6f 6e ..switch $option
dea0: 73 28 2d 66 72 61 6d 65 5f 74 6f 70 6c 65 76 65 s(-frame_topleve
deb0: 6c 29 20 7b 0a 09 20 20 20 20 74 6f 70 6c 65 76 l) {.. toplev
dec0: 65 6c 20 7b 20 73 65 74 20 6f 70 74 69 6f 6e 73 el { set options
ded0: 28 2d 66 72 61 6d 65 5f 74 6f 70 6c 65 76 65 6c (-frame_toplevel
dee0: 29 20 66 72 61 6d 65 20 7d 0a 09 20 20 20 20 66 ) frame }.. f
def0: 72 61 6d 65 20 7b 20 73 65 74 20 6f 70 74 69 6f rame { set optio
df00: 6e 73 28 2d 66 72 61 6d 65 5f 74 6f 70 6c 65 76 ns(-frame_toplev
df10: 65 6c 29 20 74 6f 70 6c 65 76 65 6c 20 7d 0a 09 el) toplevel }..
df20: 7d 0a 09 24 73 65 6c 66 20 63 72 65 61 74 65 77 }..$self createw
df30: 69 6e 64 6f 77 0a 20 20 20 20 7d 0a 20 20 20 20 indow. }.
df40: 6d 65 74 68 6f 64 20 63 72 65 61 74 65 77 69 6e method createwin
df50: 64 6f 77 6e 6f 77 61 69 74 20 7b 7d 20 7b 0a 09 downowait {} {..
df60: 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 66 if { $options(-f
df70: 72 61 6d 65 5f 74 6f 70 6c 65 76 65 6c 29 20 65 rame_toplevel) e
df80: 71 20 22 74 6f 70 6c 65 76 65 6c 22 20 7d 20 7b q "toplevel" } {
df90: 0a 09 20 20 20 20 24 73 65 6c 66 20 63 72 65 61 .. $self crea
dfa0: 74 65 77 69 6e 64 6f 77 6e 6f 77 61 69 74 5f 61 tewindownowait_a
dfb0: 73 5f 74 6f 70 6c 65 76 65 6c 0a 09 7d 20 65 6c s_toplevel..} el
dfc0: 73 65 20 7b 0a 09 20 20 20 20 24 73 65 6c 66 20 se {.. $self
dfd0: 63 72 65 61 74 65 77 69 6e 64 6f 77 6e 6f 77 61 createwindownowa
dfe0: 69 74 5f 61 73 5f 66 72 61 6d 65 0a 09 7d 0a 20 it_as_frame..}.
dff0: 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 }. method
e000: 63 72 65 61 74 65 77 69 6e 64 6f 77 6e 6f 77 61 createwindownowa
e010: 69 74 5f 61 73 5f 66 72 61 6d 65 20 7b 7d 20 7b it_as_frame {} {
e020: 0a 09 0a 09 69 66 20 7b 20 5b 77 69 6e 66 6f 20 ....if { [winfo
e030: 65 78 69 73 74 73 20 24 77 69 6e 2e 66 30 2e 62 exists $win.f0.b
e040: 75 74 73 5d 20 7d 20 7b 0a 09 20 20 20 20 69 66 uts] } {.. if
e050: 20 7b 20 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 { [winfo exists
e060: 20 24 77 69 6e 2e 73 65 70 5d 20 7d 20 7b 20 67 $win.sep] } { g
e070: 72 69 64 20 72 65 6d 6f 76 65 20 24 77 69 6e 2e rid remove $win.
e080: 73 65 70 20 7d 0a 09 20 20 20 20 67 72 69 64 20 sep }.. grid
e090: 72 65 6d 6f 76 65 20 24 77 69 6e 2e 62 75 74 73 remove $win.buts
e0a0: 0a 09 20 20 20 20 67 72 69 64 20 24 77 69 6e 2e .. grid $win.
e0b0: 66 30 2e 62 75 74 73 0a 09 7d 0a 09 24 77 69 6e f0.buts..}..$win
e0c0: 20 63 6f 6e 66 69 67 75 72 65 20 2d 62 64 20 31 configure -bd 1
e0d0: 20 2d 72 65 6c 69 65 66 20 72 69 64 67 65 0a 09 -relief ridge..
e0e0: 75 70 64 61 74 65 20 69 64 6c 65 74 61 73 6b 73 update idletasks
e0f0: 0a 09 77 6d 20 66 6f 72 67 65 74 20 24 77 69 6e ..wm forget $win
e100: 0a 09 66 6f 63 75 73 20 24 77 69 6e 0a 09 73 65 ..focus $win..se
e110: 74 20 65 72 72 20 5b 63 61 74 63 68 20 7b 20 75 t err [catch { u
e120: 70 6c 65 76 65 6c 20 23 30 20 24 6f 70 74 69 6f plevel #0 $optio
e130: 6e 73 28 2d 66 72 61 6d 65 5f 67 72 69 64 5f 63 ns(-frame_grid_c
e140: 6d 64 29 20 7d 5d 0a 09 69 66 20 7b 20 24 65 72 md) }]..if { $er
e150: 72 20 7d 20 7b 0a 09 20 20 20 20 61 66 74 65 72 r } {.. after
e160: 20 69 64 6c 65 20 5b 6c 69 73 74 20 24 73 65 6c idle [list $sel
e170: 66 20 63 72 65 61 74 65 77 69 6e 64 6f 77 6e 6f f createwindowno
e180: 77 61 69 74 5f 61 73 5f 74 6f 70 6c 65 76 65 6c wait_as_toplevel
e190: 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 6d ]..}. }. m
e1a0: 65 74 68 6f 64 20 63 72 65 61 74 65 77 69 6e 64 ethod createwind
e1b0: 6f 77 6e 6f 77 61 69 74 5f 61 73 5f 74 6f 70 6c ownowait_as_topl
e1c0: 65 76 65 6c 20 7b 7d 20 7b 0a 0a 09 73 65 74 20 evel {} {...set
e1d0: 70 61 72 65 6e 74 20 5b 77 69 6e 66 6f 20 70 61 parent [winfo pa
e1e0: 72 65 6e 74 20 24 77 69 6e 5d 0a 09 73 65 74 20 rent $win]..set
e1f0: 74 6f 70 20 5b 77 69 6e 66 6f 20 74 6f 70 6c 65 top [winfo tople
e200: 76 65 6c 20 24 70 61 72 65 6e 74 5d 0a 0a 09 69 vel $parent]...i
e210: 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 f { $::tcl_platf
e220: 6f 72 6d 28 6f 73 29 20 6e 65 20 22 44 61 72 77 orm(os) ne "Darw
e230: 69 6e 22 20 7d 20 7b 0a 09 20 20 20 20 77 6d 20 in" } {.. wm
e240: 6d 61 6e 61 67 65 20 24 77 69 6e 0a 09 7d 0a 09 manage $win..}..
e250: 77 6d 20 77 69 74 68 64 72 61 77 20 24 77 69 6e wm withdraw $win
e260: 0a 09 75 70 64 61 74 65 0a 0a 09 69 66 20 7b 20 ..update...if {
e270: 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 24 ![winfo exists $
e280: 77 69 6e 5d 20 7d 20 7b 20 72 65 74 75 72 6e 20 win] } { return
e290: 7d 0a 09 77 6d 20 74 69 74 6c 65 20 24 77 69 6e }..wm title $win
e2a0: 20 24 6f 70 74 69 6f 6e 73 28 2d 74 69 74 6c 65 $options(-title
e2b0: 29 0a 09 69 66 20 7b 20 24 3a 3a 74 63 6c 5f 70 )..if { $::tcl_p
e2c0: 6c 61 74 66 6f 72 6d 28 6f 73 29 20 65 71 20 22 latform(os) eq "
e2d0: 57 69 6e 64 6f 77 73 20 43 45 22 20 7d 20 7b 0a Windows CE" } {.
e2e0: 09 20 20 20 20 62 69 6e 64 20 24 77 69 6e 20 3c . bind $win <
e2f0: 43 6f 6e 66 69 67 75 72 65 52 65 71 75 65 73 74 ConfigureRequest
e300: 3e 20 7b 20 69 66 20 7b 20 22 25 57 22 20 65 71 > { if { "%W" eq
e310: 20 5b 77 69 6e 66 6f 20 74 6f 70 6c 65 76 65 6c [winfo toplevel
e320: 20 25 57 5d 20 7d 20 7b 20 65 74 63 6c 3a 3a 61 %W] } { etcl::a
e330: 75 74 6f 66 69 74 20 25 57 20 7d 7d 0a 09 20 20 utofit %W }}..
e340: 20 20 62 69 6e 64 20 24 77 69 6e 20 3c 45 78 70 bind $win <Exp
e350: 6f 73 65 3e 20 7b 20 69 66 20 7b 20 22 25 57 22 ose> { if { "%W"
e360: 20 65 71 20 5b 77 69 6e 66 6f 20 74 6f 70 6c 65 eq [winfo tople
e370: 76 65 6c 20 25 57 5d 20 7d 20 7b 20 65 74 63 6c vel %W] } { etcl
e380: 3a 3a 61 75 74 6f 66 69 74 20 25 57 20 7d 7d 0a ::autofit %W }}.
e390: 09 7d 0a 09 23 75 70 64 61 74 65 20 69 64 6c 65 .}..#update idle
e3a0: 74 61 73 6b 73 0a 0a 09 69 66 20 7b 20 5b 77 69 tasks...if { [wi
e3b0: 6e 66 6f 20 65 78 69 73 74 73 20 24 77 69 6e 2e nfo exists $win.
e3c0: 66 30 2e 62 75 74 73 5d 20 7d 20 7b 20 20 20 0a f0.buts] } { .
e3d0: 09 20 20 20 20 69 66 20 7b 20 5b 77 69 6e 66 6f . if { [winfo
e3e0: 20 65 78 69 73 74 73 20 24 77 69 6e 2e 73 65 70 exists $win.sep
e3f0: 5d 20 7d 20 7b 20 67 72 69 64 20 24 77 69 6e 2e ] } { grid $win.
e400: 73 65 70 20 7d 0a 09 20 20 20 20 67 72 69 64 20 sep }.. grid
e410: 24 77 69 6e 2e 62 75 74 73 0a 09 20 20 20 20 67 $win.buts.. g
e420: 72 69 64 20 72 65 6d 6f 76 65 20 24 77 69 6e 2e rid remove $win.
e430: 66 30 2e 62 75 74 73 0a 09 7d 0a 0a 09 6c 61 73 f0.buts..}...las
e440: 73 69 67 6e 20 22 22 20 77 69 64 74 68 20 68 65 sign "" width he
e450: 69 67 68 74 20 78 20 79 0a 09 69 66 20 7b 20 5b ight x y..if { [
e460: 63 61 74 63 68 20 7b 20 70 61 63 6b 61 67 65 20 catch { package
e470: 70 72 65 73 65 6e 74 20 74 77 61 70 69 20 7d 5d present twapi }]
e480: 20 3d 3d 20 30 20 7d 20 7b 0a 09 20 20 20 20 6c == 0 } {.. l
e490: 61 73 73 69 67 6e 20 5b 74 77 61 70 69 3a 3a 67 assign [twapi::g
e4a0: 65 74 5f 64 65 73 6b 74 6f 70 5f 77 6f 72 6b 61 et_desktop_worka
e4b0: 72 65 61 5d 20 73 63 72 5f 78 20 73 63 72 5f 79 rea] scr_x scr_y
e4c0: 20 73 63 72 5f 77 20 73 63 72 5f 68 0a 09 20 20 scr_w scr_h..
e4d0: 20 20 73 65 74 20 73 63 72 5f 77 20 5b 65 78 70 set scr_w [exp
e4e0: 72 20 7b 24 73 63 72 5f 77 2d 24 73 63 72 5f 78 r {$scr_w-$scr_x
e4f0: 7d 5d 0a 09 20 20 20 20 73 65 74 20 73 63 72 5f }].. set scr_
e500: 68 20 5b 65 78 70 72 20 7b 24 73 63 72 5f 68 2d h [expr {$scr_h-
e510: 24 73 63 72 5f 79 7d 5d 0a 09 7d 20 65 6c 73 65 $scr_y}]..} else
e520: 20 7b 0a 09 20 20 20 20 6c 61 73 73 69 67 6e 20 {.. lassign
e530: 5b 6c 69 73 74 20 30 20 30 20 5b 77 69 6e 66 6f [list 0 0 [winfo
e540: 20 73 63 72 65 65 6e 77 69 64 74 68 20 24 74 6f screenwidth $to
e550: 70 5d 20 5b 77 69 6e 66 6f 20 73 63 72 65 65 6e p] [winfo screen
e560: 68 65 69 67 68 74 20 24 74 6f 70 5d 5d 20 5c 0a height $top]] \.
e570: 09 09 73 63 72 5f 78 20 73 63 72 5f 79 20 73 63 ..scr_x scr_y sc
e580: 72 5f 77 20 73 63 72 5f 68 0a 09 7d 0a 09 69 66 r_w scr_h..}..if
e590: 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 67 65 6f { $options(-geo
e5a0: 6d 65 74 72 79 29 20 6e 65 20 22 22 20 26 26 20 metry) ne "" &&
e5b0: 24 6f 70 74 69 6f 6e 73 28 2d 67 65 6f 6d 65 74 $options(-geomet
e5c0: 72 79 29 20 6e 65 20 22 7a 6f 6f 6d 65 64 22 20 ry) ne "zoomed"
e5d0: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 21 5b } {.. if { ![
e5e0: 72 65 67 65 78 70 20 7b 28 5c 64 2b 29 78 28 5c regexp {(\d+)x(\
e5f0: 64 2b 29 28 3f 3a 5c 2b 28 5b 2d 5c 64 5d 2b 29 d+)(?:\+([-\d]+)
e600: 5c 2b 28 5b 2d 5c 64 5d 2b 29 29 3f 7d 20 5c 0a \+([-\d]+))?} \.
e610: 09 09 24 6f 70 74 69 6f 6e 73 28 2d 67 65 6f 6d ..$options(-geom
e620: 65 74 72 79 29 20 7b 7d 20 77 69 64 74 68 20 68 etry) {} width h
e630: 65 69 67 68 74 20 78 20 79 5d 20 7d 20 7b 0a 09 eight x y] } {..
e640: 09 72 65 67 65 78 70 20 7b 5e 5c 2b 28 5b 2d 5c .regexp {^\+([-\
e650: 64 5d 2b 29 5c 2b 28 5b 2d 5c 64 5d 2b 29 24 7d d]+)\+([-\d]+)$}
e660: 20 5c 0a 09 09 20 20 20 20 24 6f 70 74 69 6f 6e \... $option
e670: 73 28 2d 67 65 6f 6d 65 74 72 79 29 20 7b 7d 20 s(-geometry) {}
e680: 78 20 79 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 69 x y.. }..}..i
e690: 66 20 7b 20 24 77 69 64 74 68 20 65 71 20 22 22 f { $width eq ""
e6a0: 20 7c 7c 20 24 68 65 69 67 68 74 20 65 71 20 22 || $height eq "
e6b0: 22 20 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 " } {.. if {
e6c0: 24 6f 70 74 69 6f 6e 73 28 2d 6d 69 6e 77 69 64 $options(-minwid
e6d0: 74 68 29 20 21 3d 20 22 22 20 26 26 20 5b 77 69 th) != "" && [wi
e6e0: 6e 66 6f 20 72 65 71 77 69 64 74 68 20 24 77 69 nfo reqwidth $wi
e6f0: 6e 5d 20 3c 20 24 6f 70 74 69 6f 6e 73 28 2d 6d n] < $options(-m
e700: 69 6e 77 69 64 74 68 29 20 7d 20 7b 0a 09 09 73 inwidth) } {...s
e710: 65 74 20 77 69 64 74 68 20 24 6f 70 74 69 6f 6e et width $option
e720: 73 28 2d 6d 69 6e 77 69 64 74 68 29 0a 09 20 20 s(-minwidth)..
e730: 20 20 7d 20 65 6c 73 65 20 7b 20 73 65 74 20 77 } else { set w
e740: 69 64 74 68 20 5b 77 69 6e 66 6f 20 72 65 71 77 idth [winfo reqw
e750: 69 64 74 68 20 24 77 69 6e 5d 20 7d 0a 09 20 20 idth $win] }..
e760: 20 20 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 if { $options(
e770: 2d 6d 69 6e 68 65 69 67 68 74 29 20 21 3d 20 22 -minheight) != "
e780: 22 20 26 26 20 5b 77 69 6e 66 6f 20 72 65 71 68 " && [winfo reqh
e790: 65 69 67 68 74 20 24 77 69 6e 5d 20 3c 20 24 6f eight $win] < $o
e7a0: 70 74 69 6f 6e 73 28 2d 6d 69 6e 68 65 69 67 68 ptions(-minheigh
e7b0: 74 29 20 7d 20 7b 0a 09 09 73 65 74 20 68 65 69 t) } {...set hei
e7c0: 67 68 74 20 24 6f 70 74 69 6f 6e 73 28 2d 6d 69 ght $options(-mi
e7d0: 6e 68 65 69 67 68 74 29 0a 09 20 20 20 20 7d 20 nheight).. }
e7e0: 65 6c 73 65 20 7b 20 73 65 74 20 68 65 69 67 68 else { set heigh
e7f0: 74 20 5b 77 69 6e 66 6f 20 72 65 71 68 65 69 67 t [winfo reqheig
e800: 68 74 20 24 77 69 6e 5d 20 7d 0a 0a 09 20 20 20 ht $win] }...
e810: 20 69 66 20 7b 20 24 77 69 64 74 68 20 3e 20 24 if { $width > $
e820: 73 63 72 5f 77 20 7d 20 7b 20 73 65 74 20 77 69 scr_w } { set wi
e830: 64 74 68 20 24 73 63 72 5f 77 20 7d 0a 09 20 20 dth $scr_w }..
e840: 20 20 69 66 20 7b 20 24 68 65 69 67 68 74 20 3e if { $height >
e850: 20 24 73 63 72 5f 68 20 7d 20 7b 20 73 65 74 20 $scr_h } { set
e860: 68 65 69 67 68 74 20 24 73 63 72 5f 68 20 7d 0a height $scr_h }.
e870: 09 7d 0a 09 69 66 20 7b 20 24 78 20 65 71 20 22 .}..if { $x eq "
e880: 22 20 7c 7c 20 24 79 20 65 71 20 22 22 20 7d 20 " || $y eq "" }
e890: 7b 0a 09 20 20 20 20 73 65 74 20 62 69 67 20 30 {.. set big 0
e8a0: 0a 09 20 20 20 20 69 66 20 7b 20 24 77 69 64 74 .. if { $widt
e8b0: 68 20 3e 20 2e 38 2a 24 73 63 72 5f 77 20 7d 20 h > .8*$scr_w }
e8c0: 7b 20 73 65 74 20 62 69 67 20 31 20 7d 0a 09 20 { set big 1 }..
e8d0: 20 20 20 69 66 20 7b 20 24 68 65 69 67 68 74 20 if { $height
e8e0: 3e 20 2e 38 2a 24 73 63 72 5f 68 20 7d 20 7b 20 > .8*$scr_h } {
e8f0: 73 65 74 20 62 69 67 20 31 20 7d 0a 09 0a 09 20 set big 1 }....
e900: 20 20 20 69 66 20 7b 20 24 62 69 67 20 7c 7c 20 if { $big ||
e910: 5b 77 6d 20 73 74 61 74 65 20 24 74 6f 70 5d 20 [wm state $top]
e920: 3d 3d 20 22 77 69 74 68 64 72 61 77 6e 22 20 7d == "withdrawn" }
e930: 20 7b 0a 09 09 73 65 74 20 78 20 5b 65 78 70 72 {...set x [expr
e940: 20 7b 24 73 63 72 5f 78 2b 24 73 63 72 5f 77 2f {$scr_x+$scr_w/
e950: 32 2d 24 77 69 64 74 68 2f 32 7d 5d 0a 09 09 73 2-$width/2}]...s
e960: 65 74 20 79 20 5b 65 78 70 72 20 7b 24 73 63 72 et y [expr {$scr
e970: 5f 79 2b 24 73 63 72 5f 68 2f 32 2d 24 68 65 69 _y+$scr_h/2-$hei
e980: 67 68 74 2f 32 7d 5d 0a 09 20 20 20 20 7d 20 65 ght/2}].. } e
e990: 6c 73 65 20 7b 0a 09 09 73 65 74 20 78 20 5b 65 lse {...set x [e
e9a0: 78 70 72 20 5b 77 69 6e 66 6f 20 72 6f 6f 74 78 xpr [winfo rootx
e9b0: 20 24 70 61 72 65 6e 74 5d 2b 5b 77 69 6e 66 6f $parent]+[winfo
e9c0: 20 77 69 64 74 68 20 24 70 61 72 65 6e 74 5d 2f width $parent]/
e9d0: 32 2d 24 77 69 64 74 68 2f 32 5d 0a 09 09 73 65 2-$width/2]...se
e9e0: 74 20 79 20 5b 65 78 70 72 20 5b 77 69 6e 66 6f t y [expr [winfo
e9f0: 20 72 6f 6f 74 79 20 24 70 61 72 65 6e 74 5d 2b rooty $parent]+
ea00: 5b 77 69 6e 66 6f 20 68 65 69 67 68 74 20 24 70 [winfo height $p
ea10: 61 72 65 6e 74 5d 2f 32 2d 24 68 65 69 67 68 74 arent]/2-$height
ea20: 2f 32 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 /2].. }..
ea30: 69 66 20 7b 20 24 78 2b 24 77 69 64 74 68 20 3e if { $x+$width >
ea40: 20 24 73 63 72 5f 77 2b 24 73 63 72 5f 78 20 7d $scr_w+$scr_x }
ea50: 20 7b 0a 09 09 73 65 74 20 78 20 5b 65 78 70 72 {...set x [expr
ea60: 20 7b 24 73 63 72 5f 78 2b 24 73 63 72 5f 77 2d {$scr_x+$scr_w-
ea70: 24 77 69 64 74 68 7d 5d 0a 09 20 20 20 20 7d 0a $width}].. }.
ea80: 09 20 20 20 20 69 66 20 7b 20 24 79 2b 24 68 65 . if { $y+$he
ea90: 69 67 68 74 20 3e 20 24 73 63 72 5f 68 2b 24 73 ight > $scr_h+$s
eaa0: 63 72 5f 79 20 7d 20 7b 0a 09 09 73 65 74 20 79 cr_y } {...set y
eab0: 20 5b 65 78 70 72 20 7b 24 73 63 72 5f 79 2b 24 [expr {$scr_y+$
eac0: 73 63 72 5f 68 2d 24 68 65 69 67 68 74 7d 5d 0a scr_h-$height}].
ead0: 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 7b . }.. if {
eae0: 20 24 78 20 3c 20 30 20 7d 20 7b 20 73 65 74 20 $x < 0 } { set
eaf0: 78 20 30 20 7d 0a 09 20 20 20 20 69 66 20 7b 20 x 0 }.. if {
eb00: 24 77 69 64 74 68 20 3e 20 24 73 63 72 5f 77 20 $width > $scr_w
eb10: 7d 20 7b 20 73 65 74 20 77 69 64 74 68 20 24 73 } { set width $s
eb20: 63 72 5f 77 20 7d 0a 0a 09 20 20 20 20 73 65 74 cr_w }... set
eb30: 20 65 72 72 20 5b 63 61 74 63 68 20 7b 20 70 61 err [catch { pa
eb40: 63 6b 61 67 65 20 70 72 65 73 65 6e 74 20 77 63 ckage present wc
eb50: 65 20 7d 5d 0a 09 20 20 20 20 69 66 20 7b 20 21 e }].. if { !
eb60: 24 65 72 72 20 7d 20 7b 0a 09 09 66 6f 72 65 61 $err } {...forea
eb70: 63 68 20 22 78 30 20 79 30 20 78 31 20 79 31 22 ch "x0 y0 x1 y1"
eb80: 20 5b 77 63 65 20 73 69 70 69 6e 66 6f 5d 20 62 [wce sipinfo] b
eb90: 72 65 61 6b 0a 09 09 69 66 20 7b 20 24 79 20 3c reak...if { $y <
eba0: 20 24 79 30 20 7d 20 7b 20 73 65 74 20 79 20 24 $y0 } { set y $
ebb0: 79 30 20 7d 0a 09 09 69 66 20 7b 20 24 68 65 69 y0 }...if { $hei
ebc0: 67 68 74 20 3e 20 24 79 31 2d 24 79 30 20 7d 20 ght > $y1-$y0 }
ebd0: 7b 0a 09 09 20 20 20 20 73 65 74 20 68 65 69 67 {... set heig
ebe0: 68 74 20 5b 65 78 70 72 20 7b 24 79 31 2d 24 79 ht [expr {$y1-$y
ebf0: 30 7d 5d 0a 09 09 7d 0a 09 20 20 20 20 7d 20 20 0}]...}.. }
ec00: 65 6c 73 65 20 7b 0a 09 09 69 66 20 7b 20 24 79 else {...if { $y
ec10: 20 3c 20 30 20 7d 20 7b 20 73 65 74 20 79 20 30 < 0 } { set y 0
ec20: 20 7d 0a 09 09 69 66 20 7b 20 24 68 65 69 67 68 }...if { $heigh
ec30: 74 20 3e 20 24 73 63 72 5f 68 20 7d 20 7b 0a 09 t > $scr_h } {..
ec40: 09 20 20 20 20 73 65 74 20 68 65 69 67 68 74 20 . set height
ec50: 24 73 63 72 5f 68 0a 09 09 7d 0a 09 20 20 20 20 $scr_h...}..
ec60: 7d 0a 09 7d 0a 0a 09 77 6d 20 67 65 6f 6d 65 74 }..}...wm geomet
ec70: 72 79 20 24 77 69 6e 20 24 7b 77 69 64 74 68 7d ry $win ${width}
ec80: 78 24 7b 68 65 69 67 68 74 7d 2b 24 7b 78 7d 2b x${height}+${x}+
ec90: 24 79 0a 09 0a 09 69 66 20 7b 20 24 6f 70 74 69 $y....if { $opti
eca0: 6f 6e 73 28 2d 74 72 61 6e 73 69 65 6e 74 29 20 ons(-transient)
ecb0: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 5b 77 } {.. if { [w
ecc0: 6d 20 73 74 61 74 65 20 24 74 6f 70 5d 20 6e 65 m state $top] ne
ecd0: 20 22 77 69 74 68 64 72 61 77 6e 22 20 7d 20 7b "withdrawn" } {
ece0: 0a 09 09 77 6d 20 74 72 61 6e 73 69 65 6e 74 20 ...wm transient
ecf0: 24 77 69 6e 20 24 70 61 72 65 6e 74 0a 09 20 20 $win $parent..
ed00: 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 20 24 3a }.. if { $:
ed10: 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c :tcl_platform(pl
ed20: 61 74 66 6f 72 6d 29 20 65 71 20 22 75 6e 69 78 atform) eq "unix
ed30: 22 20 7d 20 7b 0a 09 09 77 6d 20 61 74 74 72 69 " } {...wm attri
ed40: 62 75 74 65 73 20 24 77 69 6e 20 2d 74 79 70 65 butes $win -type
ed50: 20 64 69 61 6c 6f 67 0a 09 20 20 20 20 7d 0a 09 dialog.. }..
ed60: 7d 0a 09 75 70 64 61 74 65 0a 09 69 66 20 7b 20 }..update..if {
ed70: 21 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 24 ![winfo exists $
ed80: 77 69 6e 5d 20 7d 20 7b 0a 09 20 20 20 20 72 65 win] } {.. re
ed90: 74 75 72 6e 0a 09 7d 0a 09 23 20 74 68 69 73 20 turn..}..# this
eda0: 69 73 20 6e 65 63 65 73 73 61 72 79 20 62 65 63 is necessary bec
edb0: 61 75 73 65 20 77 69 74 68 20 6a 75 73 74 20 6f ause with just o
edc0: 6e 65 20 67 65 6f 6d 65 74 72 79 20 69 73 20 64 ne geometry is d
edd0: 6f 65 73 20 6e 6f 74 20 77 6f 72 6b 20 61 6c 77 oes not work alw
ede0: 61 79 73 20 6f 6b 0a 09 77 6d 20 67 65 6f 6d 65 ays ok..wm geome
edf0: 74 72 79 20 24 77 69 6e 20 24 7b 77 69 64 74 68 try $win ${width
ee00: 7d 78 24 7b 68 65 69 67 68 74 7d 2b 24 7b 78 7d }x${height}+${x}
ee10: 2b 24 79 0a 0a 09 77 6d 20 64 65 69 63 6f 6e 69 +$y...wm deiconi
ee20: 66 79 20 24 77 69 6e 0a 09 75 70 64 61 74 65 20 fy $win..update
ee30: 69 64 6c 65 74 61 73 6b 73 0a 09 77 6d 20 67 65 idletasks..wm ge
ee40: 6f 6d 65 74 72 79 20 24 77 69 6e 20 5b 77 6d 20 ometry $win [wm
ee50: 67 65 6f 6d 65 74 72 79 20 24 77 69 6e 5d 0a 09 geometry $win]..
ee60: 73 65 74 20 6f 6c 64 46 6f 63 75 73 20 5b 66 6f set oldFocus [fo
ee70: 63 75 73 20 2d 64 69 73 70 6c 61 79 6f 66 20 24 cus -displayof $
ee80: 77 69 6e 5d 0a 09 66 6f 63 75 73 20 24 77 69 6e win]..focus $win
ee90: 0a 09 69 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 ..if { $options(
eea0: 2d 67 72 61 62 29 20 7d 20 7b 0a 09 20 20 20 20 -grab) } {..
eeb0: 73 65 74 20 6f 6c 64 47 72 61 62 20 5b 67 72 61 set oldGrab [gra
eec0: 62 20 63 75 72 72 65 6e 74 20 24 77 69 6e 5d 0a b current $win].
eed0: 09 20 20 20 20 69 66 20 7b 20 24 6f 6c 64 47 72 . if { $oldGr
eee0: 61 62 20 6e 65 20 22 22 20 26 26 20 5b 77 69 6e ab ne "" && [win
eef0: 66 6f 20 65 78 69 73 74 73 20 24 6f 6c 64 47 72 fo exists $oldGr
ef00: 61 62 5d 20 7d 20 7b 0a 09 09 73 65 74 20 67 72 ab] } {...set gr
ef10: 61 62 53 74 61 74 75 73 20 5b 67 72 61 62 20 73 abStatus [grab s
ef20: 74 61 74 75 73 20 24 6f 6c 64 47 72 61 62 5d 0a tatus $oldGrab].
ef30: 09 09 67 72 61 62 20 72 65 6c 65 61 73 65 20 24 ..grab release $
ef40: 6f 6c 64 47 72 61 62 0a 09 20 20 20 20 7d 0a 09 oldGrab.. }..
ef50: 20 20 20 20 63 61 74 63 68 20 7b 20 67 72 61 62 catch { grab
ef60: 20 24 77 69 6e 20 7d 0a 09 7d 20 65 6c 73 65 20 $win }..} else
ef70: 7b 0a 09 20 20 20 20 73 65 74 20 6f 6c 64 47 72 {.. set oldGr
ef80: 61 62 20 22 22 0a 09 7d 0a 09 75 70 64 61 74 65 ab ""..}..update
ef90: 0a 09 69 66 20 7b 20 21 5b 77 69 6e 66 6f 20 65 ..if { ![winfo e
efa0: 78 69 73 74 73 20 24 77 69 6e 5d 20 7d 20 7b 20 xists $win] } {
efb0: 72 65 74 75 72 6e 20 7d 0a 09 73 65 74 20 66 6f return }..set fo
efc0: 63 75 73 20 5b 66 6f 63 75 73 20 2d 6c 61 73 74 cus [focus -last
efd0: 66 6f 72 20 24 77 69 6e 5d 0a 09 69 66 20 7b 20 for $win]..if {
efe0: 24 66 6f 63 75 73 20 6e 65 20 22 22 20 7d 20 7b $focus ne "" } {
eff0: 20 74 6b 3a 3a 54 61 62 54 6f 57 69 6e 64 6f 77 tk::TabToWindow
f000: 20 24 66 6f 63 75 73 20 7d 0a 09 69 66 20 7b 20 $focus }..if {
f010: 24 66 6f 63 75 73 20 65 71 20 22 22 20 7d 20 7b $focus eq "" } {
f020: 20 73 65 74 20 66 6f 63 75 73 20 24 77 69 6e 20 set focus $win
f030: 7d 0a 09 66 6f 63 75 73 20 2d 66 6f 72 63 65 20 }..focus -force
f040: 24 66 6f 63 75 73 0a 09 69 66 20 7b 20 24 6f 70 $focus..if { $op
f050: 74 69 6f 6e 73 28 2d 74 6f 70 6c 65 76 65 6c 5f tions(-toplevel_
f060: 63 6d 64 29 20 6e 65 20 22 22 20 7d 20 7b 0a 09 cmd) ne "" } {..
f070: 20 20 20 20 75 70 6c 65 76 65 6c 20 23 30 20 24 uplevel #0 $
f080: 6f 70 74 69 6f 6e 73 28 2d 74 6f 70 6c 65 76 65 options(-topleve
f090: 6c 5f 63 6d 64 29 0a 09 7d 0a 20 20 20 20 7d 0a l_cmd)..}. }.
f0a0: 20 20 20 20 6d 65 74 68 6f 64 20 5f 61 70 70 6c method _appl
f0b0: 79 61 63 74 69 6f 6e 20 7b 20 76 61 6c 75 65 20 yaction { value
f0c0: 7d 20 7b 0a 09 73 65 74 20 61 63 74 69 6f 6e 20 } {..set action
f0d0: 24 76 61 6c 75 65 0a 09 69 66 20 7b 20 24 6f 70 $value..if { $op
f0e0: 74 69 6f 6e 73 28 2d 63 61 6c 6c 62 61 63 6b 29 tions(-callback)
f0f0: 20 6e 65 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 ne "" } {..
f100: 75 70 6c 65 76 65 6c 20 23 30 20 24 6f 70 74 69 uplevel #0 $opti
f110: 6f 6e 73 28 2d 63 61 6c 6c 62 61 63 6b 29 20 24 ons(-callback) $
f120: 77 69 6e 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 win..}. }.
f130: 20 6d 65 74 68 6f 64 20 67 69 76 65 61 63 74 69 method giveacti
f140: 6f 6e 20 7b 7d 20 7b 0a 09 72 65 74 75 72 6e 20 on {} {..return
f150: 24 61 63 74 69 6f 6e 0a 20 20 20 20 7d 0a 20 20 $action. }.
f160: 20 20 6d 65 74 68 6f 64 20 77 61 69 74 66 6f 72 method waitfor
f170: 77 69 6e 64 6f 77 20 7b 20 7b 20 72 61 69 73 65 window { { raise
f180: 20 30 20 7d 20 7d 20 7b 0a 0a 09 69 66 20 7b 20 0 } } {...if {
f190: 24 72 61 69 73 65 20 3d 3d 20 22 22 20 7d 20 7b $raise == "" } {
f1a0: 0a 09 20 20 20 20 23 20 74 68 69 73 20 69 73 20 .. # this is
f1b0: 74 6f 20 61 76 6f 69 64 20 74 68 65 20 32 20 73 to avoid the 2 s
f1c0: 65 63 6f 6e 64 20 70 72 6f 62 6c 65 6d 20 69 6e econd problem in
f1d0: 20 4b 44 45 20 32 0a 09 20 20 20 20 69 66 20 7b KDE 2.. if {
f1e0: 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d $::tcl_platform
f1f0: 28 70 6c 61 74 66 6f 72 6d 29 20 3d 3d 20 22 77 (platform) == "w
f200: 69 6e 64 6f 77 73 22 20 7d 20 7b 0a 09 09 73 65 indows" } {...se
f210: 74 20 72 61 69 73 65 20 31 0a 09 20 20 20 20 7d t raise 1.. }
f220: 20 65 6c 73 65 20 7b 20 73 65 74 20 72 61 69 73 else { set rais
f230: 65 20 30 20 7d 0a 09 7d 0a 09 69 66 20 7b 20 24 e 0 }..}..if { $
f240: 72 61 69 73 65 20 7d 20 7b 0a 09 20 20 20 20 72 raise } {.. r
f250: 61 69 73 65 20 5b 77 69 6e 66 6f 20 74 6f 70 6c aise [winfo topl
f260: 65 76 65 6c 20 24 77 69 6e 5d 0a 09 7d 0a 09 69 evel $win]..}..i
f270: 66 20 7b 20 24 6f 70 74 69 6f 6e 73 28 2d 63 61 f { $options(-ca
f280: 6c 6c 62 61 63 6b 29 20 6e 65 20 22 22 20 7d 20 llback) ne "" }
f290: 7b 0a 09 20 20 20 20 72 65 74 75 72 6e 0a 09 7d {.. return..}
f2a0: 0a 09 73 65 74 20 61 63 74 69 6f 6e 20 2d 32 0a ..set action -2.
f2b0: 09 76 77 61 69 74 20 5b 76 61 72 6e 61 6d 65 20 .vwait [varname
f2c0: 61 63 74 69 6f 6e 5d 0a 09 69 66 20 7b 20 21 5b action]..if { ![
f2d0: 69 6e 66 6f 20 65 78 69 73 74 73 20 61 63 74 69 info exists acti
f2e0: 6f 6e 5d 20 7d 20 7b 20 72 65 74 75 72 6e 20 2d on] } { return -
f2f0: 31 20 7d 0a 09 72 65 74 75 72 6e 20 24 61 63 74 1 }..return $act
f300: 69 6f 6e 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 ion. }. me
f310: 74 68 6f 64 20 77 69 74 68 64 72 61 77 77 69 6e thod withdrawwin
f320: 64 6f 77 20 7b 7d 20 7b 0a 09 69 66 20 7b 20 24 dow {} {..if { $
f330: 6f 70 74 69 6f 6e 73 28 2d 67 72 61 62 29 20 7d options(-grab) }
f340: 20 7b 0a 09 20 20 20 20 67 72 61 62 20 72 65 6c {.. grab rel
f350: 65 61 73 65 20 24 77 69 6e 0a 09 20 20 20 20 69 ease $win.. i
f360: 66 20 7b 20 24 6f 6c 64 47 72 61 62 20 6e 65 20 f { $oldGrab ne
f370: 22 22 20 7d 20 20 7b 0a 09 09 69 66 20 7b 20 5b "" } {...if { [
f380: 69 6e 66 6f 20 65 78 69 73 74 73 20 67 72 61 62 info exists grab
f390: 53 74 61 74 75 73 5d 20 26 26 20 24 67 72 61 62 Status] && $grab
f3a0: 53 74 61 74 75 73 20 6e 65 20 22 67 6c 6f 62 61 Status ne "globa
f3b0: 6c 22 20 7d 20 7b 0a 09 09 20 20 20 20 69 66 20 l" } {... if
f3c0: 7b 20 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 { [winfo exists
f3d0: 24 6f 6c 64 47 72 61 62 5d 20 26 26 20 5b 77 69 $oldGrab] && [wi
f3e0: 6e 66 6f 20 69 73 6d 61 70 70 65 64 20 24 6f 6c nfo ismapped $ol
f3f0: 64 47 72 61 62 5d 20 7d 20 7b 0a 09 09 20 20 20 dGrab] } {...
f400: 20 20 20 20 20 67 72 61 62 20 24 6f 6c 64 47 72 grab $oldGr
f410: 61 62 0a 09 09 20 20 20 20 7d 0a 09 09 7d 20 65 ab... }...} e
f420: 6c 73 65 20 7b 0a 09 09 20 20 20 20 69 66 20 7b lse {... if {
f430: 20 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 24 [winfo exists $
f440: 6f 6c 64 47 72 61 62 5d 20 26 26 20 5b 77 69 6e oldGrab] && [win
f450: 66 6f 20 69 73 6d 61 70 70 65 64 20 24 6f 6c 64 fo ismapped $old
f460: 47 72 61 62 5d 20 7d 20 7b 0a 09 09 20 20 20 20 Grab] } {...
f470: 20 20 20 20 67 72 61 62 20 2d 67 6c 6f 62 61 6c grab -global
f480: 20 24 6f 6c 64 47 72 61 62 0a 09 09 20 20 20 20 $oldGrab...
f490: 7d 0a 09 09 7d 0a 09 20 20 20 20 7d 0a 09 20 20 }...}.. }..
f4a0: 20 20 73 65 74 20 6f 6c 64 47 72 61 62 20 22 22 set oldGrab ""
f4b0: 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 66 6f .. catch { fo
f4c0: 63 75 73 20 24 6f 6c 64 46 6f 63 75 73 20 7d 0a cus $oldFocus }.
f4d0: 09 20 20 20 20 73 65 74 20 6f 6c 64 46 6f 63 75 . set oldFocu
f4e0: 73 20 22 22 0a 09 7d 0a 09 77 6d 20 77 69 74 68 s ""..}..wm with
f4f0: 64 72 61 77 20 24 77 69 6e 0a 20 20 20 20 7d 0a draw $win. }.
f500: 20 20 20 20 6d 65 74 68 6f 64 20 64 65 69 63 6f method deico
f510: 6e 69 66 79 77 69 6e 64 6f 77 20 7b 7d 20 7b 0a nifywindow {} {.
f520: 09 0a 09 73 65 74 20 6f 6c 64 46 6f 63 75 73 20 ...set oldFocus
f530: 5b 66 6f 63 75 73 20 2d 64 69 73 70 6c 61 79 6f [focus -displayo
f540: 66 20 24 77 69 6e 5d 0a 09 66 6f 63 75 73 20 24 f $win]..focus $
f550: 77 69 6e 0a 0a 09 69 66 20 7b 20 24 6f 70 74 69 win...if { $opti
f560: 6f 6e 73 28 2d 67 72 61 62 29 20 7d 20 7b 0a 09 ons(-grab) } {..
f570: 20 20 20 20 73 65 74 20 6f 6c 64 47 72 61 62 20 set oldGrab
f580: 5b 67 72 61 62 20 63 75 72 72 65 6e 74 20 24 77 [grab current $w
f590: 69 6e 5d 0a 09 20 20 20 20 69 66 20 7b 20 24 6f in].. if { $o
f5a0: 6c 64 47 72 61 62 20 6e 65 20 22 22 20 26 26 20 ldGrab ne "" &&
f5b0: 5b 77 69 6e 66 6f 20 65 78 69 73 74 73 20 24 6f [winfo exists $o
f5c0: 6c 64 47 72 61 62 5d 20 7d 20 7b 0a 09 09 73 65 ldGrab] } {...se
f5d0: 74 20 67 72 61 62 53 74 61 74 75 73 20 5b 67 72 t grabStatus [gr
f5e0: 61 62 20 73 74 61 74 75 73 20 24 6f 6c 64 47 72 ab status $oldGr
f5f0: 61 62 5d 0a 09 09 67 72 61 62 20 72 65 6c 65 61 ab]...grab relea
f600: 73 65 20 24 6f 6c 64 47 72 61 62 0a 09 20 20 20 se $oldGrab..
f610: 20 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 }.. catch {
f620: 67 72 61 62 20 24 77 69 6e 20 7d 0a 09 7d 20 65 grab $win }..} e
f630: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 6f lse {.. set o
f640: 6c 64 47 72 61 62 20 22 22 0a 09 7d 0a 09 77 6d ldGrab ""..}..wm
f650: 20 64 65 69 63 6f 6e 69 66 79 20 24 77 69 6e 0a deiconify $win.
f660: 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 }. method
f670: 20 69 73 77 61 69 74 69 6e 67 20 7b 7d 20 7b 0a iswaiting {} {.
f680: 09 69 66 20 7b 20 5b 69 6e 66 6f 20 65 78 69 73 .if { [info exis
f690: 74 73 20 61 63 74 69 6f 6e 5d 20 26 26 20 24 61 ts action] && $a
f6a0: 63 74 69 6f 6e 20 3d 3d 20 2d 32 20 7d 20 7b 20 ction == -2 } {
f6b0: 72 65 74 75 72 6e 20 31 20 7d 0a 09 72 65 74 75 return 1 }..retu
f6c0: 72 6e 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 6d rn 0. }. m
f6d0: 65 74 68 6f 64 20 67 69 76 65 65 6e 74 72 79 76 ethod giveentryv
f6e0: 61 6c 75 65 20 7b 7d 20 7b 0a 09 72 65 74 75 72 alue {} {..retur
f6f0: 6e 20 24 65 6e 74 72 79 76 61 6c 75 65 0a 20 20 n $entryvalue.
f700: 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 67 }. method g
f710: 69 76 65 5f 72 65 70 65 61 74 5f 6d 79 5f 61 6e ive_repeat_my_an
f720: 73 77 65 72 20 7b 7d 20 7b 0a 09 72 65 74 75 72 swer {} {..retur
f730: 6e 20 24 72 65 70 65 61 74 5f 6d 79 5f 61 6e 73 n $repeat_my_ans
f740: 77 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 wer. }. me
f750: 74 68 6f 64 20 65 78 69 73 74 73 5f 75 73 65 72 thod exists_user
f760: 76 61 72 20 7b 20 6b 65 79 20 7d 20 7b 0a 09 72 var { key } {..r
f770: 65 74 75 72 6e 20 5b 69 6e 66 6f 20 65 78 69 73 eturn [info exis
f780: 74 73 20 75 73 65 72 76 61 72 28 24 6b 65 79 29 ts uservar($key)
f790: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 ]. }. meth
f7a0: 6f 64 20 67 69 76 65 5f 75 73 65 72 76 61 72 20 od give_uservar
f7b0: 7b 20 61 72 67 73 20 7d 20 7b 0a 09 73 77 69 74 { args } {..swit
f7c0: 63 68 20 2d 2d 20 5b 6c 6c 65 6e 67 74 68 20 24 ch -- [llength $
f7d0: 61 72 67 73 5d 20 7b 0a 09 20 20 20 20 31 20 7b args] {.. 1 {
f7e0: 0a 09 09 23 6e 6f 74 68 69 6e 67 0a 09 20 20 20 ...#nothing..
f7f0: 20 7d 0a 09 20 20 20 20 32 20 7b 0a 09 09 73 65 }.. 2 {...se
f800: 74 20 75 73 65 72 76 61 72 28 5b 6c 69 6e 64 65 t uservar([linde
f810: 78 20 24 61 72 67 73 20 30 5d 29 20 5b 6c 69 6e x $args 0]) [lin
f820: 64 65 78 20 24 61 72 67 73 20 31 5d 0a 09 20 20 dex $args 1]..
f830: 20 20 7d 0a 09 20 20 20 20 64 65 66 61 75 6c 74 }.. default
f840: 20 7b 0a 09 09 65 72 72 6f 72 20 22 65 72 72 6f {...error "erro
f850: 72 20 69 6e 20 67 69 76 65 5f 75 73 65 72 76 61 r in give_userva
f860: 72 22 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 72 65 r".. }..}..re
f870: 74 75 72 6e 20 5b 76 61 72 6e 61 6d 65 20 75 73 turn [varname us
f880: 65 72 76 61 72 28 5b 6c 69 6e 64 65 78 20 24 61 ervar([lindex $a
f890: 72 67 73 20 30 5d 29 5d 0a 20 20 20 20 7d 0a 20 rgs 0])]. }.
f8a0: 20 20 20 6d 65 74 68 6f 64 20 73 65 74 5f 75 73 method set_us
f8b0: 65 72 76 61 72 5f 76 61 6c 75 65 20 7b 20 6b 65 ervar_value { ke
f8c0: 79 20 6e 65 77 76 61 6c 75 65 20 7d 20 7b 0a 09 y newvalue } {..
f8d0: 73 65 74 20 75 73 65 72 76 61 72 28 24 6b 65 79 set uservar($key
f8e0: 29 20 24 6e 65 77 76 61 6c 75 65 0a 20 20 20 20 ) $newvalue.
f8f0: 7d 0a 20 20 20 20 23 20 6f 6e 6c 79 20 61 63 74 }. # only act
f900: 69 76 61 74 65 20 77 72 69 74 65 20 74 72 61 63 ivate write trac
f910: 65 73 20 69 66 20 64 69 66 66 65 72 65 6e 74 0a es if different.
f920: 20 20 20 20 6d 65 74 68 6f 64 20 75 70 64 61 74 method updat
f930: 65 5f 75 73 65 72 76 61 72 5f 76 61 6c 75 65 20 e_uservar_value
f940: 7b 20 6b 65 79 20 6e 65 77 76 61 6c 75 65 20 7d { key newvalue }
f950: 20 7b 0a 09 69 66 20 7b 20 24 6e 65 77 76 61 6c {..if { $newval
f960: 75 65 20 6e 65 20 24 75 73 65 72 76 61 72 28 24 ue ne $uservar($
f970: 6b 65 79 29 20 7d 20 7b 0a 09 20 20 20 20 73 65 key) } {.. se
f980: 74 20 75 73 65 72 76 61 72 28 24 6b 65 79 29 20 t uservar($key)
f990: 24 6e 65 77 76 61 6c 75 65 0a 09 7d 0a 20 20 20 $newvalue..}.
f9a0: 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 67 69 }. method gi
f9b0: 76 65 5f 75 73 65 72 76 61 72 5f 76 61 6c 75 65 ve_uservar_value
f9c0: 20 7b 20 61 72 67 73 20 7d 20 7b 0a 09 73 65 74 { args } {..set
f9d0: 20 6b 65 79 20 5b 6c 69 6e 64 65 78 20 24 61 72 key [lindex $ar
f9e0: 67 73 20 30 5d 0a 09 73 77 69 74 63 68 20 2d 2d gs 0]..switch --
f9f0: 20 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d [llength $args]
fa00: 20 7b 0a 09 20 20 20 20 31 20 7b 0a 09 09 72 65 {.. 1 {...re
fa10: 74 75 72 6e 20 24 75 73 65 72 76 61 72 28 24 6b turn $uservar($k
fa20: 65 79 29 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 ey).. }..
fa30: 32 20 7b 0a 09 09 69 66 20 7b 20 5b 69 6e 66 6f 2 {...if { [info
fa40: 20 65 78 69 73 74 73 20 75 73 65 72 76 61 72 28 exists uservar(
fa50: 24 6b 65 79 29 5d 20 7d 20 7b 0a 09 09 20 20 20 $key)] } {...
fa60: 20 72 65 74 75 72 6e 20 24 75 73 65 72 76 61 72 return $uservar
fa70: 28 24 6b 65 79 29 0a 09 09 7d 20 65 6c 73 65 20 ($key)...} else
fa80: 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b {... return [
fa90: 6c 69 6e 64 65 78 20 24 61 72 67 73 20 31 5d 0a lindex $args 1].
faa0: 09 09 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 ..}.. }..
fab0: 64 65 66 61 75 6c 74 20 7b 0a 09 09 65 72 72 6f default {...erro
fac0: 72 20 22 65 72 72 6f 72 20 69 6e 20 67 69 76 65 r "error in give
fad0: 5f 75 73 65 72 76 61 72 5f 76 61 6c 75 65 22 0a _uservar_value".
fae0: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
faf0: 20 20 20 20 6d 65 74 68 6f 64 20 75 6e 73 65 74 method unset
fb00: 5f 75 73 65 72 76 61 72 20 7b 20 6b 65 79 20 7d _uservar { key }
fb10: 20 7b 0a 09 75 6e 73 65 74 20 2d 6e 6f 63 6f 6d {..unset -nocom
fb20: 70 6c 61 69 6e 20 75 73 65 72 76 61 72 28 24 6b plain uservar($k
fb30: 65 79 29 0a 20 20 20 20 7d 0a 20 20 20 20 74 79 ey). }. ty
fb40: 70 65 6d 65 74 68 6f 64 20 65 78 69 73 74 73 5f pemethod exists_
fb50: 74 79 70 65 75 73 65 72 76 61 72 20 7b 20 6b 65 typeuservar { ke
fb60: 79 20 7d 20 7b 0a 09 72 65 74 75 72 6e 20 5b 69 y } {..return [i
fb70: 6e 66 6f 20 65 78 69 73 74 73 20 74 79 70 65 75 nfo exists typeu
fb80: 73 65 72 76 61 72 28 24 6b 65 79 29 5d 0a 20 20 servar($key)].
fb90: 20 20 7d 0a 20 20 20 20 74 79 70 65 6d 65 74 68 }. typemeth
fba0: 6f 64 20 73 65 74 5f 74 79 70 65 75 73 65 72 76 od set_typeuserv
fbb0: 61 72 5f 76 61 6c 75 65 20 7b 20 6b 65 79 20 6e ar_value { key n
fbc0: 65 77 76 61 6c 75 65 20 7d 20 7b 0a 09 73 65 74 ewvalue } {..set
fbd0: 20 74 79 70 65 75 73 65 72 76 61 72 28 24 6b 65 typeuservar($ke
fbe0: 79 29 20 24 6e 65 77 76 61 6c 75 65 0a 20 20 20 y) $newvalue.
fbf0: 20 7d 0a 20 20 20 20 74 79 70 65 6d 65 74 68 6f }. typemetho
fc00: 64 20 67 69 76 65 5f 74 79 70 65 75 73 65 72 76 d give_typeuserv
fc10: 61 72 5f 76 61 6c 75 65 20 7b 20 61 72 67 73 20 ar_value { args
fc20: 7d 20 7b 0a 09 73 65 74 20 6b 65 79 20 5b 6c 69 } {..set key [li
fc30: 6e 64 65 78 20 24 61 72 67 73 20 30 5d 0a 09 73 ndex $args 0]..s
fc40: 77 69 74 63 68 20 2d 2d 20 5b 6c 6c 65 6e 67 74 witch -- [llengt
fc50: 68 20 24 61 72 67 73 5d 20 7b 0a 09 20 20 20 20 h $args] {..
fc60: 31 20 7b 0a 09 09 72 65 74 75 72 6e 20 24 74 79 1 {...return $ty
fc70: 70 65 75 73 65 72 76 61 72 28 24 6b 65 79 29 0a peuservar($key).
fc80: 09 20 20 20 20 7d 0a 09 20 20 20 20 32 20 7b 0a . }.. 2 {.
fc90: 09 09 69 66 20 7b 20 5b 69 6e 66 6f 20 65 78 69 ..if { [info exi
fca0: 73 74 73 20 74 79 70 65 75 73 65 72 76 61 72 28 sts typeuservar(
fcb0: 24 6b 65 79 29 5d 20 7d 20 7b 0a 09 09 20 20 20 $key)] } {...
fcc0: 20 72 65 74 75 72 6e 20 24 74 79 70 65 75 73 65 return $typeuse
fcd0: 72 76 61 72 28 24 6b 65 79 29 0a 09 09 7d 20 65 rvar($key)...} e
fce0: 6c 73 65 20 7b 0a 09 09 20 20 20 20 72 65 74 75 lse {... retu
fcf0: 72 6e 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 rn [lindex $args
fd00: 20 31 5d 0a 09 09 7d 0a 09 20 20 20 20 7d 0a 09 1]...}.. }..
fd10: 20 20 20 20 64 65 66 61 75 6c 74 20 7b 0a 09 09 default {...
fd20: 65 72 72 6f 72 20 22 65 72 72 6f 72 20 69 6e 20 error "error in
fd30: 67 69 76 65 5f 74 79 70 65 75 73 65 72 76 61 72 give_typeuservar
fd40: 5f 76 61 6c 75 65 22 0a 09 20 20 20 20 7d 0a 09 _value".. }..
fd50: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 74 79 70 65 }. }. type
fd60: 6d 65 74 68 6f 64 20 75 6e 73 65 74 5f 74 79 70 method unset_typ
fd70: 65 75 73 65 72 76 61 72 20 7b 20 6b 65 79 7d 20 euservar { key}
fd80: 7b 0a 09 75 6e 73 65 74 20 74 79 70 65 75 73 65 {..unset typeuse
fd90: 72 76 61 72 28 24 6b 65 79 29 0a 20 20 20 20 7d rvar($key). }
fda0: 0a 20 20 20 20 74 79 70 65 6d 65 74 68 6f 64 20 . typemethod
fdb0: 63 6c 65 61 72 5f 64 6f 5f 6e 6f 74 5f 61 73 6b clear_do_not_ask
fdc0: 5f 61 67 61 69 6e 20 7b 20 6d 65 73 73 61 67 65 _again { message
fdd0: 20 7d 20 7b 0a 09 69 66 20 7b 20 21 5b 69 6e 66 } {..if { ![inf
fde0: 6f 20 65 78 69 73 74 73 20 74 79 70 65 75 73 65 o exists typeuse
fdf0: 72 76 61 72 28 64 6f 5f 6e 6f 74 5f 61 73 6b 5f rvar(do_not_ask_
fe00: 61 67 61 69 6e 29 5d 20 7d 20 7b 20 72 65 74 75 again)] } { retu
fe10: 72 6e 20 7d 0a 09 73 65 74 20 64 20 24 74 79 70 rn }..set d $typ
fe20: 65 75 73 65 72 76 61 72 28 64 6f 5f 6e 6f 74 5f euservar(do_not_
fe30: 61 73 6b 5f 61 67 61 69 6e 29 0a 09 64 69 63 74 ask_again)..dict
fe40: 20 75 6e 73 65 74 20 64 20 24 6d 65 73 73 61 67 unset d $messag
fe50: 65 0a 09 73 65 74 20 74 79 70 65 75 73 65 72 76 e..set typeuserv
fe60: 61 72 28 64 6f 5f 6e 6f 74 5f 61 73 6b 5f 61 67 ar(do_not_ask_ag
fe70: 61 69 6e 29 20 24 64 0a 20 20 20 20 7d 0a 20 20 ain) $d. }.
fe80: 20 20 6d 65 74 68 6f 64 20 61 64 64 5f 74 72 61 method add_tra
fe90: 63 65 5f 74 6f 5f 75 73 65 72 76 61 72 20 7b 20 ce_to_uservar {
fea0: 6b 65 79 20 63 6d 64 20 7d 20 7b 0a 09 74 72 61 key cmd } {..tra
feb0: 63 65 20 61 64 64 20 76 61 72 69 61 62 6c 65 20 ce add variable
fec0: 5b 76 61 72 6e 61 6d 65 20 75 73 65 72 76 61 72 [varname uservar
fed0: 28 24 6b 65 79 29 5d 20 77 72 69 74 65 20 22 24 ($key)] write "$
fee0: 63 6d 64 3b 23 22 0a 09 6c 61 70 70 65 6e 64 20 cmd;#"..lappend
fef0: 74 72 61 63 65 73 20 5b 6c 69 73 74 20 5b 76 61 traces [list [va
ff00: 72 6e 61 6d 65 20 75 73 65 72 76 61 72 28 24 6b rname uservar($k
ff10: 65 79 29 5d 20 77 72 69 74 65 20 22 24 63 6d 64 ey)] write "$cmd
ff20: 3b 23 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 6d ;#"]. }. m
ff30: 65 74 68 6f 64 20 61 64 64 5f 74 72 61 63 65 4e ethod add_traceN
ff40: 5f 74 6f 5f 75 73 65 72 76 61 72 20 7b 20 6b 65 _to_uservar { ke
ff50: 79 20 63 6d 64 20 7d 20 7b 0a 09 61 70 70 65 6e y cmd } {..appen
ff60: 64 20 63 6d 64 20 22 20 5c 5b 5b 6c 69 73 74 20 d cmd " \[[list
ff70: 24 73 65 6c 66 20 67 69 76 65 5f 75 73 65 72 76 $self give_userv
ff80: 61 72 5f 76 61 6c 75 65 20 24 6b 65 79 5d 5c 5d ar_value $key]\]
ff90: 22 0a 09 74 72 61 63 65 20 61 64 64 20 76 61 72 "..trace add var
ffa0: 69 61 62 6c 65 20 5b 76 61 72 6e 61 6d 65 20 75 iable [varname u
ffb0: 73 65 72 76 61 72 28 24 6b 65 79 29 5d 20 77 72 servar($key)] wr
ffc0: 69 74 65 20 22 24 63 6d 64 3b 23 22 0a 09 6c 61 ite "$cmd;#"..la
ffd0: 70 70 65 6e 64 20 74 72 61 63 65 73 20 5b 6c 69 ppend traces [li
ffe0: 73 74 20 5b 76 61 72 6e 61 6d 65 20 75 73 65 72 st [varname user
fff0: 76 61 72 28 24 6b 65 79 29 5d 20 77 72 69 74 65 var($key)] write
10000 20 22 24 63 6d 64 3b 23 22 5d 0a 20 20 20 20 7d "$cmd;#"]. }
10010 0a 20 20 20 20 6d 65 74 68 6f 64 20 65 76 61 6c . method eval
10020 5f 75 73 65 72 76 61 72 5f 74 72 61 63 65 73 20 _uservar_traces
10030 7b 20 6b 65 79 20 7d 20 7b 0a 09 73 65 74 20 75 { key } {..set u
10040 73 65 72 76 61 72 28 24 6b 65 79 29 20 24 75 73 servar($key) $us
10050 65 72 76 61 72 28 24 6b 65 79 29 0a 20 20 20 20 ervar($key).
10060 7d 0a 20 20 20 20 23 20 64 69 63 74 20 63 6f 6e }. # dict con
10070 74 61 69 6e 73 20 76 61 6c 75 65 73 20 61 6e 64 tains values and
10080 20 61 63 74 69 76 65 20 77 69 64 67 65 74 73 20 active widgets
10090 66 6f 72 20 74 68 65 73 65 20 76 61 6c 75 65 73 for these values
100a0 0a 20 20 20 20 23 20 65 78 61 6d 70 6c 65 3a 20 . # example:
100b0 69 66 20 64 69 63 74 20 63 6f 6e 74 61 69 6e 73 if dict contains
100c0 3a 0a 20 20 20 20 23 20 20 20 20 76 61 6c 75 65 :. # value
100d0 31 20 22 77 31 20 77 32 22 20 76 61 6c 75 65 32 1 "w1 w2" value2
100e0 20 22 77 33 20 77 34 22 0a 20 20 20 20 23 20 77 "w3 w4". # w
100f0 68 65 6e 20 76 61 6c 75 65 20 6f 66 20 6b 65 79 hen value of key
10100 20 69 73 20 63 68 61 6e 67 65 64 20 74 6f 20 27 is changed to '
10110 76 61 6c 75 65 31 27 2c 20 77 69 64 67 65 74 73 value1', widgets
10120 20 77 31 20 77 32 20 77 69 6c 6c 20 62 65 20 65 w1 w2 will be e
10130 6e 61 62 6c 65 64 0a 20 20 20 20 23 20 61 6e 64 nabled. # and
10140 20 77 69 64 67 65 74 73 20 77 33 20 77 34 20 77 widgets w3 w4 w
10150 69 6c 6c 20 62 65 20 64 69 73 61 62 6c 65 64 0a ill be disabled.
10160 20 20 20 20 23 20 69 66 20 77 69 64 67 65 74 20 # if widget
10170 69 73 20 61 20 6e 75 6d 62 65 72 2c 20 69 74 20 is a number, it
10180 72 65 66 65 72 73 20 74 6f 20 61 20 62 75 74 74 refers to a butt
10190 6f 6e 0a 20 20 20 20 23 20 69 66 20 74 68 65 72 on. # if ther
101a0 65 20 69 73 20 61 20 6e 65 67 61 74 69 76 65 20 e is a negative
101b0 73 69 67 6e 20 69 6e 20 66 72 6f 6e 74 20 6f 66 sign in front of
101c0 20 74 68 65 20 77 69 64 67 65 74 20 6e 61 6d 65 the widget name
101d0 2c 20 69 74 20 6d 61 6b 65 73 20 74 68 65 20 6f , it makes the o
101e0 70 70 6f 73 69 74 65 0a 20 20 20 20 6d 65 74 68 pposite. meth
101f0 6f 64 20 65 6e 61 62 6c 65 5f 64 69 73 61 62 6c od enable_disabl
10200 65 5f 6f 6e 5f 6b 65 79 20 7b 20 61 72 67 73 20 e_on_key { args
10210 7d 20 7b 0a 09 73 65 74 20 6f 70 74 69 6f 6e 61 } {..set optiona
10220 6c 20 7b 0a 09 20 20 20 20 7b 20 2d 63 6c 65 61 l {.. { -clea
10230 72 20 22 22 20 30 20 7d 0a 09 7d 0a 09 73 65 74 r "" 0 }..}..set
10240 20 63 6f 6d 70 75 6c 73 6f 72 79 20 22 6b 65 79 compulsory "key
10250 20 64 69 63 74 22 0a 09 70 61 72 73 65 5f 61 72 dict"..parse_ar
10260 67 73 20 24 6f 70 74 69 6f 6e 61 6c 20 24 63 6f gs $optional $co
10270 6d 70 75 6c 73 6f 72 79 20 24 61 72 67 73 0a 0a mpulsory $args..
10280 09 69 66 20 7b 20 24 63 6c 65 61 72 20 7d 20 7b .if { $clear } {
10290 0a 09 20 20 20 20 24 73 65 6c 66 20 72 65 6d 6f .. $self remo
102a0 76 65 5f 74 72 61 63 65 73 5f 74 6f 5f 75 73 65 ve_traces_to_use
102b0 72 76 61 72 20 24 6b 65 79 20 5b 6d 79 6d 65 74 rvar $key [mymet
102c0 68 6f 64 20 5f 65 6e 61 62 6c 65 5f 64 69 73 61 hod _enable_disa
102d0 62 6c 65 5f 6f 6e 5f 6b 65 79 5f 68 65 6c 70 65 ble_on_key_helpe
102e0 72 5d 2a 0a 09 7d 0a 09 24 73 65 6c 66 20 61 64 r]*..}..$self ad
102f0 64 5f 74 72 61 63 65 5f 74 6f 5f 75 73 65 72 76 d_trace_to_userv
10300 61 72 20 24 6b 65 79 20 5b 6d 79 6d 65 74 68 6f ar $key [mymetho
10310 64 20 5f 65 6e 61 62 6c 65 5f 64 69 73 61 62 6c d _enable_disabl
10320 65 5f 6f 6e 5f 6b 65 79 5f 68 65 6c 70 65 72 20 e_on_key_helper
10330 5c 0a 09 09 24 6b 65 79 20 24 64 69 63 74 5d 0a \...$key $dict].
10340 09 63 61 74 63 68 20 7b 20 24 73 65 6c 66 20 5f .catch { $self _
10350 65 6e 61 62 6c 65 5f 64 69 73 61 62 6c 65 5f 6f enable_disable_o
10360 6e 5f 6b 65 79 5f 68 65 6c 70 65 72 20 24 6b 65 n_key_helper $ke
10370 79 20 24 64 69 63 74 20 7d 0a 20 20 20 20 7d 0a y $dict }. }.
10380 20 20 20 20 6d 65 74 68 6f 64 20 5f 65 6e 61 62 method _enab
10390 6c 65 5f 64 69 73 61 62 6c 65 5f 6f 6e 5f 6b 65 le_disable_on_ke
103a0 79 5f 68 65 6c 70 65 72 20 7b 20 6b 65 79 20 64 y_helper { key d
103b0 69 63 74 20 61 72 67 73 20 7d 20 7b 0a 09 64 69 ict args } {..di
103c0 63 74 20 66 6f 72 20 22 6e 20 76 22 20 24 64 69 ct for "n v" $di
103d0 63 74 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 24 ct {.. if { $
103e0 6e 20 6e 65 20 24 75 73 65 72 76 61 72 28 24 6b n ne $uservar($k
103f0 65 79 29 20 7d 20 7b 0a 09 09 66 6f 72 65 61 63 ey) } {...foreac
10400 68 20 77 20 24 76 20 7b 0a 09 09 20 20 20 20 69 h w $v {... i
10410 66 20 7b 20 5b 73 74 72 69 6e 67 20 69 73 20 69 f { [string is i
10420 6e 74 65 67 65 72 20 24 77 5d 20 7d 20 7b 0a 09 nteger $w] } {..
10430 09 20 20 20 20 20 20 20 20 73 77 69 74 63 68 20 . switch
10440 24 77 20 7b 0a 09 09 20 20 20 20 20 20 20 20 20 $w {...
10450 20 20 20 31 20 7b 20 24 73 65 6c 66 20 64 69 73 1 { $self dis
10460 61 62 6c 65 6f 6b 20 7d 0a 09 09 20 20 20 20 20 ableok }...
10470 20 20 20 20 20 20 20 30 20 7b 20 24 73 65 6c 66 0 { $self
10480 20 64 69 73 61 62 6c 65 63 61 6e 63 65 6c 20 7d disablecancel }
10490 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 20 64 ... d
104a0 65 66 61 75 6c 74 20 7b 20 24 73 65 6c 66 20 64 efault { $self d
104b0 69 73 61 62 6c 65 62 75 74 74 6f 6e 20 24 77 20 isablebutton $w
104c0 7d 0a 09 09 20 20 20 20 20 20 20 20 7d 0a 09 09 }... }...
104d0 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 20 } else {...
104e0 20 20 20 20 20 20 20 73 65 74 20 69 5f 61 63 74 set i_act
104f0 69 6f 6e 20 64 69 73 61 62 6c 65 0a 09 09 20 20 ion disable...
10500 20 20 20 20 20 20 69 66 20 7b 20 5b 72 65 67 65 if { [rege
10510 78 70 20 7b 5e 28 5b 2d 2b 5d 29 28 2e 2a 29 7d xp {^([-+])(.*)}
10520 20 24 77 20 7b 7d 20 73 69 67 6e 20 77 5d 20 7d $w {} sign w] }
10530 20 7b 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 {...
10540 20 69 66 20 7b 20 24 73 69 67 6e 20 65 71 20 22 if { $sign eq "
10550 2d 22 20 7d 20 7b 0a 09 09 20 20 20 20 20 20 20 -" } {...
10560 20 20 20 20 20 20 20 20 20 73 65 74 20 69 5f 61 set i_a
10570 63 74 69 6f 6e 20 65 6e 61 62 6c 65 0a 09 09 20 ction enable...
10580 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 } els
10590 65 20 7b 0a 09 09 20 20 20 20 20 20 20 20 20 20 e {...
105a0 20 20 20 20 20 20 63 6f 6e 74 69 6e 75 65 0a 09 continue..
105b0 09 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 . }..
105c0 09 20 20 20 20 20 20 20 20 7d 0a 09 09 20 20 20 . }...
105d0 20 20 20 20 20 24 73 65 6c 66 20 5f 65 6e 61 62 $self _enab
105e0 6c 65 5f 64 69 73 61 62 6c 65 5f 77 69 64 67 65 le_disable_widge
105f0 74 20 24 77 20 24 69 5f 61 63 74 69 6f 6e 0a 09 t $w $i_action..
10600 09 20 20 20 20 7d 0a 09 09 7d 0a 09 20 20 20 20 . }...}..
10610 7d 0a 09 7d 0a 09 73 65 74 20 6e 20 24 75 73 65 }..}..set n $use
10620 72 76 61 72 28 24 6b 65 79 29 0a 09 69 66 20 7b rvar($key)..if {
10630 20 5b 64 69 63 74 20 65 78 69 73 74 73 20 24 64 [dict exists $d
10640 69 63 74 20 24 6e 5d 20 7d 20 7b 0a 09 20 20 20 ict $n] } {..
10650 20 73 65 74 20 76 20 5b 64 69 63 74 20 67 65 74 set v [dict get
10660 20 24 64 69 63 74 20 24 6e 5d 0a 09 7d 20 65 6c $dict $n]..} el
10670 73 65 69 66 20 7b 20 5b 64 69 63 74 20 65 78 69 seif { [dict exi
10680 73 74 73 20 24 64 69 63 74 20 22 22 5d 20 7d 20 sts $dict ""] }
10690 7b 0a 09 20 20 20 20 73 65 74 20 76 20 5b 64 69 {.. set v [di
106a0 63 74 20 67 65 74 20 24 64 69 63 74 20 22 22 5d ct get $dict ""]
106b0 0a 09 7d 20 65 6c 73 65 20 7b 20 73 65 74 20 76 ..} else { set v
106c0 20 22 22 20 7d 0a 09 0a 09 66 6f 72 65 61 63 68 "" }....foreach
106d0 20 77 20 24 76 20 7b 0a 09 20 20 20 20 69 66 20 w $v {.. if
106e0 7b 20 5b 73 74 72 69 6e 67 20 69 73 20 69 6e 74 { [string is int
106f0 65 67 65 72 20 24 77 5d 20 7d 20 7b 0a 09 09 73 eger $w] } {...s
10700 77 69 74 63 68 20 24 77 20 7b 0a 09 09 20 20 20 witch $w {...
10710 20 31 20 7b 20 24 73 65 6c 66 20 65 6e 61 62 6c 1 { $self enabl
10720 65 6f 6b 20 7d 0a 09 09 20 20 20 20 30 20 7b 20 eok }... 0 {
10730 24 73 65 6c 66 20 65 6e 61 62 6c 65 63 61 6e 63 $self enablecanc
10740 65 6c 20 7d 0a 09 09 20 20 20 20 64 65 66 61 75 el }... defau
10750 6c 74 20 7b 20 24 73 65 6c 66 20 65 6e 61 62 6c lt { $self enabl
10760 65 62 75 74 74 6f 6e 20 24 77 20 7d 0a 09 09 7d ebutton $w }...}
10770 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
10780 09 73 65 74 20 69 5f 61 63 74 69 6f 6e 20 65 6e .set i_action en
10790 61 62 6c 65 0a 09 09 69 66 20 7b 20 5b 72 65 67 able...if { [reg
107a0 65 78 70 20 7b 5e 28 5b 2d 2b 5d 29 28 2e 2a 29 exp {^([-+])(.*)
107b0 7d 20 24 77 20 7b 7d 20 73 69 67 6e 20 77 5d 20 } $w {} sign w]
107c0 7d 20 7b 0a 09 09 20 20 20 20 69 66 20 7b 20 24 } {... if { $
107d0 73 69 67 6e 20 65 71 20 22 2d 22 20 7d 20 7b 20 sign eq "-" } {
107e0 73 65 74 20 69 5f 61 63 74 69 6f 6e 20 64 69 73 set i_action dis
107f0 61 62 6c 65 20 7d 0a 09 09 7d 0a 09 09 24 73 65 able }...}...$se
10800 6c 66 20 5f 65 6e 61 62 6c 65 5f 64 69 73 61 62 lf _enable_disab
10810 6c 65 5f 77 69 64 67 65 74 20 24 77 20 24 69 5f le_widget $w $i_
10820 61 63 74 69 6f 6e 0a 09 20 20 20 20 7d 0a 09 7d action.. }..}
10830 0a 20 20 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f . }. metho
10840 64 20 5f 65 6e 61 62 6c 65 5f 64 69 73 61 62 6c d _enable_disabl
10850 65 5f 77 69 64 67 65 74 20 7b 20 77 20 65 6e 61 e_widget { w ena
10860 62 6c 65 5f 64 69 73 61 62 6c 65 20 7d 20 7b 0a ble_disable } {.
10870 09 73 77 69 74 63 68 20 5b 77 69 6e 66 6f 20 63 .switch [winfo c
10880 6c 61 73 73 20 24 77 5d 20 7b 0a 09 20 20 20 20 lass $w] {..
10890 43 61 6e 76 61 73 20 7b 0a 09 09 73 77 69 74 63 Canvas {...switc
108a0 68 20 24 65 6e 61 62 6c 65 5f 64 69 73 61 62 6c h $enable_disabl
108b0 65 20 7b 0a 09 09 20 20 20 20 65 6e 61 62 6c 65 e {... enable
108c0 20 7b 20 24 77 20 69 74 65 6d 63 6f 6e 66 69 67 { $w itemconfig
108d0 75 72 65 20 61 6c 6c 20 2d 66 69 6c 6c 20 62 6c ure all -fill bl
108e0 61 63 6b 20 7d 0a 09 09 20 20 20 20 64 69 73 61 ack }... disa
108f0 62 6c 65 20 7b 20 24 77 20 69 74 65 6d 63 6f 6e ble { $w itemcon
10900 66 69 67 75 72 65 20 61 6c 6c 20 2d 66 69 6c 6c figure all -fill
10910 20 67 72 65 79 20 7d 0a 09 09 7d 0a 09 20 20 20 grey }...}..
10920 20 7d 0a 09 20 20 20 20 64 65 66 61 75 6c 74 20 }.. default
10930 7b 0a 09 09 73 77 69 74 63 68 20 24 65 6e 61 62 {...switch $enab
10940 6c 65 5f 64 69 73 61 62 6c 65 20 7b 0a 09 09 20 le_disable {...
10950 20 20 20 65 6e 61 62 6c 65 20 7b 0a 09 09 20 20 enable {...
10960 20 20 20 20 20 20 73 65 74 20 65 72 72 20 5b 63 set err [c
10970 61 74 63 68 20 7b 20 24 77 20 73 74 61 74 65 20 atch { $w state
10980 21 64 69 73 61 62 6c 65 64 20 7d 5d 0a 09 09 20 !disabled }]...
10990 20 20 20 20 20 20 20 69 66 20 7b 20 24 65 72 72 if { $err
109a0 20 7d 20 7b 20 63 61 74 63 68 20 7b 20 24 77 20 } { catch { $w
109b0 63 6f 6e 66 69 67 75 72 65 20 2d 73 74 61 74 65 configure -state
109c0 20 6e 6f 72 6d 61 6c 20 7d 20 7d 0a 09 09 20 20 normal } }...
109d0 20 20 7d 0a 09 09 20 20 20 20 64 69 73 61 62 6c }... disabl
109e0 65 20 7b 0a 09 09 20 20 20 20 20 20 20 20 73 65 e {... se
109f0 74 20 65 72 72 20 5b 63 61 74 63 68 20 7b 20 24 t err [catch { $
10a00 77 20 73 74 61 74 65 20 64 69 73 61 62 6c 65 64 w state disabled
10a10 20 7d 5d 0a 09 09 20 20 20 20 20 20 20 20 69 66 }]... if
10a20 20 7b 20 24 65 72 72 20 7d 20 7b 20 63 61 74 63 { $err } { catc
10a30 68 20 7b 20 24 77 20 63 6f 6e 66 69 67 75 72 65 h { $w configure
10a40 20 2d 73 74 61 74 65 20 64 69 73 61 62 6c 65 64 -state disabled
10a50 20 7d 20 7d 0a 09 09 20 20 20 20 7d 0a 09 09 7d } }... }...}
10a60 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 66 6f 72 65 .. }..}..fore
10a70 61 63 68 20 69 20 5b 77 69 6e 66 6f 20 63 68 69 ach i [winfo chi
10a80 6c 64 72 65 6e 20 24 77 5d 20 7b 0a 09 20 20 20 ldren $w] {..
10a90 20 24 73 65 6c 66 20 5f 65 6e 61 62 6c 65 5f 64 $self _enable_d
10aa0 69 73 61 62 6c 65 5f 77 69 64 67 65 74 20 24 69 isable_widget $i
10ab0 20 24 65 6e 61 62 6c 65 5f 64 69 73 61 62 6c 65 $enable_disable
10ac0 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 23 20 ..}. }. #
10ad0 64 69 63 74 20 63 6f 6e 74 61 69 6e 73 20 76 61 dict contains va
10ae0 6c 75 65 73 20 61 6e 64 20 22 6b 65 79 32 20 6e lues and "key2 n
10af0 65 77 76 61 6c 75 65 22 20 70 61 69 72 73 20 66 ewvalue" pairs f
10b00 6f 72 20 74 68 65 73 65 20 76 61 6c 75 65 73 0a or these values.
10b10 20 20 20 20 23 20 65 78 61 6d 70 6c 65 3a 20 69 # example: i
10b20 66 20 64 69 63 74 20 63 6f 6e 74 61 69 6e 73 3a f dict contains:
10b30 0a 20 20 20 20 23 20 20 20 20 76 61 6c 75 65 31 . # value1
10b40 20 22 6b 65 79 32 20 31 22 20 76 61 6c 75 65 32 "key2 1" value2
10b50 20 22 6b 65 79 32 20 30 20 6b 65 79 33 20 76 22 "key2 0 key3 v"
10b60 20 64 65 66 61 75 6c 74 20 22 6b 65 79 34 20 31 default "key4 1
10b70 22 0a 20 20 20 20 23 20 77 68 65 6e 20 76 61 6c ". # when val
10b80 75 65 20 6f 66 20 6b 65 79 20 69 73 20 63 68 61 ue of key is cha
10b90 6e 67 65 64 20 74 6f 20 27 76 61 6c 75 65 31 27 nged to 'value1'
10ba0 2c 20 74 68 65 20 76 61 6c 75 65 20 6f 66 20 6b , the value of k
10bb0 65 79 20 22 6b 65 79 32 22 20 69 73 0a 20 20 20 ey "key2" is.
10bc0 20 23 20 63 68 61 6e 67 65 64 20 74 6f 20 22 31 # changed to "1
10bd0 22 2e 20 77 68 65 6e 20 76 61 6c 75 65 20 6f 66 ". when value of
10be0 20 6b 65 79 20 69 73 20 63 68 61 6e 67 65 64 20 key is changed
10bf0 74 6f 20 27 76 61 6c 75 65 32 27 2c 20 74 68 65 to 'value2', the
10c00 20 76 61 6c 75 65 0a 20 20 20 20 23 20 6f 66 20 value. # of
10c10 6b 65 79 20 22 6b 65 79 32 22 20 69 73 20 63 68 key "key2" is ch
10c20 61 6e 67 65 64 20 74 30 20 22 30 22 20 61 6e 64 anged t0 "0" and
10c30 20 74 68 65 20 76 61 6c 75 65 20 6f 66 20 22 6b the value of "k
10c40 65 79 33 22 20 69 73 20 63 68 61 6e 67 65 64 20 ey3" is changed
10c50 74 6f 20 22 76 22 0a 20 20 20 20 23 20 66 6f 72 to "v". # for
10c60 20 61 6e 79 20 6f 74 68 65 72 20 76 61 6c 75 65 any other value
10c70 2c 20 6b 65 79 34 20 69 73 20 63 68 61 6e 67 65 , key4 is change
10c80 64 20 74 6f 20 31 0a 20 20 20 20 23 20 74 68 65 d to 1. # the
10c90 72 65 20 63 61 6e 20 62 65 20 61 20 22 64 65 66 re can be a "def
10ca0 61 75 6c 74 22 20 76 61 6c 75 65 20 74 68 61 74 ault" value that
10cb0 20 69 73 20 61 70 70 6c 69 65 64 20 69 66 20 6e is applied if n
10cc0 6f 6e 65 20 6f 66 20 74 68 65 20 6f 74 68 65 72 one of the other
10cd0 20 76 61 6c 75 65 73 20 61 70 70 6c 79 0a 20 20 values apply.
10ce0 20 20 23 20 69 66 20 61 20 76 61 6c 75 65 20 66 # if a value f
10cf0 6f 72 20 61 20 76 61 72 69 61 62 6c 65 20 69 73 or a variable is
10d00 20 6e 6f 74 20 67 69 76 65 6e 2c 20 69 74 20 69 not given, it i
10d10 73 20 6a 75 73 74 20 75 70 64 61 74 65 64 20 74 s just updated t
10d20 6f 20 72 61 69 73 65 20 74 72 61 63 65 73 0a 20 o raise traces.
10d30 20 20 20 6d 65 74 68 6f 64 20 63 68 61 6e 67 65 method change
10d40 5f 6b 65 79 5f 6f 6e 5f 6b 65 79 20 7b 20 61 72 _key_on_key { ar
10d50 67 73 20 7d 20 7b 0a 09 73 65 74 20 6f 70 74 69 gs } {..set opti
10d60 6f 6e 61 6c 20 7b 0a 09 20 20 20 20 7b 20 2d 63 onal {.. { -c
10d70 6c 65 61 72 20 22 22 20 30 20 7d 0a 09 20 20 20 lear "" 0 }..
10d80 20 7b 20 2d 69 6e 69 74 69 61 6c 69 7a 65 20 62 { -initialize b
10d90 6f 6f 6c 65 61 6e 20 31 20 7d 0a 09 7d 0a 09 73 oolean 1 }..}..s
10da0 65 74 20 63 6f 6d 70 75 6c 73 6f 72 79 20 22 6b et compulsory "k
10db0 65 79 20 64 69 63 74 22 0a 09 70 61 72 73 65 5f ey dict"..parse_
10dc0 61 72 67 73 20 24 6f 70 74 69 6f 6e 61 6c 20 24 args $optional $
10dd0 63 6f 6d 70 75 6c 73 6f 72 79 20 24 61 72 67 73 compulsory $args
10de0 0a 09 0a 09 69 66 20 7b 20 24 63 6c 65 61 72 20 ....if { $clear
10df0 7d 20 7b 0a 09 20 20 20 20 24 73 65 6c 66 20 72 } {.. $self r
10e00 65 6d 6f 76 65 5f 74 72 61 63 65 73 5f 74 6f 5f emove_traces_to_
10e10 75 73 65 72 76 61 72 20 24 6b 65 79 20 5b 6d 79 uservar $key [my
10e20 6d 65 74 68 6f 64 20 5f 63 68 61 6e 67 65 5f 6b method _change_k
10e30 65 79 5f 6f 6e 5f 6b 65 79 5f 68 65 6c 70 65 72 ey_on_key_helper
10e40 5d 2a 0a 09 7d 0a 09 24 73 65 6c 66 20 61 64 64 ]*..}..$self add
10e50 5f 74 72 61 63 65 5f 74 6f 5f 75 73 65 72 76 61 _trace_to_userva
10e60 72 20 24 6b 65 79 20 5b 6d 79 6d 65 74 68 6f 64 r $key [mymethod
10e70 20 5f 63 68 61 6e 67 65 5f 6b 65 79 5f 6f 6e 5f _change_key_on_
10e80 6b 65 79 5f 68 65 6c 70 65 72 20 5c 0a 09 09 24 key_helper \...$
10e90 6b 65 79 20 24 64 69 63 74 5d 0a 09 69 66 20 7b key $dict]..if {
10ea0 20 24 69 6e 69 74 69 61 6c 69 7a 65 20 7d 20 7b $initialize } {
10eb0 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 24 73 .. catch { $s
10ec0 65 6c 66 20 5f 63 68 61 6e 67 65 5f 6b 65 79 5f elf _change_key_
10ed0 6f 6e 5f 6b 65 79 5f 68 65 6c 70 65 72 20 24 6b on_key_helper $k
10ee0 65 79 20 24 64 69 63 74 20 7d 0a 09 7d 0a 20 20 ey $dict }..}.
10ef0 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 5f }. method _
10f00 63 68 61 6e 67 65 5f 6b 65 79 5f 6f 6e 5f 6b 65 change_key_on_ke
10f10 79 5f 68 65 6c 70 65 72 20 7b 20 6b 65 79 20 64 y_helper { key d
10f20 69 63 74 20 61 72 67 73 20 7d 20 7b 0a 09 73 65 ict args } {..se
10f30 74 20 6e 20 24 75 73 65 72 76 61 72 28 24 6b 65 t n $uservar($ke
10f40 79 29 0a 09 69 66 20 7b 20 5b 64 69 63 74 20 65 y)..if { [dict e
10f50 78 69 73 74 73 20 24 64 69 63 74 20 24 6e 5d 20 xists $dict $n]
10f60 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 76 20 5b } {.. set v [
10f70 64 69 63 74 20 67 65 74 20 24 64 69 63 74 20 24 dict get $dict $
10f80 6e 5d 0a 09 20 20 20 20 69 66 20 7b 20 5b 6c 6c n].. if { [ll
10f90 65 6e 67 74 68 20 24 76 5d 25 32 20 3d 3d 20 31 ength $v]%2 == 1
10fa0 20 7d 20 7b 0a 09 09 6c 61 70 70 65 6e 64 20 76 } {...lappend v
10fb0 20 24 75 73 65 72 76 61 72 28 5b 6c 69 6e 64 65 $uservar([linde
10fc0 78 20 24 76 20 65 6e 64 5d 29 0a 09 20 20 20 20 x $v end])..
10fd0 7d 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 22 }.. foreach "
10fe0 6b 20 76 22 20 24 76 20 7b 0a 09 09 73 65 74 20 k v" $v {...set
10ff0 75 73 65 72 76 61 72 28 24 6b 29 20 24 76 0a 09 uservar($k) $v..
11000 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 }..} elseif
11010 7b 20 5b 64 69 63 74 20 65 78 69 73 74 73 20 24 { [dict exists $
11020 64 69 63 74 20 64 65 66 61 75 6c 74 5d 20 7d 20 dict default] }
11030 7b 0a 09 20 20 20 20 73 65 74 20 76 20 5b 64 69 {.. set v [di
11040 63 74 20 67 65 74 20 24 64 69 63 74 20 64 65 66 ct get $dict def
11050 61 75 6c 74 5d 0a 09 20 20 20 20 69 66 20 7b 20 ault].. if {
11060 5b 6c 6c 65 6e 67 74 68 20 24 76 5d 25 32 20 3d [llength $v]%2 =
11070 3d 20 31 20 7d 20 7b 0a 09 09 6c 61 70 70 65 6e = 1 } {...lappen
11080 64 20 76 20 24 75 73 65 72 76 61 72 28 5b 6c 69 d v $uservar([li
11090 6e 64 65 78 20 24 76 20 65 6e 64 5d 29 0a 09 20 ndex $v end])..
110a0 20 20 20 7d 0a 09 20 20 20 20 66 6f 72 65 61 63 }.. foreac
110b0 68 20 22 6b 20 76 22 20 24 76 20 7b 0a 09 09 73 h "k v" $v {...s
110c0 65 74 20 75 73 65 72 76 61 72 28 24 6b 29 20 24 et uservar($k) $
110d0 76 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 v.. }..}.
110e0 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 68 61 73 }. method has
110f0 5f 74 72 61 63 65 73 5f 74 6f 5f 75 73 65 72 76 _traces_to_userv
11100 61 72 20 7b 20 6b 65 79 20 7b 20 63 6d 64 5f 70 ar { key { cmd_p
11110 61 74 74 65 72 6e 20 22 22 20 7d 20 7d 20 7b 0a attern "" } } {.
11120 09 66 6f 72 65 61 63 68 20 69 20 24 74 72 61 63 .foreach i $trac
11130 65 73 20 7b 0a 09 20 20 20 20 69 66 20 7b 20 5b es {.. if { [
11140 6c 69 6e 64 65 78 20 24 69 20 30 5d 20 65 71 20 lindex $i 0] eq
11150 5b 76 61 72 6e 61 6d 65 20 75 73 65 72 76 61 72 [varname uservar
11160 28 24 6b 65 79 29 5d 20 7d 20 7b 0a 09 09 69 66 ($key)] } {...if
11170 20 7b 20 24 63 6d 64 5f 70 61 74 74 65 72 6e 20 { $cmd_pattern
11180 65 71 20 22 22 20 7c 7c 20 5b 73 74 72 69 6e 67 eq "" || [string
11190 20 6d 61 74 63 68 20 24 63 6d 64 5f 70 61 74 74 match $cmd_patt
111a0 65 72 6e 20 5b 6c 69 6e 64 65 78 20 24 69 20 32 ern [lindex $i 2
111b0 5d 5d 20 7d 20 7b 0a 09 09 20 20 20 20 72 65 74 ]] } {... ret
111c0 75 72 6e 20 31 0a 09 09 7d 0a 09 20 20 20 20 7d urn 1...}.. }
111d0 0a 09 7d 0a 09 72 65 74 75 72 6e 20 30 0a 20 20 ..}..return 0.
111e0 20 20 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 72 }. method r
111f0 65 6d 6f 76 65 5f 74 72 61 63 65 73 5f 74 6f 5f emove_traces_to_
11200 75 73 65 72 76 61 72 20 7b 20 6b 65 79 20 7b 20 uservar { key {
11210 63 6d 64 5f 70 61 74 74 65 72 6e 20 22 22 20 7d cmd_pattern "" }
11220 20 7d 20 7b 0a 09 66 6f 72 65 61 63 68 20 69 20 } {..foreach i
11230 24 74 72 61 63 65 73 20 7b 0a 09 20 20 20 20 69 $traces {.. i
11240 66 20 7b 20 5b 6c 69 6e 64 65 78 20 24 69 20 30 f { [lindex $i 0
11250 5d 20 65 71 20 5b 76 61 72 6e 61 6d 65 20 75 73 ] eq [varname us
11260 65 72 76 61 72 28 24 6b 65 79 29 5d 20 7d 20 7b ervar($key)] } {
11270 0a 09 09 69 66 20 7b 20 24 63 6d 64 5f 70 61 74 ...if { $cmd_pat
11280 74 65 72 6e 20 65 71 20 22 22 20 7c 7c 20 5b 73 tern eq "" || [s
11290 74 72 69 6e 67 20 6d 61 74 63 68 20 24 63 6d 64 tring match $cmd
112a0 5f 70 61 74 74 65 72 6e 20 5b 6c 69 6e 64 65 78 _pattern [lindex
112b0 20 24 69 20 32 5d 5d 20 7d 20 7b 0a 09 09 20 20 $i 2]] } {...
112c0 20 20 74 72 61 63 65 20 72 65 6d 6f 76 65 20 76 trace remove v
112d0 61 72 69 61 62 6c 65 20 7b 2a 7d 24 69 0a 09 09 ariable {*}$i...
112e0 7d 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 }.. }..}.
112f0 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 61 64 64 }. method add
11300 5f 64 65 73 74 72 6f 79 5f 68 61 6e 64 6c 65 72 _destroy_handler
11310 20 7b 20 63 6d 64 20 7d 20 7b 0a 09 6c 61 70 70 { cmd } {..lapp
11320 65 6e 64 20 64 65 73 74 72 6f 79 5f 68 61 6e 64 end destroy_hand
11330 6c 65 72 73 20 24 63 6d 64 0a 20 20 20 20 7d 0a lers $cmd. }.
11340 20 20 20 20 6d 65 74 68 6f 64 20 72 65 6d 6f 76 method remov
11350 65 5f 64 65 73 74 72 6f 79 5f 68 61 6e 64 6c 65 e_destroy_handle
11360 72 20 7b 20 63 6d 64 20 7d 20 7b 0a 09 73 65 74 r { cmd } {..set
11370 20 69 70 6f 73 20 5b 6c 73 65 61 72 63 68 20 2d ipos [lsearch -
11380 65 78 61 63 74 20 24 64 65 73 74 72 6f 79 5f 68 exact $destroy_h
11390 61 6e 64 6c 65 72 73 20 24 63 6d 64 5d 0a 09 69 andlers $cmd]..i
113a0 66 20 7b 20 24 69 70 6f 73 20 21 3d 20 2d 31 20 f { $ipos != -1
113b0 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 64 65 73 } {.. set des
113c0 74 72 6f 79 5f 68 61 6e 64 6c 65 72 73 20 5b 6c troy_handlers [l
113d0 72 65 70 6c 61 63 65 20 24 64 65 73 74 72 6f 79 replace $destroy
113e0 5f 68 61 6e 64 6c 65 72 73 20 24 69 70 6f 73 20 _handlers $ipos
113f0 24 69 70 6f 73 5d 0a 09 7d 0a 20 20 20 20 7d 0a $ipos]..}. }.
11400 7d 0a 0a 0a 23 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d }...#-----------
11410 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
11420 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
11430 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
11440 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
11450 2d 2d 2d 2d 2d 0a 23 20 20 20 64 69 61 6c 6f 67 -----.# dialog
11460 77 69 6e 5f 73 6e 69 74 20 45 58 41 4d 50 4c 45 win_snit EXAMPLE
11470 53 0a 23 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d S.#-------------
11480 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
11490 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
114a0 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
114b0 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
114c0 2d 2d 2d 0a 0a 23 20 20 20 20 20 53 49 4d 50 4c ---..# SIMPL
114d0 45 3a 20 6f 6e 6c 79 20 74 65 78 74 20 61 6e 64 E: only text and
114e0 20 62 75 74 74 6f 6e 73 0a 0a 69 66 20 30 20 7b buttons..if 0 {
114f0 0a 20 20 20 20 64 69 61 6c 6f 67 77 69 6e 5f 73 . dialogwin_s
11500 6e 69 74 20 24 77 69 6e 2e 5f 61 73 6b 20 2d 74 nit $win._ask -t
11510 69 74 6c 65 20 5b 5f 20 22 41 63 74 69 6f 6e 22 itle [_ "Action"
11520 5d 20 2d 6f 6b 6e 61 6d 65 20 5b 5f 20 22 4e 65 ] -okname [_ "Ne
11530 77 20 70 61 73 73 77 6f 72 64 22 5d 20 5c 0a 09 w password"] \..
11540 2d 6d 6f 72 65 62 75 74 74 6f 6e 73 20 5b 6c 69 -morebuttons [li
11550 73 74 20 5b 5f 20 22 55 6e 63 72 79 70 74 22 5d st [_ "Uncrypt"]
11560 5d 20 2d 65 6e 74 72 79 74 65 78 74 20 5b 5f 20 ] -entrytext [_
11570 22 43 68 6f 6f 73 65 20 61 63 74 69 6f 6e 20 74 "Choose action t
11580 6f 20 70 65 72 66 6f 72 6d 22 5d 3a 0a 20 20 20 o perform"]:.
11590 20 73 65 74 20 61 63 74 69 6f 6e 20 5b 24 77 69 set action [$wi
115a0 6e 2e 5f 61 73 6b 20 63 72 65 61 74 65 77 69 6e n._ask createwin
115b0 64 6f 77 5d 0a 20 20 20 20 64 65 73 74 72 6f 79 dow]. destroy
115c0 20 24 77 69 6e 2e 5f 61 73 6b 0a 20 20 20 20 69 $win._ask. i
115d0 66 20 7b 20 24 61 63 74 69 6f 6e 20 3c 3d 20 30 f { $action <= 0
115e0 20 7d 20 7b 20 20 72 65 74 75 72 6e 20 7d 0a 20 } { return }.
115f0 20 20 20 69 66 20 7b 20 24 61 63 74 69 6f 6e 20 if { $action
11600 3d 3d 20 32 20 7d 20 7b 0a 09 24 77 6f 72 64 6e == 2 } {..$wordn
11610 6f 74 65 72 5f 64 62 20 65 6e 74 65 72 70 61 67 oter_db enterpag
11620 65 20 24 6f 70 74 69 6f 6e 73 28 2d 70 61 67 65 e $options(-page
11630 29 20 2d 20 24 64 61 74 61 0a 09 72 65 74 75 72 ) - $data..retur
11640 6e 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 20 20 20 n. }.}..#
11650 20 4d 45 44 49 55 4d 3a 20 74 65 78 74 20 61 6e MEDIUM: text an
11660 64 20 62 75 74 74 6f 6e 73 20 61 6e 64 20 65 6e d buttons and en
11670 74 72 79 0a 0a 69 66 20 30 20 7b 0a 20 20 20 20 try..if 0 {.
11680 64 69 61 6c 6f 67 77 69 6e 5f 73 6e 69 74 20 24 dialogwin_snit $
11690 77 69 6e 2e 5f 61 73 6b 20 2d 74 69 74 6c 65 20 win._ask -title
116a0 5b 5f 20 22 45 6e 74 65 72 20 70 61 73 73 77 6f [_ "Enter passwo
116b0 72 64 22 5d 20 2d 65 6e 74 72 79 74 79 70 65 20 rd"] -entrytype
116c0 70 61 73 73 77 6f 72 64 20 5c 0a 09 2d 65 6e 74 password \..-ent
116d0 72 79 6c 61 62 65 6c 20 5b 5f 20 22 50 61 73 73 rylabel [_ "Pass
116e0 77 6f 72 64 22 5d 3a 20 2d 65 6e 74 72 79 74 65 word"]: -entryte
116f0 78 74 20 5b 5f 20 22 45 6e 74 65 72 20 70 61 73 xt [_ "Enter pas
11700 73 77 6f 72 64 20 74 6f 20 65 6e 63 72 79 70 74 sword to encrypt
11710 22 5d 3a 0a 20 20 20 20 73 65 74 20 61 63 74 69 "]:. set acti
11720 6f 6e 20 5b 24 77 69 6e 2e 5f 61 73 6b 20 63 72 on [$win._ask cr
11730 65 61 74 65 77 69 6e 64 6f 77 5d 0a 20 20 20 20 eatewindow].
11740 77 68 69 6c 65 20 31 20 7b 0a 09 69 66 20 7b 20 while 1 {..if {
11750 24 61 63 74 69 6f 6e 20 3c 3d 20 30 20 7d 20 7b $action <= 0 } {
11760 0a 09 20 20 20 20 64 65 73 74 72 6f 79 20 24 77 .. destroy $w
11770 69 6e 2e 5f 61 73 6b 0a 09 20 20 20 20 72 65 74 in._ask.. ret
11780 75 72 6e 0a 09 7d 0a 09 73 65 74 20 70 61 73 73 urn..}..set pass
11790 20 5b 73 74 72 69 6e 67 20 74 72 69 6d 20 5b 24 [string trim [$
117a0 77 69 6e 2e 5f 61 73 6b 20 67 69 76 65 65 6e 74 win._ask giveent
117b0 72 79 76 61 6c 75 65 5d 5d 0a 09 69 66 20 7b 20 ryvalue]]..if {
117c0 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
117d0 70 61 73 73 5d 20 3c 20 34 20 7d 20 7b 0a 09 20 pass] < 4 } {..
117e0 20 20 20 24 73 65 6c 66 20 77 61 72 6e 77 69 6e $self warnwin
117f0 20 5b 5f 20 22 50 61 73 73 77 6f 72 64 20 6d 75 [_ "Password mu
11800 73 74 20 68 61 76 65 20 61 74 20 6c 65 61 73 74 st have at least
11810 20 34 20 63 68 61 72 61 63 74 65 72 73 22 5d 0a 4 characters"].
11820 09 7d 20 65 6c 73 65 20 7b 20 62 72 65 61 6b 20 .} else { break
11830 7d 0a 09 73 65 74 20 61 63 74 69 6f 6e 20 5b 24 }..set action [$
11840 77 69 6e 2e 5f 61 73 6b 20 77 61 69 74 66 6f 72 win._ask waitfor
11850 77 69 6e 64 6f 77 5d 0a 20 20 20 20 7d 0a 7d 0a window]. }.}.
11860 0a 23 20 20 20 20 20 43 4f 4d 50 4c 45 58 3a 20 .# COMPLEX:
11870 75 73 65 72 20 64 65 66 69 6e 65 64 20 77 69 64 user defined wid
11880 67 65 74 73 0a 0a 69 66 20 30 20 7b 0a 20 20 20 gets..if 0 {.
11890 20 73 65 74 20 77 20 5b 64 69 61 6c 6f 67 77 69 set w [dialogwi
118a0 6e 5f 73 6e 69 74 20 24 77 69 6e 2e 5f 61 73 6b n_snit $win._ask
118b0 20 2d 74 69 74 6c 65 20 5b 5f 20 22 43 68 61 6e -title [_ "Chan
118c0 67 65 20 70 61 67 65 20 74 79 70 65 22 5d 20 2d ge page type"] -
118d0 65 6e 74 72 79 74 65 78 74 20 5c 0a 09 20 20 20 entrytext \..
118e0 20 5b 5f 20 22 43 68 6f 6f 73 65 20 61 20 6e 65 [_ "Choose a ne
118f0 77 20 70 61 67 65 20 74 79 70 65 20 66 6f 72 20 w page type for
11900 70 61 67 65 20 27 25 73 27 22 20 24 70 61 67 65 page '%s'" $page
11910 5d 20 5c 0a 09 20 20 20 20 2d 6d 6f 72 65 62 75 ] \.. -morebu
11920 74 74 6f 6e 73 20 5b 6c 69 73 74 20 5b 5f 20 22 ttons [list [_ "
11930 59 65 73 20 74 6f 20 61 6c 6c 22 5d 20 5b 5f 20 Yes to all"] [_
11940 22 4e 6f 20 74 6f 20 61 6c 6c 22 5d 20 5b 5f 20 "No to all"] [_
11950 4e 6f 5d 5d 5d 0a 23 2d 67 72 61 62 20 30 20 2d No]]].#-grab 0 -
11960 63 61 6c 6c 62 61 63 6b 20 5b 6d 79 6d 65 74 68 callback [mymeth
11970 6f 64 20 70 72 65 66 65 72 65 6e 63 65 73 5f 77 od preferences_w
11980 69 6e 5f 61 70 70 6c 79 5d 20 2d 6f 6b 6e 61 6d in_apply] -oknam
11990 65 20 2d 0a 20 20 20 20 73 65 74 20 66 20 5b 24 e -. set f [$
119a0 77 20 67 69 76 65 66 72 61 6d 65 5d 0a 20 20 20 w giveframe].
119b0 20 69 66 20 7b 20 24 74 79 70 65 20 65 71 20 22 if { $type eq "
119c0 22 20 7d 20 7b 20 73 65 74 20 74 79 70 65 20 4e " } { set type N
119d0 6f 72 6d 61 6c 20 7d 0a 20 20 20 20 6c 61 62 65 ormal }. labe
119e0 6c 20 24 66 2e 6c 31 20 2d 74 65 78 74 20 5b 5f l $f.l1 -text [_
119f0 20 22 43 75 72 72 65 6e 74 20 74 79 70 65 3a 20 "Current type:
11a00 25 73 22 20 24 74 79 70 65 5d 0a 20 20 20 20 6c %s" $type]. l
11a10 61 62 65 6c 20 24 66 2e 6c 32 20 2d 74 65 78 74 abel $f.l2 -text
11a20 20 5b 5f 20 22 4e 65 77 20 74 79 70 65 3a 22 5d [_ "New type:"]
11a30 0a 20 20 20 20 43 6f 6d 62 6f 42 6f 78 20 24 66 . ComboBox $f
11a40 2e 63 62 31 20 2d 74 65 78 74 76 61 72 69 61 62 .cb1 -textvariab
11a50 6c 65 20 5b 24 77 20 67 69 76 65 5f 75 73 65 72 le [$w give_user
11a60 76 61 72 20 6e 65 77 74 79 70 65 20 24 74 79 70 var newtype $typ
11a70 65 5d 20 2d 76 61 6c 75 65 73 20 5c 0a 09 5b 6c e] -values \..[l
11a80 69 73 74 20 4e 6f 72 6d 61 6c 20 48 6f 6d 65 5d ist Normal Home]
11a90 20 2d 65 64 69 74 61 62 6c 65 20 30 0a 20 20 20 -editable 0.
11aa0 20 74 6b 3a 3a 54 61 62 54 6f 57 69 6e 64 6f 77 tk::TabToWindow
11ab0 20 24 66 2e 63 62 31 0a 20 20 20 20 62 69 6e 64 $f.cb1. bind
11ac0 20 24 66 2e 63 62 31 20 3c 52 65 74 75 72 6e 3e $f.cb1 <Return>
11ad0 20 5b 6c 69 73 74 20 24 77 20 69 6e 76 6f 6b 65 [list $w invoke
11ae0 6f 6b 5d 0a 20 20 20 20 67 72 69 64 20 24 66 2e ok]. grid $f.
11af0 6c 31 20 2d 20 2d 73 74 69 63 6b 79 20 77 20 2d l1 - -sticky w -
11b00 70 61 64 79 20 32 0a 20 20 20 20 67 72 69 64 20 pady 2. grid
11b10 24 66 2e 6c 32 20 24 66 2e 63 62 31 20 2d 73 74 $f.l2 $f.cb1 -st
11b20 69 63 6b 79 20 77 20 2d 70 61 64 78 20 32 20 2d icky w -padx 2 -
11b30 70 61 64 79 20 22 32 20 34 22 0a 20 20 20 20 67 pady "2 4". g
11b40 72 69 64 20 63 6f 6e 66 69 67 75 72 65 20 24 66 rid configure $f
11b50 2e 63 62 31 20 2d 73 74 69 63 6b 79 20 65 77 0a .cb1 -sticky ew.
11b60 20 20 20 20 67 72 69 64 20 63 6f 6c 75 6d 6e 63 grid columnc
11b70 6f 6e 66 69 67 75 72 65 20 24 66 20 31 20 2d 77 onfigure $f 1 -w
11b80 65 69 67 68 74 20 31 0a 0a 20 20 20 20 73 65 74 eight 1.. set
11b90 20 61 63 74 69 6f 6e 20 5b 24 77 20 63 72 65 61 action [$w crea
11ba0 74 65 77 69 6e 64 6f 77 5d 0a 20 20 20 20 73 65 tewindow]. se
11bb0 74 20 6e 65 77 74 79 70 65 20 5b 24 77 20 67 69 t newtype [$w gi
11bc0 76 65 5f 75 73 65 72 76 61 72 5f 76 61 6c 75 65 ve_uservar_value
11bd0 20 6e 65 77 74 79 70 65 5d 0a 20 20 20 20 64 65 newtype]. de
11be0 73 74 72 6f 79 20 24 77 0a 20 20 20 20 69 66 20 stroy $w. if
11bf0 7b 20 24 61 63 74 69 6f 6e 20 3c 3d 20 30 20 7d { $action <= 0 }
11c00 20 7b 20 20 72 65 74 75 72 6e 20 7d 0a 20 20 20 { return }.
11c10 20 69 66 20 7b 20 24 6e 65 77 74 79 70 65 20 65 if { $newtype e
11c20 71 20 22 4e 6f 72 6d 61 6c 22 20 7d 20 7b 20 73 q "Normal" } { s
11c30 65 74 20 6e 65 77 74 79 70 65 20 22 22 20 7d 0a et newtype "" }.
11c40 0a 23 20 20 20 20 20 73 77 69 74 63 68 20 2d 2d .# switch --
11c50 20 5b 24 77 20 67 69 76 65 61 63 74 69 6f 6e 5d [$w giveaction]
11c60 20 7b 0a 23 20 20 20 20 20 20 20 20 20 2d 31 20 {.# -1
11c70 2d 20 30 20 7b 20 64 65 73 74 72 6f 79 20 24 77 - 0 { destroy $w
11c80 20 7d 0a 23 20 20 20 20 20 20 20 20 20 31 20 2d }.# 1 -
11c90 20 32 20 7b 0a 23 0a 23 20 20 20 20 20 20 20 20 2 {.#.#
11ca0 20 20 20 20 20 69 66 20 7b 20 5b 24 77 20 67 69 if { [$w gi
11cb0 76 65 61 63 74 69 6f 6e 5d 20 3d 3d 20 31 20 7d veaction] == 1 }
11cc0 20 7b 20 64 65 73 74 72 6f 79 20 24 77 20 7d 0a { destroy $w }.
11cd0 23 20 20 20 20 20 20 20 20 20 7d 0a 23 20 20 20 # }.#
11ce0 20 20 7d 0a 7d 0a 0a 23 20 20 20 20 20 6f 6e 65 }.}..# one
11cf0 20 65 78 65 6d 70 6c 65 20 77 69 74 68 6f 75 74 exemple without
11d00 20 62 75 74 74 6f 6e 73 0a 0a 69 66 20 30 20 7b buttons..if 0 {
11d10 0a 20 20 20 20 77 6d 20 77 69 74 68 64 72 61 77 . wm withdraw
11d20 20 2e 0a 20 20 20 20 73 65 74 20 77 20 2e 61 73 .. set w .as
11d30 6b 0a 20 20 20 20 64 69 61 6c 6f 67 77 69 6e 5f k. dialogwin_
11d40 73 6e 69 74 20 24 77 20 2d 74 69 74 6c 65 20 5b snit $w -title [
11d50 5f 20 22 41 63 74 69 6f 6e 22 5d 20 2d 6f 6b 6e _ "Action"] -okn
11d60 61 6d 65 20 2d 20 2d 63 61 6e 63 65 6c 6e 61 6d ame - -cancelnam
11d70 65 20 2d 20 5c 0a 09 2d 65 6e 74 72 79 74 65 78 e - \..-entrytex
11d80 74 20 5b 5f 20 22 43 68 6f 6f 73 65 20 61 63 74 t [_ "Choose act
11d90 69 6f 6e 20 74 6f 20 70 65 72 66 6f 72 6d 22 5d ion to perform"]
11da0 3a 20 20 2d 65 6e 74 72 79 74 79 70 65 20 65 6e : -entrytype en
11db0 74 72 79 0a 20 20 20 20 73 65 74 20 61 63 74 69 try. set acti
11dc0 6f 6e 20 5b 24 77 20 63 72 65 61 74 65 77 69 6e on [$w createwin
11dd0 64 6f 77 5d 0a 20 20 20 20 70 75 74 73 20 5b 24 dow]. puts [$
11de0 77 20 67 69 76 65 65 6e 74 72 79 76 61 6c 75 65 w giveentryvalue
11df0 5d 0a 20 20 20 20 64 65 73 74 72 6f 79 20 24 77 ]. destroy $w
11e00 0a 20 20 20 20 65 78 69 74 0a 7d 0a 0a 73 6e 69 . exit.}..sni
11e10 74 3a 3a 77 69 64 67 65 74 61 64 61 70 74 6f 72 t::widgetadaptor
11e20 20 77 69 7a 61 72 64 5f 73 6e 69 74 20 7b 0a 20 wizard_snit {.
11e30 20 20 20 6f 70 74 69 6f 6e 20 2d 69 6d 61 67 65 option -image
11e40 20 22 22 0a 20 20 20 20 6f 70 74 69 6f 6e 20 2d "". option -
11e50 6f 6e 5f 65 78 69 74 5f 63 61 6c 6c 62 61 63 6b on_exit_callback
11e60 20 22 22 0a 0a 20 20 20 20 64 65 6c 65 67 61 74 "".. delegat
11e70 65 20 6d 65 74 68 6f 64 20 2a 20 74 6f 20 68 75 e method * to hu
11e80 6c 6c 0a 20 20 20 20 64 65 6c 65 67 61 74 65 20 ll. delegate
11e90 6f 70 74 69 6f 6e 20 2a 20 74 6f 20 68 75 6c 6c option * to hull
11ea0 0a 0a 20 20 20 20 23 20 65 76 65 72 79 20 65 6c .. # every el
11eb0 65 6d 65 6e 74 20 69 73 20 63 6f 6d 70 6f 73 65 ement is compose
11ec0 64 20 6f 66 3a 20 74 69 74 6c 65 20 62 75 69 6c d of: title buil
11ed0 64 5f 63 61 6c 6c 62 61 63 6b 20 63 68 65 63 6b d_callback check
11ee0 5f 63 61 6c 6c 62 61 63 6b 20 68 61 73 5f 66 69 _callback has_fi
11ef0 6e 69 73 68 5f 62 75 74 74 6f 6e 0a 20 20 20 20 nish_button.
11f00 23 20 69 73 5f 6c 61 62 65 6c 66 72 61 6d 65 20 # is_labelframe
11f10 69 73 5f 68 69 64 64 65 6e 20 70 72 65 76 69 6f is_hidden previo
11f20 75 73 5f 70 61 67 65 0a 20 20 20 20 23 20 63 68 us_page. # ch
11f30 65 63 6b 5f 63 61 6c 6c 62 61 63 6b 20 63 61 6e eck_callback can
11f40 20 62 65 20 76 6f 69 64 20 6f 6e 20 61 6c 6c 20 be void on all
11f50 70 61 67 65 73 20 65 78 63 65 70 74 20 74 68 65 pages except the
11f60 20 6c 61 73 74 0a 20 20 20 20 76 61 72 69 61 62 last. variab
11f70 6c 65 20 64 61 74 61 4c 69 73 74 20 22 22 0a 0a le dataList ""..
11f80 20 20 20 20 76 61 72 69 61 62 6c 65 20 63 75 72 variable cur
11f90 72 5f 63 61 6c 6c 62 61 63 6b 0a 20 20 20 20 76 r_callback. v
11fa0 61 72 69 61 62 6c 65 20 66 72 61 6d 65 0a 0a 20 ariable frame..
11fb0 20 20 20 63 6f 6e 73 74 72 75 63 74 6f 72 20 7b constructor {
11fc0 61 72 67 73 7d 20 7b 0a 09 69 6e 73 74 61 6c 6c args} {..install
11fd0 68 75 6c 6c 20 75 73 69 6e 67 20 64 69 61 6c 6f hull using dialo
11fe0 67 77 69 6e 5f 73 6e 69 74 20 2d 63 61 6c 6c 62 gwin_snit -callb
11ff0 61 63 6b 20 5b 6d 79 6d 65 74 68 6f 64 20 5f 63 ack [mymethod _c
12000 61 6c 6c 62 61 63 6b 5d 20 5c 0a 09 20 20 20 20 allback] \..
12010 2d 6d 6f 72 65 62 75 74 74 6f 6e 73 20 5b 6c 69 -morebuttons [li
12020 73 74 20 5b 5f 20 50 72 65 76 69 6f 75 73 5d 20 st [_ Previous]
12030 5b 5f 20 4e 65 78 74 5d 20 5b 5f 20 46 69 6e 69 [_ Next] [_ Fini
12040 73 68 5d 20 5b 5f 20 43 61 6e 63 65 6c 5d 5d 20 sh] [_ Cancel]]
12050 5c 0a 09 20 20 20 20 2d 6f 6b 6e 61 6d 65 20 2d \.. -okname -
12060 20 2d 63 61 6e 63 65 6c 6e 61 6d 65 20 2d 20 2d -cancelname - -
12070 67 65 6f 6d 65 74 72 79 20 35 30 30 78 33 30 30 geometry 500x300
12080 20 2d 74 72 61 6e 73 69 65 6e 74 20 31 0a 0a 09 -transient 1...
12090 24 73 65 6c 66 20 63 6f 6e 66 69 67 75 72 65 6c $self configurel
120a0 69 73 74 20 24 61 72 67 73 0a 09 0a 09 73 65 74 ist $args....set
120b0 20 66 20 5b 24 77 69 6e 20 67 69 76 65 66 72 61 f [$win givefra
120c0 6d 65 5d 0a 09 0a 09 74 74 6b 3a 3a 6c 61 62 65 me]....ttk::labe
120d0 6c 20 24 66 2e 6c 31 0a 09 69 66 20 7b 20 24 6f l $f.l1..if { $o
120e0 70 74 69 6f 6e 73 28 2d 69 6d 61 67 65 29 20 6e ptions(-image) n
120f0 65 20 22 22 20 7d 20 7b 0a 09 20 20 20 20 24 66 e "" } {.. $f
12100 2e 6c 31 20 63 6f 6e 66 69 67 75 72 65 20 2d 69 .l1 configure -i
12110 6d 61 67 65 20 24 6f 70 74 69 6f 6e 73 28 2d 69 mage $options(-i
12120 6d 61 67 65 29 0a 09 7d 0a 09 73 65 74 20 66 72 mage)..}..set fr
12130 61 6d 65 20 5b 74 74 6b 3a 3a 6c 61 62 65 6c 66 ame [ttk::labelf
12140 72 61 6d 65 20 24 66 2e 66 31 5d 0a 09 0a 09 67 rame $f.f1]....g
12150 72 69 64 20 24 66 2e 6c 31 20 24 66 72 61 6d 65 rid $f.l1 $frame
12160 20 2d 73 74 69 63 6b 79 20 6e 73 65 77 0a 09 67 -sticky nsew..g
12170 72 69 64 20 63 6f 6e 66 69 67 75 72 65 20 24 66 rid configure $f
12180 72 61 6d 65 20 2d 70 61 64 78 20 35 20 2d 70 61 rame -padx 5 -pa
12190 64 79 20 35 0a 09 67 72 69 64 20 63 6f 6c 75 6d dy 5..grid colum
121a0 6e 63 6f 6e 66 69 67 75 72 65 20 24 66 20 31 20 nconfigure $f 1
121b0 2d 77 65 69 67 68 74 20 31 0a 09 67 72 69 64 20 -weight 1..grid
121c0 72 6f 77 63 6f 6e 66 69 67 75 72 65 20 24 66 20 rowconfigure $f
121d0 30 20 2d 77 65 69 67 68 74 20 31 0a 09 0a 09 73 0 -weight 1....s
121e0 65 74 20 63 75 72 72 5f 63 61 6c 6c 62 61 63 6b et curr_callback
121f0 20 30 0a 09 0a 09 24 77 69 6e 20 63 68 61 6e 67 0....$win chang
12200 65 62 75 74 74 6f 6e 67 72 69 64 6f 70 74 69 6f ebuttongridoptio
12210 6e 73 20 35 20 2d 70 61 64 78 20 22 32 30 20 30 ns 5 -padx "20 0
12220 22 0a 09 24 77 69 6e 20 63 72 65 61 74 65 77 69 "..$win createwi
12230 6e 64 6f 77 0a 20 20 20 20 7d 0a 20 20 20 20 6d ndow. }. m
12240 65 74 68 6f 64 20 63 72 65 61 74 65 5f 70 61 67 ethod create_pag
12250 65 20 7b 20 61 72 67 73 20 7d 20 7b 0a 09 0a 09 e { args } {....
12260 73 65 74 20 6f 70 74 69 6f 6e 61 6c 20 7b 0a 09 set optional {..
12270 20 20 20 20 7b 20 2d 63 68 65 63 6b 5f 63 61 6c { -check_cal
12280 6c 62 61 63 6b 20 63 61 6c 6c 62 61 63 6b 20 22 lback callback "
12290 22 20 7d 0a 09 20 20 20 20 7b 20 2d 68 61 73 5f " }.. { -has_
122a0 66 69 6e 69 73 68 5f 62 75 74 74 6f 6e 20 62 6f finish_button bo
122b0 6f 6c 65 61 6e 20 30 20 7d 0a 09 20 20 20 20 7b olean 0 }.. {
122c0 20 2d 69 73 5f 6c 61 62 65 6c 66 72 61 6d 65 20 -is_labelframe
122d0 62 6f 6f 6c 65 61 6e 20 31 20 7d 0a 09 20 20 20 boolean 1 }..
122e0 20 7b 20 2d 69 73 5f 68 69 64 64 65 6e 20 62 6f { -is_hidden bo
122f0 6f 6c 65 61 6e 20 30 20 7d 0a 09 20 20 20 20 7b olean 0 }.. {
12300 20 2d 70 72 65 76 69 6f 75 73 5f 70 61 67 65 20 -previous_page
12310 6e 75 6d 62 65 72 7c 74 69 74 6c 65 20 22 22 20 number|title ""
12320 7d 0a 09 7d 0a 09 73 65 74 20 63 6f 6d 70 75 6c }..}..set compul
12330 73 6f 72 79 20 22 74 69 74 6c 65 20 62 75 69 6c sory "title buil
12340 64 5f 63 61 6c 6c 62 61 63 6b 22 0a 09 70 61 72 d_callback"..par
12350 73 65 5f 61 72 67 73 20 24 6f 70 74 69 6f 6e 61 se_args $optiona
12360 6c 20 24 63 6f 6d 70 75 6c 73 6f 72 79 20 24 61 l $compulsory $a
12370 72 67 73 0a 09 0a 09 69 66 20 7b 20 24 70 72 65 rgs....if { $pre
12380 76 69 6f 75 73 5f 70 61 67 65 20 6e 65 20 22 22 vious_page ne ""
12390 20 26 26 20 21 5b 73 74 72 69 6e 67 20 69 73 20 && ![string is
123a0 69 6e 74 65 67 65 72 20 2d 73 74 72 69 63 74 20 integer -strict
123b0 24 70 72 65 76 69 6f 75 73 5f 70 61 67 65 5d 20 $previous_page]
123c0 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 69 70 6f } {.. set ipo
123d0 73 20 5b 6c 73 65 61 72 63 68 20 2d 65 78 61 63 s [lsearch -exac
123e0 74 20 2d 69 6e 64 65 78 20 30 20 24 64 61 74 61 t -index 0 $data
123f0 4c 69 73 74 20 24 70 72 65 76 69 6f 75 73 5f 70 List $previous_p
12400 61 67 65 5d 0a 09 20 20 20 20 69 66 20 7b 20 24 age].. if { $
12410 69 70 6f 73 20 3d 3d 20 2d 31 20 7d 20 7b 0a 09 ipos == -1 } {..
12420 09 65 72 72 6f 72 20 22 65 72 72 6f 72 20 69 6e .error "error in
12430 20 63 72 65 61 74 65 5f 70 61 67 65 2e 20 70 72 create_page. pr
12440 65 76 69 6f 75 73 5f 70 61 67 65 20 6e 6f 74 20 evious_page not
12450 65 78 69 73 74 61 6e 74 22 0a 09 20 20 20 20 7d existant".. }
12460 0a 09 20 20 20 20 73 65 74 20 70 72 65 76 69 6f .. set previo
12470 75 73 5f 70 61 67 65 20 5b 65 78 70 72 20 7b 24 us_page [expr {$
12480 69 70 6f 73 2b 31 7d 5d 0a 09 7d 0a 09 0a 09 73 ipos+1}]..}....s
12490 65 74 20 65 6c 6d 20 5b 6c 69 73 74 20 24 74 69 et elm [list $ti
124a0 74 6c 65 20 24 62 75 69 6c 64 5f 63 61 6c 6c 62 tle $build_callb
124b0 61 63 6b 20 24 63 68 65 63 6b 5f 63 61 6c 6c 62 ack $check_callb
124c0 61 63 6b 20 24 68 61 73 5f 66 69 6e 69 73 68 5f ack $has_finish_
124d0 62 75 74 74 6f 6e 20 5c 0a 09 09 24 69 73 5f 6c button \...$is_l
124e0 61 62 65 6c 66 72 61 6d 65 20 24 69 73 5f 68 69 abelframe $is_hi
124f0 64 64 65 6e 20 24 70 72 65 76 69 6f 75 73 5f 70 dden $previous_p
12500 61 67 65 5d 0a 0a 09 6c 61 70 70 65 6e 64 20 64 age]...lappend d
12510 61 74 61 4c 69 73 74 20 24 65 6c 6d 0a 09 72 65 ataList $elm..re
12520 74 75 72 6e 20 5b 6c 6c 65 6e 67 74 68 20 24 64 turn [llength $d
12530 61 74 61 4c 69 73 74 5d 0a 20 20 20 20 7d 0a 20 ataList]. }.
12540 20 20 20 6d 65 74 68 6f 64 20 65 64 69 74 5f 70 method edit_p
12550 61 67 65 20 7b 20 6e 75 6d 20 61 72 67 73 20 7d age { num args }
12560 20 7b 0a 09 0a 09 69 6e 63 72 20 6e 75 6d 20 2d {....incr num -
12570 31 0a 09 0a 09 73 65 74 20 6f 70 74 69 6f 6e 61 1....set optiona
12580 6c 20 7b 0a 09 20 20 20 20 7b 20 2d 74 69 74 6c l {.. { -titl
12590 65 20 74 69 74 6c 65 20 22 22 20 7d 0a 09 20 20 e title "" }..
125a0 20 20 7b 20 2d 62 75 69 6c 64 5f 63 61 6c 6c 62 { -build_callb
125b0 61 63 6b 20 63 61 6c 6c 62 61 63 6b 20 22 22 20 ack callback ""
125c0 7d 0a 09 20 20 20 20 7b 20 2d 63 68 65 63 6b 5f }.. { -check_
125d0 63 61 6c 6c 62 61 63 6b 20 63 61 6c 6c 62 61 63 callback callbac
125e0 6b 20 22 22 20 7d 0a 09 20 20 20 20 7b 20 2d 68 k "" }.. { -h
125f0 61 73 5f 66 69 6e 69 73 68 5f 62 75 74 74 6f 6e as_finish_button
12600 20 62 6f 6f 6c 65 61 6e 20 2d 31 20 7d 0a 09 20 boolean -1 }..
12610 20 20 20 7b 20 2d 69 73 5f 6c 61 62 65 6c 66 72 { -is_labelfr
12620 61 6d 65 20 62 6f 6f 6c 65 61 6e 20 2d 31 20 7d ame boolean -1 }
12630 0a 09 20 20 20 20 7b 20 2d 69 73 5f 68 69 64 64 .. { -is_hidd
12640 65 6e 20 62 6f 6f 6c 65 61 6e 20 2d 31 20 7d 0a en boolean -1 }.
12650 09 20 20 20 20 7b 20 2d 70 72 65 76 69 6f 75 73 . { -previous
12660 5f 70 61 67 65 20 6e 75 6d 62 65 72 7c 74 69 74 _page number|tit
12670 6c 65 20 22 22 20 7d 0a 09 7d 0a 09 73 65 74 20 le "" }..}..set
12680 63 6f 6d 70 75 6c 73 6f 72 79 20 22 22 0a 09 70 compulsory ""..p
12690 61 72 73 65 5f 61 72 67 73 20 24 6f 70 74 69 6f arse_args $optio
126a0 6e 61 6c 20 24 63 6f 6d 70 75 6c 73 6f 72 79 20 nal $compulsory
126b0 24 61 72 67 73 0a 09 0a 09 69 66 20 7b 20 24 70 $args....if { $p
126c0 72 65 76 69 6f 75 73 5f 70 61 67 65 20 6e 65 20 revious_page ne
126d0 22 22 20 26 26 20 21 5b 73 74 72 69 6e 67 20 69 "" && ![string i
126e0 73 20 69 6e 74 65 67 65 72 20 2d 73 74 72 69 63 s integer -stric
126f0 74 20 24 70 72 65 76 69 6f 75 73 5f 70 61 67 65 t $previous_page
12700 5d 20 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 69 ] } {.. set i
12710 70 6f 73 20 5b 6c 73 65 61 72 63 68 20 2d 65 78 pos [lsearch -ex
12720 61 63 74 20 2d 69 6e 64 65 78 20 30 20 24 64 61 act -index 0 $da
12730 74 61 4c 69 73 74 20 24 70 72 65 76 69 6f 75 73 taList $previous
12740 5f 70 61 67 65 5d 0a 09 20 20 20 20 69 66 20 7b _page].. if {
12750 20 24 69 70 6f 73 20 3d 3d 20 2d 31 20 7d 20 7b $ipos == -1 } {
12760 0a 09 09 65 72 72 6f 72 20 22 65 72 72 6f 72 20 ...error "error
12770 69 6e 20 65 64 69 74 5f 70 61 67 65 2e 20 70 72 in edit_page. pr
12780 65 76 69 6f 75 73 5f 70 61 67 65 20 6e 6f 74 20 evious_page not
12790 65 78 69 73 74 61 6e 74 22 0a 09 20 20 20 20 7d existant".. }
127a0 0a 09 20 20 20 20 73 65 74 20 70 72 65 76 69 6f .. set previo
127b0 75 73 5f 70 61 67 65 20 5b 65 78 70 72 20 7b 24 us_page [expr {$
127c0 69 70 6f 73 2b 31 7d 5d 0a 09 7d 0a 09 0a 09 73 ipos+1}]..}....s
127d0 65 74 20 69 64 78 20 30 0a 09 66 6f 72 65 61 63 et idx 0..foreac
127e0 68 20 69 20 24 6f 70 74 69 6f 6e 61 6c 20 7b 0a h i $optional {.
127f0 09 20 20 20 20 66 6f 72 65 61 63 68 20 22 6f 70 . foreach "op
12800 74 20 74 79 70 65 20 64 65 66 22 20 24 69 20 62 t type def" $i b
12810 72 65 61 6b 0a 09 20 20 20 20 73 65 74 20 6f 70 reak.. set op
12820 74 20 5b 73 74 72 69 6e 67 20 74 72 69 6d 6c 65 t [string trimle
12830 66 74 20 24 6f 70 74 20 2d 5d 0a 09 20 20 20 20 ft $opt -]..
12840 69 66 20 7b 20 5b 73 65 74 20 24 6f 70 74 5d 20 if { [set $opt]
12850 6e 65 20 24 64 65 66 20 7d 20 7b 0a 09 09 6c 73 ne $def } {...ls
12860 65 74 20 64 61 74 61 4c 69 73 74 20 24 6e 75 6d et dataList $num
12870 20 24 69 64 78 20 5b 73 65 74 20 24 6f 70 74 5d $idx [set $opt]
12880 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 6e 63 .. }.. inc
12890 72 20 69 64 78 0a 09 7d 0a 20 20 20 20 7d 0a 20 r idx..}. }.
128a0 20 20 20 6d 65 74 68 6f 64 20 6f 70 65 6e 5f 70 method open_p
128b0 61 67 65 20 7b 20 6e 75 6d 20 7d 20 7b 0a 09 73 age { num } {..s
128c0 65 74 20 63 75 72 72 5f 63 61 6c 6c 62 61 63 6b et curr_callback
128d0 20 5b 65 78 70 72 20 7b 24 6e 75 6d 2d 31 7d 5d [expr {$num-1}]
128e0 0a 09 24 73 65 6c 66 20 5f 6f 70 65 6e 5f 77 69 ..$self _open_wi
128f0 6e 64 6f 77 20 61 68 65 61 64 0a 20 20 20 20 7d ndow ahead. }
12900 0a 20 20 20 20 6d 65 74 68 6f 64 20 5f 6f 70 65 . method _ope
12910 6e 5f 77 69 6e 64 6f 77 20 7b 20 64 69 72 65 63 n_window { direc
12920 74 69 6f 6e 20 7d 20 7b 0a 0a 09 77 68 69 6c 65 tion } {...while
12930 20 31 20 7b 0a 09 20 20 20 20 73 65 74 20 65 6c 1 {.. set el
12940 6d 20 5b 6c 69 6e 64 65 78 20 24 64 61 74 61 4c m [lindex $dataL
12950 69 73 74 20 24 63 75 72 72 5f 63 61 6c 6c 62 61 ist $curr_callba
12960 63 6b 5d 0a 09 20 20 20 20 69 66 20 7b 20 24 65 ck].. if { $e
12970 6c 6d 20 65 71 20 22 22 20 7d 20 7b 20 72 65 74 lm eq "" } { ret
12980 75 72 6e 20 7d 0a 09 20 20 20 20 66 6f 72 65 61 urn }.. forea
12990 63 68 20 5b 6c 69 73 74 20 74 69 74 6c 65 20 62 ch [list title b
129a0 75 69 6c 64 5f 63 61 6c 6c 62 61 63 6b 20 63 68 uild_callback ch
129b0 65 63 6b 5f 63 61 6c 6c 62 61 63 6b 20 68 61 73 eck_callback has
129c0 5f 66 69 6e 69 73 68 5f 62 75 74 74 6f 6e 20 5c _finish_button \
129d0 0a 09 09 20 20 20 20 69 73 5f 6c 61 62 65 6c 66 ... is_labelf
129e0 72 61 6d 65 20 69 73 5f 68 69 64 64 65 6e 20 70 rame is_hidden p
129f0 72 65 76 69 6f 75 73 5f 70 61 67 65 5d 20 24 65 revious_page] $e
12a00 6c 6d 20 62 72 65 61 6b 0a 09 20 20 20 20 69 66 lm break.. if
12a10 20 7b 20 21 24 69 73 5f 68 69 64 64 65 6e 20 7d { !$is_hidden }
12a20 20 7b 20 62 72 65 61 6b 20 7d 0a 09 20 20 20 20 { break }..
12a30 73 77 69 74 63 68 20 24 64 69 72 65 63 74 69 6f switch $directio
12a40 6e 20 7b 0a 09 09 61 68 65 61 64 20 7b 20 69 6e n {...ahead { in
12a50 63 72 20 63 75 72 72 5f 63 61 6c 6c 62 61 63 6b cr curr_callback
12a60 20 7d 0a 09 09 62 65 68 69 6e 64 20 7b 20 69 6e }...behind { in
12a70 63 72 20 63 75 72 72 5f 63 61 6c 6c 62 61 63 6b cr curr_callback
12a80 20 2d 31 20 7d 0a 09 20 20 20 20 7d 0a 09 7d 0a -1 }.. }..}.
12a90 09 65 76 61 6c 20 64 65 73 74 72 6f 79 20 5b 77 .eval destroy [w
12aa0 69 6e 66 6f 20 63 68 69 6c 64 72 65 6e 20 24 66 info children $f
12ab0 72 61 6d 65 5d 0a 09 73 65 74 20 69 20 5b 67 72 rame]..set i [gr
12ac0 69 64 20 69 6e 66 6f 20 24 66 72 61 6d 65 5d 0a id info $frame].
12ad0 09 64 65 73 74 72 6f 79 20 24 66 72 61 6d 65 0a .destroy $frame.
12ae0 09 69 66 20 7b 20 24 69 73 5f 6c 61 62 65 6c 66 .if { $is_labelf
12af0 72 61 6d 65 20 7d 20 7b 0a 09 20 20 20 20 74 74 rame } {.. tt
12b00 6b 3a 3a 6c 61 62 65 6c 66 72 61 6d 65 20 24 66 k::labelframe $f
12b10 72 61 6d 65 20 2d 74 65 78 74 20 24 74 69 74 6c rame -text $titl
12b20 65 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 e..} else {..
12b30 20 74 74 6b 3a 3a 66 72 61 6d 65 20 24 66 72 61 ttk::frame $fra
12b40 6d 65 0a 09 7d 0a 09 65 76 61 6c 20 67 72 69 64 me..}..eval grid
12b50 20 24 66 72 61 6d 65 20 24 69 0a 0a 09 6c 61 70 $frame $i...lap
12b60 70 65 6e 64 20 62 75 69 6c 64 5f 63 61 6c 6c 62 pend build_callb
12b70 61 63 6b 20 24 77 69 6e 20 24 66 72 61 6d 65 0a ack $win $frame.
12b80 09 75 70 6c 65 76 65 6c 20 23 30 20 24 62 75 69 .uplevel #0 $bui
12b90 6c 64 5f 63 61 6c 6c 62 61 63 6b 0a 09 0a 09 24 ld_callback....$
12ba0 77 69 6e 20 63 6f 6e 66 69 67 75 72 65 20 2d 74 win configure -t
12bb0 69 74 6c 65 20 24 74 69 74 6c 65 0a 09 0a 09 69 itle $title....i
12bc0 66 20 7b 20 24 63 75 72 72 5f 63 61 6c 6c 62 61 f { $curr_callba
12bd0 63 6b 20 3d 3d 20 30 20 7d 20 7b 0a 09 20 20 20 ck == 0 } {..
12be0 20 24 77 69 6e 20 64 69 73 61 62 6c 65 62 75 74 $win disablebut
12bf0 74 6f 6e 20 32 0a 09 7d 20 65 6c 73 65 20 7b 0a ton 2..} else {.
12c00 09 20 20 20 20 24 77 69 6e 20 65 6e 61 62 6c 65 . $win enable
12c10 62 75 74 74 6f 6e 20 32 0a 09 7d 0a 09 69 66 20 button 2..}..if
12c20 7b 20 24 63 75 72 72 5f 63 61 6c 6c 62 61 63 6b { $curr_callback
12c30 20 3d 3d 20 5b 6c 6c 65 6e 67 74 68 20 24 64 61 == [llength $da
12c40 74 61 4c 69 73 74 5d 2d 31 20 7d 20 7b 0a 09 20 taList]-1 } {..
12c50 20 20 20 24 77 69 6e 20 64 69 73 61 62 6c 65 62 $win disableb
12c60 75 74 74 6f 6e 20 33 0a 09 20 20 20 20 24 77 69 utton 3.. $wi
12c70 6e 20 73 68 6f 77 68 69 64 65 62 75 74 74 6f 6e n showhidebutton
12c80 20 34 20 73 68 6f 77 0a 09 7d 20 65 6c 73 65 20 4 show..} else
12c90 7b 0a 09 20 20 20 20 24 77 69 6e 20 65 6e 61 62 {.. $win enab
12ca0 6c 65 62 75 74 74 6f 6e 20 33 0a 09 20 20 20 20 lebutton 3..
12cb0 69 66 20 7b 20 24 68 61 73 5f 66 69 6e 69 73 68 if { $has_finish
12cc0 5f 62 75 74 74 6f 6e 20 3d 3d 20 31 20 7d 20 7b _button == 1 } {
12cd0 0a 09 09 24 77 69 6e 20 73 68 6f 77 68 69 64 65 ...$win showhide
12ce0 62 75 74 74 6f 6e 20 34 20 73 68 6f 77 0a 09 20 button 4 show..
12cf0 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 24 77 } else {...$w
12d00 69 6e 20 73 68 6f 77 68 69 64 65 62 75 74 74 6f in showhidebutto
12d10 6e 20 34 20 68 69 64 65 0a 09 20 20 20 20 7d 0a n 4 hide.. }.
12d20 09 7d 0a 09 69 66 20 7b 20 5b 77 6d 20 73 74 61 .}..if { [wm sta
12d30 74 65 20 24 77 69 6e 5d 20 6e 65 20 22 6e 6f 72 te $win] ne "nor
12d40 6d 61 6c 22 20 7d 20 7b 0a 09 20 20 20 20 24 73 mal" } {.. $s
12d50 65 6c 66 20 64 65 69 63 6f 6e 69 66 79 77 69 6e elf deiconifywin
12d60 64 6f 77 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 dow..}. }.
12d70 20 6d 65 74 68 6f 64 20 5f 63 61 6c 6c 62 61 63 method _callbac
12d80 6b 20 7b 20 66 20 7d 20 7b 0a 09 73 77 69 74 63 k { f } {..switc
12d90 68 20 2d 2d 20 5b 24 77 69 6e 20 67 69 76 65 61 h -- [$win givea
12da0 63 74 69 6f 6e 5d 20 7b 0a 09 20 20 20 20 2d 31 ction] {.. -1
12db0 20 2d 20 30 20 2d 20 35 20 7b 0a 09 09 72 65 74 - 0 - 5 {...ret
12dc0 75 72 6e 20 5b 24 73 65 6c 66 20 77 69 74 68 64 urn [$self withd
12dd0 72 61 77 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 raw].. }..
12de0 20 32 20 7b 0a 09 09 73 65 74 20 70 72 65 76 69 2 {...set previ
12df0 6f 75 73 5f 70 61 67 65 20 5b 6c 69 6e 64 65 78 ous_page [lindex
12e00 20 24 64 61 74 61 4c 69 73 74 20 24 63 75 72 72 $dataList $curr
12e10 5f 63 61 6c 6c 62 61 63 6b 20 36 5d 0a 09 09 69 _callback 6]...i
12e20 66 20 7b 20 24 70 72 65 76 69 6f 75 73 5f 70 61 f { $previous_pa
12e30 67 65 20 6e 65 20 22 22 20 7d 20 7b 0a 09 09 20 ge ne "" } {...
12e40 20 20 20 73 65 74 20 63 75 72 72 5f 63 61 6c 6c set curr_call
12e50 62 61 63 6b 20 5b 65 78 70 72 20 7b 24 70 72 65 back [expr {$pre
12e60 76 69 6f 75 73 5f 70 61 67 65 2d 31 7d 5d 0a 09 vious_page-1}]..
12e70 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 .} else {...
12e80 69 6e 63 72 20 63 75 72 72 5f 63 61 6c 6c 62 61 incr curr_callba
12e90 63 6b 20 2d 31 0a 09 09 7d 0a 09 09 24 73 65 6c ck -1...}...$sel
12ea0 66 20 5f 6f 70 65 6e 5f 77 69 6e 64 6f 77 20 62 f _open_window b
12eb0 65 68 69 6e 64 0a 09 20 20 20 20 7d 0a 09 20 20 ehind.. }..
12ec0 20 20 33 20 2d 20 34 20 7b 0a 09 09 73 65 74 20 3 - 4 {...set
12ed0 63 68 65 63 6b 5f 63 61 6c 6c 62 61 63 6b 20 5b check_callback [
12ee0 6c 69 6e 64 65 78 20 24 64 61 74 61 4c 69 73 74 lindex $dataList
12ef0 20 24 63 75 72 72 5f 63 61 6c 6c 62 61 63 6b 20 $curr_callback
12f00 32 5d 0a 09 09 73 65 74 20 72 65 74 20 22 22 0a 2]...set ret "".
12f10 09 09 69 66 20 7b 20 24 63 68 65 63 6b 5f 63 61 ..if { $check_ca
12f20 6c 6c 62 61 63 6b 20 6e 65 20 22 22 20 7d 20 7b llback ne "" } {
12f30 0a 09 09 20 20 20 20 6c 61 70 70 65 6e 64 20 63 ... lappend c
12f40 68 65 63 6b 5f 63 61 6c 6c 62 61 63 6b 20 24 77 heck_callback $w
12f50 69 6e 20 24 66 72 61 6d 65 0a 09 09 20 20 20 20 in $frame...
12f60 69 66 20 7b 20 5b 24 77 69 6e 20 67 69 76 65 61 if { [$win givea
12f70 63 74 69 6f 6e 5d 20 3d 3d 20 34 20 7d 20 7b 0a ction] == 4 } {.
12f80 09 09 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e .. lappen
12f90 64 20 63 68 65 63 6b 5f 63 61 6c 6c 62 61 63 6b d check_callback
12fa0 20 66 69 6e 69 73 68 0a 09 09 20 20 20 20 7d 20 finish... }
12fb0 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 20 20 20 else {...
12fc0 20 6c 61 70 70 65 6e 64 20 63 68 65 63 6b 5f 63 lappend check_c
12fd0 61 6c 6c 62 61 63 6b 20 6e 65 78 74 0a 09 09 20 allback next...
12fe0 20 20 20 7d 0a 09 09 20 20 20 20 73 65 74 20 65 }... set e
12ff0 72 72 20 5b 63 61 74 63 68 20 7b 20 75 70 6c 65 rr [catch { uple
13000 76 65 6c 20 23 30 20 24 63 68 65 63 6b 5f 63 61 vel #0 $check_ca
13010 6c 6c 62 61 63 6b 20 7d 20 72 65 74 5d 0a 09 09 llback } ret]...
13020 20 20 20 20 69 66 20 7b 20 24 65 72 72 20 7d 20 if { $err }
13030 7b 0a 09 09 20 20 20 20 20 20 20 20 69 66 20 7b {... if {
13040 20 24 72 65 74 20 6e 65 20 22 22 20 7d 20 7b 0a $ret ne "" } {.
13050 09 09 20 20 20 20 20 20 20 20 20 20 20 20 73 6e .. sn
13060 69 74 5f 6d 65 73 73 61 67 65 42 6f 78 20 2d 70 it_messageBox -p
13070 61 72 65 6e 74 20 24 77 69 6e 20 2d 6d 65 73 73 arent $win -mess
13080 61 67 65 20 24 72 65 74 0a 09 09 20 20 20 20 20 age $ret...
13090 20 20 20 7d 0a 09 09 20 20 20 20 20 20 20 20 72 }... r
130a0 65 74 75 72 6e 0a 09 09 20 20 20 20 7d 0a 09 09 eturn... }...
130b0 7d 0a 09 09 69 66 20 7b 20 24 72 65 74 20 65 71 }...if { $ret eq
130c0 20 22 66 69 6e 69 73 68 22 20 7c 7c 20 5b 24 77 "finish" || [$w
130d0 69 6e 20 67 69 76 65 61 63 74 69 6f 6e 5d 20 3d in giveaction] =
130e0 3d 20 34 20 7d 20 7b 0a 09 09 20 20 20 20 72 65 = 4 } {... re
130f0 74 75 72 6e 20 5b 24 73 65 6c 66 20 77 69 74 68 turn [$self with
13100 64 72 61 77 5d 0a 09 09 7d 20 65 6c 73 65 69 66 draw]...} elseif
13110 20 7b 20 5b 73 74 72 69 6e 67 20 69 73 20 69 6e { [string is in
13120 74 65 67 65 72 20 2d 73 74 72 69 63 74 20 24 72 teger -strict $r
13130 65 74 5d 20 7d 20 7b 0a 09 09 20 20 20 20 73 65 et] } {... se
13140 74 20 63 75 72 72 5f 63 61 6c 6c 62 61 63 6b 20 t curr_callback
13150 5b 65 78 70 72 20 7b 24 72 65 74 2d 31 7d 5d 0a [expr {$ret-1}].
13160 09 09 7d 20 65 6c 73 65 69 66 20 7b 20 24 72 65 ..} elseif { $re
13170 74 20 6e 65 20 22 22 20 7d 20 7b 0a 09 09 20 20 t ne "" } {...
13180 20 20 73 65 74 20 69 70 6f 73 20 5b 6c 73 65 61 set ipos [lsea
13190 72 63 68 20 2d 65 78 61 63 74 20 2d 69 6e 64 65 rch -exact -inde
131a0 78 20 30 20 24 64 61 74 61 4c 69 73 74 20 24 72 x 0 $dataList $r
131b0 65 74 5d 0a 09 09 20 20 20 20 69 66 20 7b 20 24 et]... if { $
131c0 69 70 6f 73 20 3d 3d 20 2d 31 20 7d 20 7b 0a 09 ipos == -1 } {..
131d0 09 20 20 20 20 20 20 20 20 65 72 72 6f 72 20 22 . error "
131e0 65 72 72 6f 72 20 69 6e 20 63 68 65 63 6b 5f 63 error in check_c
131f0 61 6c 6c 62 61 63 6b 20 72 65 74 75 72 6e 20 76 allback return v
13200 61 6c 75 65 2e 20 70 61 67 65 20 6e 6f 74 20 65 alue. page not e
13210 78 69 73 74 61 6e 74 22 0a 09 09 20 20 20 20 7d xistant"... }
13220 0a 09 09 20 20 20 20 73 65 74 20 63 75 72 72 5f ... set curr_
13230 63 61 6c 6c 62 61 63 6b 20 24 69 70 6f 73 0a 09 callback $ipos..
13240 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 .} else {...
13250 69 6e 63 72 20 63 75 72 72 5f 63 61 6c 6c 62 61 incr curr_callba
13260 63 6b 0a 09 09 7d 0a 09 09 24 73 65 6c 66 20 5f ck...}...$self _
13270 6f 70 65 6e 5f 77 69 6e 64 6f 77 20 61 68 65 61 open_window ahea
13280 64 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 d.. }..}.
13290 7d 0a 20 20 20 20 6d 65 74 68 6f 64 20 77 69 74 }. method wit
132a0 68 64 72 61 77 20 7b 7d 20 7b 0a 09 69 66 20 7b hdraw {} {..if {
132b0 20 24 6f 70 74 69 6f 6e 73 28 2d 6f 6e 5f 65 78 $options(-on_ex
132c0 69 74 5f 63 61 6c 6c 62 61 63 6b 29 20 6e 65 20 it_callback) ne
132d0 22 22 20 7d 20 7b 0a 09 20 20 20 20 75 70 6c 65 "" } {.. uple
132e0 76 65 6c 20 23 30 20 24 6f 70 74 69 6f 6e 73 28 vel #0 $options(
132f0 2d 6f 6e 5f 65 78 69 74 5f 63 61 6c 6c 62 61 63 -on_exit_callbac
13300 6b 29 20 24 77 69 6e 0a 09 7d 0a 09 24 73 65 6c k) $win..}..$sel
13310 66 20 77 69 74 68 64 72 61 77 77 69 6e 64 6f 77 f withdrawwindow
13320 0a 09 23 64 65 73 74 72 6f 79 20 24 77 69 6e 0a ..#destroy $win.
13330 09 72 65 74 75 72 6e 20 22 22 0a 20 20 20 20 7d .return "". }
13340 0a 7d 0a 0a 23 23 23 23 23 23 23 23 23 23 23 23 .}..############
13350 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
13360 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
13370 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
13380 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
13390 23 23 23 23 0a 23 20 20 20 20 70 61 72 73 65 20 ####.# parse
133a0 61 72 67 73 0a 23 0a 23 20 65 78 61 6d 70 6c 65 args.#.# example
133b0 3a 0a 23 20 20 70 72 6f 63 20 6d 79 70 72 6f 63 :.# proc myproc
133c0 20 7b 20 61 72 67 73 20 7d 20 7b 0a 23 20 20 20 { args } {.#
133d0 20 20 73 65 74 20 6f 70 74 69 6f 6e 61 6c 20 7b set optional {
133e0 0a 23 20 20 20 20 20 20 20 20 20 7b 20 2d 76 69 .# { -vi
133f0 65 77 5f 62 69 6e 64 69 6e 67 20 62 69 6e 64 69 ew_binding bindi
13400 6e 67 20 22 22 20 7d 0a 23 20 20 20 20 20 20 20 ng "" }.#
13410 20 20 7b 20 2d 66 69 6c 65 20 66 69 6c 65 20 22 { -file file "
13420 22 20 7d 0a 23 20 20 20 20 20 20 20 20 20 7b 20 " }.# {
13430 2d 72 65 73 74 61 72 74 5f 66 69 6c 65 20 62 6f -restart_file bo
13440 6f 6c 65 61 6e 20 30 20 7d 0a 23 20 20 20 20 20 olean 0 }.#
13450 20 20 20 20 7b 20 2d 66 6c 61 67 31 20 22 22 20 { -flag1 ""
13460 30 20 7d 0a 23 20 20 20 20 20 7d 0a 23 20 20 20 0 }.# }.#
13470 20 20 73 65 74 20 63 6f 6d 70 75 6c 73 6f 72 79 set compulsory
13480 20 22 6c 65 76 65 6c 73 22 0a 23 20 20 20 20 20 "levels".#
13490 70 61 72 73 65 5f 61 72 67 73 20 24 6f 70 74 69 parse_args $opti
134a0 6f 6e 61 6c 20 24 63 6f 6d 70 75 6c 73 6f 72 79 onal $compulsory
134b0 20 24 61 72 67 73 0a 23 0a 23 20 20 20 20 20 69 $args.#.# i
134c0 66 20 7b 20 24 76 69 65 77 5f 62 69 6e 64 69 6e f { $view_bindin
134d0 67 20 6e 65 20 22 22 20 7d 20 7b 20 70 75 74 73 g ne "" } { puts
134e0 20 68 6f 68 6f 68 6f 20 7d 0a 23 20 20 20 20 20 hohoho }.#
134f0 69 66 20 7b 20 24 66 6c 61 67 31 20 7d 20 7b 20 if { $flag1 } {
13500 70 75 74 73 20 22 61 63 74 69 76 61 74 65 64 20 puts "activated
13510 66 6c 61 67 22 20 7d 0a 23 20 20 7d 0a 23 0a 23 flag" }.# }.#.#
13520 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
13530 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
13540 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
13550 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
13560 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 0a ###############.
13570 0a 69 66 20 7b 20 31 7c 7c 20 5b 63 61 74 63 68 .if { 1|| [catch
13580 20 7b 20 70 61 63 6b 61 67 65 20 72 65 71 75 69 { package requi
13590 72 65 20 63 6f 6d 70 61 73 73 5f 75 74 69 6c 73 re compass_utils
135a0 20 7d 5d 20 7d 20 7b 0a 20 20 20 20 70 72 6f 63 }] } {. proc
135b0 20 3a 3a 70 61 72 73 65 5f 61 72 67 73 20 7b 20 ::parse_args {
135c0 61 72 67 73 20 7d 20 7b 0a 09 0a 09 73 65 74 20 args } {....set
135d0 6f 70 74 69 6f 6e 61 6c 20 7b 0a 09 20 20 20 20 optional {..
135e0 7b 20 2d 72 61 69 73 65 5f 63 6f 6d 70 75 6c 73 { -raise_compuls
135f0 6f 72 79 5f 65 72 72 6f 72 20 62 6f 6f 6c 65 61 ory_error boolea
13600 6e 20 31 20 7d 0a 09 20 20 20 20 7b 20 2d 63 6f n 1 }.. { -co
13610 6d 70 75 6c 73 6f 72 79 5f 6d 69 6e 20 6d 69 6e mpulsory_min min
13620 5f 6e 75 6d 62 65 72 20 22 22 20 7d 0a 09 7d 0a _number "" }..}.
13630 09 73 65 74 20 63 6f 6d 70 75 6c 73 6f 72 79 20 .set compulsory
13640 22 6f 70 74 69 6f 6e 61 6c 20 63 6f 6d 70 75 6c "optional compul
13650 73 6f 72 79 20 61 72 67 75 6d 65 6e 74 73 22 0a sory arguments".
13660 09 0a 09 69 66 20 7b 20 5b 69 6e 66 6f 20 6c 65 ...if { [info le
13670 76 65 6c 5d 20 3d 3d 20 31 20 7d 20 7b 0a 09 20 vel] == 1 } {..
13680 20 20 20 73 65 74 20 63 6d 64 6e 61 6d 65 20 5b set cmdname [
13690 6c 69 73 74 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f list [info nameo
136a0 66 65 78 65 63 75 74 61 62 6c 65 5d 5d 0a 09 20 fexecutable]]..
136b0 20 20 20 69 66 20 7b 20 21 5b 69 6e 66 6f 20 65 if { ![info e
136c0 78 69 73 74 73 20 3a 3a 73 74 61 72 6b 69 74 3a xists ::starkit:
136d0 3a 74 6f 70 64 69 72 5d 20 7d 20 7b 0a 09 09 6c :topdir] } {...l
136e0 61 70 70 65 6e 64 20 63 6d 64 6e 61 6d 65 20 24 append cmdname $
136f0 3a 3a 61 72 67 76 30 0a 09 20 20 20 20 7d 0a 09 ::argv0.. }..
13700 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 } else {.. se
13710 74 20 63 6d 64 6e 61 6d 65 20 5b 6c 69 6e 64 65 t cmdname [linde
13720 78 20 5b 69 6e 66 6f 20 6c 65 76 65 6c 20 5b 65 x [info level [e
13730 78 70 72 20 7b 5b 69 6e 66 6f 20 6c 65 76 65 6c xpr {[info level
13740 5d 2d 31 7d 5d 5d 20 30 5d 0a 09 7d 0a 09 69 66 ]-1}]] 0]..}..if
13750 20 7b 20 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 { [llength $arg
13760 73 5d 20 3e 20 5b 6c 6c 65 6e 67 74 68 20 24 63 s] > [llength $c
13770 6f 6d 70 75 6c 73 6f 72 79 5d 20 26 26 20 5b 73 ompulsory] && [s
13780 74 72 69 6e 67 20 6d 61 74 63 68 20 2d 2a 20 5b tring match -* [
13790 6c 69 6e 64 65 78 20 24 61 72 67 73 20 30 5d 5d lindex $args 0]]
137a0 20 7d 20 7b 0a 09 20 20 20 20 70 61 72 73 65 5f } {.. parse_
137b0 61 72 67 73 20 24 6f 70 74 69 6f 6e 61 6c 20 24 args $optional $
137c0 63 6f 6d 70 75 6c 73 6f 72 79 20 24 61 72 67 73 compulsory $args
137d0 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
137e0 73 65 74 20 72 61 69 73 65 5f 63 6f 6d 70 75 6c set raise_compul
137f0 73 6f 72 79 5f 65 72 72 6f 72 20 31 0a 09 20 20 sory_error 1..
13800 20 20 73 65 74 20 63 6f 6d 70 75 6c 73 6f 72 79 set compulsory
13810 5f 6d 69 6e 20 22 22 0a 09 20 20 20 20 69 66 20 _min "".. if
13820 7b 20 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 { [llength $args
13830 5d 20 21 3d 20 5b 6c 6c 65 6e 67 74 68 20 24 63 ] != [llength $c
13840 6f 6d 70 75 6c 73 6f 72 79 5d 20 7d 20 7b 0a 09 ompulsory] } {..
13850 09 75 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74 .uplevel 1 [list
13860 20 65 72 72 6f 72 20 5b 5f 70 61 72 73 65 5f 61 error [_parse_a
13870 72 67 73 5f 73 74 72 69 6e 67 20 24 63 6d 64 6e rgs_string $cmdn
13880 61 6d 65 20 24 6f 70 74 69 6f 6e 61 6c 20 5c 0a ame $optional \.
13890 09 09 20 20 20 20 20 20 20 20 20 20 20 20 24 63 .. $c
138a0 6f 6d 70 75 6c 73 6f 72 79 20 24 61 72 67 75 6d ompulsory $argum
138b0 65 6e 74 73 5d 5d 0a 09 09 72 65 74 75 72 6e 20 ents]]...return
138c0 22 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 6c "".. }.. l
138d0 61 73 73 69 67 6e 20 24 61 72 67 73 20 7b 2a 7d assign $args {*}
138e0 24 63 6f 6d 70 75 6c 73 6f 72 79 0a 09 7d 0a 09 $compulsory..}..
138f0 0a 09 66 6f 72 65 61 63 68 20 69 20 24 6f 70 74 ..foreach i $opt
13900 69 6f 6e 61 6c 20 7b 0a 09 20 20 20 20 6c 61 73 ional {.. las
13910 73 69 67 6e 20 24 69 20 6e 61 6d 65 20 6e 61 6d sign $i name nam
13920 65 76 61 6c 75 65 20 64 65 66 61 75 6c 74 0a 09 evalue default..
13930 20 20 20 20 73 65 74 20 6f 70 74 73 5f 76 61 6c set opts_val
13940 75 65 28 24 6e 61 6d 65 29 20 24 6e 61 6d 65 76 ue($name) $namev
13950 61 6c 75 65 0a 09 20 20 20 20 69 66 20 7b 20 5b alue.. if { [
13960 6c 6c 65 6e 67 74 68 20 24 69 5d 20 3e 20 32 20 llength $i] > 2
13970 7d 20 7b 0a 09 09 73 65 74 20 6f 70 74 73 28 24 } {...set opts($
13980 6e 61 6d 65 29 20 24 64 65 66 61 75 6c 74 0a 09 name) $default..
13990 20 20 20 20 7d 0a 09 7d 0a 09 77 68 69 6c 65 20 }..}..while
139a0 7b 20 28 21 24 72 61 69 73 65 5f 63 6f 6d 70 75 { (!$raise_compu
139b0 6c 73 6f 72 79 5f 65 72 72 6f 72 20 7c 7c 20 5b lsory_error || [
139c0 6c 6c 65 6e 67 74 68 20 24 61 72 67 75 6d 65 6e llength $argumen
139d0 74 73 5d 20 3e 20 5b 6c 6c 65 6e 67 74 68 20 24 ts] > [llength $
139e0 63 6f 6d 70 75 6c 73 6f 72 79 5d 29 20 26 26 0a compulsory]) &&.
139f0 09 20 20 20 20 5b 73 74 72 69 6e 67 20 6d 61 74 . [string mat
13a00 63 68 20 2d 2a 20 5b 6c 69 6e 64 65 78 20 24 61 ch -* [lindex $a
13a10 72 67 75 6d 65 6e 74 73 20 30 5d 5d 20 7d 20 7b rguments 0]] } {
13a20 0a 09 20 20 20 20 69 66 20 7b 20 5b 6c 69 6e 64 .. if { [lind
13a30 65 78 20 24 61 72 67 75 6d 65 6e 74 73 20 30 5d ex $arguments 0]
13a40 20 65 71 20 22 2d 2d 22 20 7d 20 7b 0a 09 09 73 eq "--" } {...s
13a50 65 74 20 61 72 67 75 6d 65 6e 74 73 20 5b 6c 72 et arguments [lr
13a60 61 6e 67 65 20 24 61 72 67 75 6d 65 6e 74 73 20 ange $arguments
13a70 31 20 65 6e 64 5d 0a 09 09 62 72 65 61 6b 0a 09 1 end]...break..
13a80 20 20 20 20 7d 0a 09 20 20 20 20 6c 61 73 73 69 }.. lassi
13a90 67 6e 20 5b 6c 72 61 6e 67 65 20 24 61 72 67 75 gn [lrange $argu
13aa0 6d 65 6e 74 73 20 30 20 31 5d 20 6e 61 6d 65 20 ments 0 1] name
13ab0 76 61 6c 75 65 0a 09 20 20 20 20 69 66 20 7b 20 value.. if {
13ac0 5b 72 65 67 65 78 70 20 7b 28 2e 2a 29 3d 28 2e [regexp {(.*)=(.
13ad0 2a 29 7d 20 24 6e 61 6d 65 20 7b 7d 20 6e 61 6d *)} $name {} nam
13ae0 65 20 76 61 6c 75 65 5d 20 7d 20 7b 0a 09 09 73 e value] } {...s
13af0 65 74 20 68 61 73 5f 61 74 74 5f 76 61 6c 75 65 et has_att_value
13b00 20 31 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 1.. } else {
13b10 0a 09 09 73 65 74 20 68 61 73 5f 61 74 74 5f 76 ...set has_att_v
13b20 61 6c 75 65 20 30 0a 09 20 20 20 20 7d 0a 09 20 alue 0.. }..
13b30 20 20 20 69 66 20 7b 20 5b 69 6e 66 6f 20 65 78 if { [info ex
13b40 69 73 74 73 20 6f 70 74 73 5f 76 61 6c 75 65 28 ists opts_value(
13b50 24 6e 61 6d 65 29 5d 20 7d 20 7b 0a 09 09 69 66 $name)] } {...if
13b60 20 7b 20 24 68 61 73 5f 61 74 74 5f 76 61 6c 75 { $has_att_valu
13b70 65 20 7d 20 7b 0a 09 09 20 20 20 20 73 65 74 20 e } {... set
13b80 6f 70 74 73 28 24 6e 61 6d 65 29 20 24 76 61 6c opts($name) $val
13b90 75 65 0a 09 09 20 20 20 20 73 65 74 20 61 72 67 ue... set arg
13ba0 75 6d 65 6e 74 73 20 5b 6c 72 61 6e 67 65 20 24 uments [lrange $
13bb0 61 72 67 75 6d 65 6e 74 73 20 31 20 65 6e 64 5d arguments 1 end]
13bc0 0a 09 09 7d 20 65 6c 73 65 69 66 20 7b 20 24 6f ...} elseif { $o
13bd0 70 74 73 5f 76 61 6c 75 65 28 24 6e 61 6d 65 29 pts_value($name)
13be0 20 65 71 20 22 22 20 7d 20 7b 0a 09 09 20 20 20 eq "" } {...
13bf0 20 73 65 74 20 6f 70 74 73 28 24 6e 61 6d 65 29 set opts($name)
13c00 20 31 0a 09 09 20 20 20 20 73 65 74 20 61 72 67 1... set arg
13c10 75 6d 65 6e 74 73 20 5b 6c 72 61 6e 67 65 20 24 uments [lrange $
13c20 61 72 67 75 6d 65 6e 74 73 20 31 20 65 6e 64 5d arguments 1 end]
13c30 0a 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 ...} else {...
13c40 20 20 73 65 74 20 6f 70 74 73 28 24 6e 61 6d 65 set opts($name
13c50 29 20 24 76 61 6c 75 65 0a 09 09 20 20 20 20 73 ) $value... s
13c60 65 74 20 61 72 67 75 6d 65 6e 74 73 20 5b 6c 72 et arguments [lr
13c70 61 6e 67 65 20 24 61 72 67 75 6d 65 6e 74 73 20 ange $arguments
13c80 32 20 65 6e 64 5d 0a 09 09 7d 0a 09 20 20 20 20 2 end]...}..
13c90 7d 20 65 6c 73 65 20 7b 0a 09 09 75 70 6c 65 76 } else {...uplev
13ca0 65 6c 20 31 20 5b 6c 69 73 74 20 65 72 72 6f 72 el 1 [list error
13cb0 20 5b 5f 70 61 72 73 65 5f 61 72 67 73 5f 73 74 [_parse_args_st
13cc0 72 69 6e 67 20 24 63 6d 64 6e 61 6d 65 20 24 6f ring $cmdname $o
13cd0 70 74 69 6f 6e 61 6c 20 5c 0a 09 09 20 20 20 20 ptional \...
13ce0 20 20 20 20 20 20 20 20 24 63 6f 6d 70 75 6c 73 $compuls
13cf0 6f 72 79 20 24 61 72 67 75 6d 65 6e 74 73 5d 5d ory $arguments]]
13d00 0a 09 09 72 65 74 75 72 6e 20 22 22 0a 09 20 20 ...return ""..
13d10 20 20 7d 0a 09 7d 0a 09 69 66 20 7b 20 24 72 61 }..}..if { $ra
13d20 69 73 65 5f 63 6f 6d 70 75 6c 73 6f 72 79 5f 65 ise_compulsory_e
13d30 72 72 6f 72 20 7d 20 7b 0a 09 20 20 20 20 69 66 rror } {.. if
13d40 20 7b 20 24 63 6f 6d 70 75 6c 73 6f 72 79 5f 6d { $compulsory_m
13d50 69 6e 20 6e 65 20 22 22 20 7d 20 7b 0a 09 09 69 in ne "" } {...i
13d60 66 20 7b 20 5b 6c 6c 65 6e 67 74 68 20 24 61 72 f { [llength $ar
13d70 67 75 6d 65 6e 74 73 5d 20 3c 20 24 63 6f 6d 70 guments] < $comp
13d80 75 6c 73 6f 72 79 5f 6d 69 6e 20 7c 7c 20 5c 0a ulsory_min || \.
13d90 09 09 20 20 20 20 5b 6c 6c 65 6e 67 74 68 20 24 .. [llength $
13da0 61 72 67 75 6d 65 6e 74 73 5d 20 3e 20 5b 6c 6c arguments] > [ll
13db0 65 6e 67 74 68 20 24 63 6f 6d 70 75 6c 73 6f 72 ength $compulsor
13dc0 79 5d 20 7d 20 7b 0a 09 09 20 20 20 20 75 70 6c y] } {... upl
13dd0 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 65 72 72 evel 1 [list err
13de0 6f 72 20 5b 5f 70 61 72 73 65 5f 61 72 67 73 5f or [_parse_args_
13df0 73 74 72 69 6e 67 20 24 63 6d 64 6e 61 6d 65 20 string $cmdname
13e00 24 6f 70 74 69 6f 6e 61 6c 20 24 63 6f 6d 70 75 $optional $compu
13e10 6c 73 6f 72 79 20 24 61 72 67 75 6d 65 6e 74 73 lsory $arguments
13e20 5d 5d 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 ]]... return
13e30 22 22 0a 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c ""...}.. } el
13e40 73 65 69 66 20 7b 20 5b 6c 6c 65 6e 67 74 68 20 seif { [llength
13e50 24 61 72 67 75 6d 65 6e 74 73 5d 20 21 3d 20 5b $arguments] != [
13e60 6c 6c 65 6e 67 74 68 20 24 63 6f 6d 70 75 6c 73 llength $compuls
13e70 6f 72 79 5d 20 7d 20 7b 0a 09 09 75 70 6c 65 76 ory] } {...uplev
13e80 65 6c 20 31 20 5b 6c 69 73 74 20 65 72 72 6f 72 el 1 [list error
13e90 20 5b 5f 70 61 72 73 65 5f 61 72 67 73 5f 73 74 [_parse_args_st
13ea0 72 69 6e 67 20 24 63 6d 64 6e 61 6d 65 20 24 6f ring $cmdname $o
13eb0 70 74 69 6f 6e 61 6c 20 5c 0a 09 09 20 20 20 20 ptional \...
13ec0 20 20 20 20 20 20 20 20 24 63 6f 6d 70 75 6c 73 $compuls
13ed0 6f 72 79 20 24 61 72 67 75 6d 65 6e 74 73 5d 5d ory $arguments]]
13ee0 0a 09 09 72 65 74 75 72 6e 20 22 22 0a 09 20 20 ...return ""..
13ef0 20 20 7d 0a 09 20 20 20 20 0a 09 7d 0a 09 66 6f }.. ..}..fo
13f00 72 65 61 63 68 20 6e 61 6d 65 20 5b 61 72 72 61 reach name [arra
13f10 79 20 6e 61 6d 65 73 20 6f 70 74 73 5d 20 7b 0a y names opts] {.
13f20 09 20 20 20 20 75 70 6c 65 76 65 6c 20 31 20 5b . uplevel 1 [
13f30 6c 69 73 74 20 73 65 74 20 5b 73 74 72 69 6e 67 list set [string
13f40 20 74 72 69 6d 6c 65 66 74 20 24 6e 61 6d 65 20 trimleft $name
13f50 2d 5d 20 24 6f 70 74 73 28 24 6e 61 6d 65 29 5d -] $opts($name)]
13f60 0a 09 7d 0a 09 73 65 74 20 69 6e 75 6d 20 30 0a ..}..set inum 0.
13f70 09 66 6f 72 65 61 63 68 20 69 20 24 63 6f 6d 70 .foreach i $comp
13f80 75 6c 73 6f 72 79 20 7b 0a 09 20 20 20 20 75 70 ulsory {.. up
13f90 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 73 65 level 1 [list se
13fa0 74 20 24 69 20 5b 6c 69 6e 64 65 78 20 24 61 72 t $i [lindex $ar
13fb0 67 75 6d 65 6e 74 73 20 24 69 6e 75 6d 5d 5d 0a guments $inum]].
13fc0 09 20 20 20 20 69 6e 63 72 20 69 6e 75 6d 0a 09 . incr inum..
13fd0 7d 0a 09 72 65 74 75 72 6e 20 5b 6c 72 61 6e 67 }..return [lrang
13fe0 65 20 24 61 72 67 75 6d 65 6e 74 73 20 24 69 6e e $arguments $in
13ff0 75 6d 20 65 6e 64 5d 0a 20 20 20 20 7d 0a 20 20 um end]. }.
14000 20 20 70 72 6f 63 20 3a 3a 5f 70 61 72 73 65 5f proc ::_parse_
14010 61 72 67 73 5f 73 74 72 69 6e 67 20 7b 20 63 6d args_string { cm
14020 64 20 6f 70 74 69 6f 6e 61 6c 20 63 6f 6d 70 75 d optional compu
14030 6c 73 6f 72 79 20 61 72 67 75 6d 65 6e 74 73 20 lsory arguments
14040 7d 20 7b 0a 09 0a 09 73 65 74 20 73 74 72 20 22 } {....set str "
14050 65 72 72 6f 72 2e 20 75 73 61 67 65 3a 20 24 63 error. usage: $c
14060 6d 64 20 22 0a 09 66 6f 72 65 61 63 68 20 69 20 md "..foreach i
14070 24 6f 70 74 69 6f 6e 61 6c 20 7b 0a 09 20 20 20 $optional {..
14080 20 66 6f 72 65 61 63 68 20 22 6e 61 6d 65 20 6e foreach "name n
14090 61 6d 65 76 61 6c 75 65 20 64 65 66 61 75 6c 74 amevalue default
140a0 22 20 24 69 20 62 72 65 61 6b 0a 09 20 20 20 20 " $i break..
140b0 61 70 70 65 6e 64 20 73 74 72 20 22 3f 24 6e 61 append str "?$na
140c0 6d 65 20 24 6e 61 6d 65 76 61 6c 75 65 3f 20 22 me $namevalue? "
140d0 0a 09 7d 0a 09 61 70 70 65 6e 64 20 73 74 72 20 ..}..append str
140e0 24 63 6f 6d 70 75 6c 73 6f 72 79 0a 09 61 70 70 $compulsory..app
140f0 65 6e 64 20 73 74 72 20 22 5c 6e 5c 74 61 72 67 end str "\n\targ
14100 73 3a 20 24 61 72 67 75 6d 65 6e 74 73 22 0a 09 s: $arguments"..
14110 72 65 74 75 72 6e 20 24 73 74 72 0a 20 20 20 20 return $str.
14120 7d 0a 7d 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a }.}.............
14130 0a 0a 0a 0a 0a 0a 0a .......