Hex Artifact Content
Not logged in

Artifact d480935465f467affc54b1bf34320ef2e3c547cc:


0000: 23 20 43 6f 70 79 72 69 67 68 74 20 28 43 29 20  # Copyright (C) 
0010: 32 30 30 36 2d 32 30 31 30 2c 20 54 72 65 76 6f  2006-2010, Trevo
0020: 72 20 44 61 76 65 6c 20 3c 74 77 79 6c 69 74 65  r Davel <twylite
0030: 20 41 54 20 63 72 79 70 74 20 44 4f 54 20 63 6f   AT crypt DOT co
0040: 20 44 4f 54 20 7a 61 3e 0d 0a 23 0d 0a 23 20 53   DOT za>..#..# S
0050: 65 65 20 74 68 65 20 66 69 6c 65 20 22 4c 49 43  ee the file "LIC
0060: 45 4e 53 45 2e 74 78 74 22 20 28 54 63 6c 2f 54  ENSE.txt" (Tcl/T
0070: 6b 20 4c 69 63 65 6e 73 65 29 20 66 6f 72 20 69  k License) for i
0080: 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 75 73  nformation on us
0090: 61 67 65 20 61 6e 64 0d 0a 23 20 72 65 64 69 73  age and..# redis
00a0: 74 72 69 62 75 74 69 6f 6e 20 6f 66 20 74 68 69  tribution of thi
00b0: 73 20 66 69 6c 65 2c 20 61 6e 64 20 66 6f 72 20  s file, and for 
00c0: 61 20 44 49 53 43 4c 41 49 4d 45 52 20 4f 46 20  a DISCLAIMER OF 
00d0: 41 4c 4c 20 57 41 52 52 41 4e 54 49 45 53 2e 0d  ALL WARRANTIES..
00e0: 0a 0d 0a 23 20 41 20 6d 65 63 68 61 6e 69 73 6d  ...# A mechanism
00f0: 20 74 6f 20 61 73 73 6f 63 69 61 74 65 20 70 72   to associate pr
0100: 6f 70 65 72 74 69 65 73 20 28 76 61 72 69 61 62  operties (variab
0110: 6c 65 73 29 20 77 69 74 68 20 61 20 54 6b 20 77  les) with a Tk w
0120: 69 6e 64 6f 77 2e 0d 0a 23 0d 0a 23 20 44 4f 43  indow...#..# DOC
0130: 55 4d 45 4e 54 41 54 49 4f 4e 0d 0a 23 0d 0a 23  UMENTATION..#..#
0140: 20 53 65 65 20 68 74 74 70 3a 2f 2f 64 65 76 2e   See http://dev.
0150: 63 72 79 70 74 2e 63 6f 2e 7a 61 2f 69 6e 63 75  crypt.co.za/incu
0160: 62 61 74 6f 72 2f 64 6f 63 2f 74 63 6c 74 6d 2f  bator/doc/tcltm/
0170: 74 6b 2f 77 70 72 6f 70 2e 77 69 6b 69 0d 0a 23  tk/wprop.wiki..#
0180: 20 66 6f 72 20 64 6f 63 75 6d 65 6e 74 61 74 69   for documentati
0190: 6f 6e 20 61 6e 64 20 45 58 41 4d 50 4c 45 20 4f  on and EXAMPLE O
01a0: 46 20 55 53 45 2e 0d 0a 23 0d 0a 23 20 44 45 53  F USE...#..# DES
01b0: 49 47 4e 20 4e 4f 54 45 53 0d 0a 23 0d 0a 23 20  IGN NOTES..#..# 
01c0: 2d 20 49 6e 74 65 6e 74 69 6f 6e 20 69 73 20 74  - Intention is t
01d0: 6f 20 61 73 73 6f 63 69 61 74 65 20 75 73 65 72  o associate user
01e0: 2d 64 65 66 69 6e 65 64 20 70 72 6f 70 65 72 74  -defined propert
01f0: 69 65 73 20 77 69 74 68 20 61 20 54 6b 20 77 69  ies with a Tk wi
0200: 6e 64 6f 77 20 61 6e 64 20 61 6c 6c 6f 77 0d 0a  ndow and allow..
0210: 23 20 20 20 70 72 6f 70 65 72 74 69 65 73 20 76  #   properties v
0220: 61 6c 75 65 73 20 74 6f 20 62 65 20 73 65 74 20  alues to be set 
0230: 61 6e 64 20 72 65 74 72 69 65 76 65 64 2e 0d 0a  and retrieved...
0240: 23 20 2d 20 53 68 6f 75 6c 64 20 61 6c 73 6f 20  # - Should also 
0250: 70 72 6f 76 69 64 65 20 61 20 6d 65 63 68 61 6e  provide a mechan
0260: 69 73 6d 20 74 6f 20 72 65 76 65 61 6c 20 74 68  ism to reveal th
0270: 65 20 75 6e 64 65 72 6c 79 69 6e 67 20 76 61 72  e underlying var
0280: 69 61 62 6c 65 20 6e 61 6d 65 20 66 6f 72 20 0d  iable name for .
0290: 0a 23 20 20 20 75 73 65 20 77 69 74 68 20 2d 74  .#   use with -t
02a0: 65 78 74 76 61 72 69 61 62 6c 65 2c 20 74 72 61  extvariable, tra
02b0: 63 65 73 2c 20 65 74 63 2e 0d 0a 23 20 2d 20 42  ces, etc...# - B
02c0: 69 6e 64 73 20 74 6f 20 3c 44 65 73 74 72 6f 79  inds to <Destroy
02d0: 3e 20 74 6f 20 66 72 65 65 20 75 70 20 61 6c 6c  > to free up all
02e0: 20 70 72 6f 70 65 72 74 69 65 73 20 61 73 73 6f   properties asso
02f0: 63 69 61 74 65 64 20 77 69 74 68 20 61 20 77 69  ciated with a wi
0300: 6e 64 6f 77 2e 0d 0a 23 20 2d 20 41 50 49 20 72  ndow...# - API r
0310: 65 77 6f 72 6b 65 64 20 74 6f 20 66 65 65 6c 20  eworked to feel 
0320: 6d 6f 72 65 20 6c 69 6b 65 20 5b 64 69 63 74 5d  more like [dict]
0330: 0d 0a 23 0d 0a 23 20 49 4d 50 4c 45 4d 45 4e 54  ..#..# IMPLEMENT
0340: 41 54 49 4f 4e 20 4e 4f 54 45 53 0d 0a 23 0d 0a  ATION NOTES..#..
0350: 23 20 2d 20 56 61 72 69 61 62 6c 65 73 20 61 72  # - Variables ar
0360: 65 20 73 74 6f 72 65 64 20 69 6e 20 61 72 72 61  e stored in arra
0370: 79 73 20 69 6e 20 74 68 65 20 3a 3a 77 70 72 6f  ys in the ::wpro
0380: 70 20 6e 61 6d 65 73 70 61 63 65 2e 0d 0a 23 20  p namespace...# 
0390: 2d 20 45 61 63 68 20 61 72 72 61 79 20 63 6f 6e  - Each array con
03a0: 74 61 69 6e 73 20 74 68 65 20 70 72 6f 70 65 72  tains the proper
03b0: 74 69 65 73 20 66 6f 72 20 6f 6e 6c 79 20 6f 6e  ties for only on
03c0: 65 20 77 69 6e 64 6f 77 2c 20 61 6e 64 20 69 73  e window, and is
03d0: 20 6e 61 6d 65 64 0d 0a 23 20 20 20 61 66 74 65   named..#   afte
03e0: 72 20 74 68 65 20 77 69 6e 64 6f 77 27 73 20 69  r the window's i
03f0: 64 2e 0d 0a 23 20 2d 20 54 68 65 20 77 69 6e 64  d...# - The wind
0400: 6f 77 27 73 20 69 64 20 69 73 20 75 73 65 64 20  ow's id is used 
0410: 61 73 20 74 68 65 20 61 72 72 61 79 20 6e 61 6d  as the array nam
0420: 65 20 74 6f 20 6d 61 6b 65 20 65 72 72 6f 72 20  e to make error 
0430: 68 61 6e 64 6c 69 6e 67 20 0d 0a 23 20 20 20 63  handling ..#   c
0440: 6f 6e 73 69 73 74 65 6e 74 2e 20 20 53 69 6e 63  onsistent.  Sinc
0450: 65 20 63 6c 65 61 6e 75 70 20 69 73 20 62 6f 75  e cleanup is bou
0460: 6e 64 20 74 6f 20 61 20 77 69 6e 64 6f 77 20 65  nd to a window e
0470: 76 65 6e 74 2c 20 77 65 20 63 61 6e 20 6f 6e 6c  vent, we can onl
0480: 79 20 61 74 74 61 63 68 0d 0a 23 20 20 20 70 72  y attach..#   pr
0490: 6f 70 65 72 74 69 65 73 20 74 6f 20 77 69 6e 64  operties to wind
04a0: 6f 77 73 2c 20 73 6f 20 65 76 65 72 79 74 68 69  ows, so everythi
04b0: 6e 67 20 6d 75 73 74 20 63 68 65 63 6b 20 74 68  ng must check th
04c0: 61 74 20 70 61 74 68 4e 61 6d 65 20 69 73 20 61  at pathName is a
04d0: 20 77 69 6e 64 6f 77 0d 0a 23 20 20 20 61 72 65   window..#   are
04e0: 20 72 65 74 75 72 6e 20 61 6e 20 61 70 70 72 6f   return an appro
04f0: 70 72 69 61 74 65 20 65 72 72 6f 72 20 6f 74 68  priate error oth
0500: 65 72 77 69 73 65 2e 20 20 55 73 69 6e 67 20 5b  erwise.  Using [
0510: 77 69 6e 66 6f 20 69 64 5d 20 6d 61 6b 65 73 20  winfo id] makes 
0520: 74 68 69 73 0d 0a 23 20 20 20 63 68 65 63 6b 69  this..#   checki
0530: 6e 67 20 61 6e 64 20 65 72 72 6f 72 20 72 65 70  ng and error rep
0540: 6f 72 74 69 6e 67 20 73 6f 6d 65 20 65 6c 73 65  orting some else
0550: 27 73 20 70 72 6f 62 6c 65 6d 2e 0d 0a 23 20 2d  's problem...# -
0560: 20 41 20 63 6c 65 61 6e 75 70 20 73 63 72 69 70   A cleanup scrip
0570: 74 20 69 73 20 62 6f 75 6e 64 20 74 6f 20 74 68  t is bound to th
0580: 65 20 77 69 6e 64 6f 77 27 73 20 3c 44 65 73 74  e window's <Dest
0590: 72 6f 79 3e 20 65 76 65 6e 74 20 74 6f 20 65 6e  roy> event to en
05a0: 73 75 72 65 20 74 68 61 74 0d 0a 23 20 20 20 61  sure that..#   a
05b0: 73 73 6f 63 69 61 74 65 64 20 70 72 6f 70 65 72  ssociated proper
05c0: 74 69 65 73 20 61 72 65 20 64 65 6c 65 74 65 64  ties are deleted
05d0: 2e 20 20 54 6f 20 70 72 65 76 65 6e 74 20 63 6f  .  To prevent co
05e0: 6e 66 6c 69 63 74 20 77 69 74 68 20 6f 74 68 65  nflict with othe
05f0: 72 20 73 63 72 69 70 74 73 0d 0a 23 20 20 20 75  r scripts..#   u
0600: 73 69 6e 67 20 3c 44 65 73 74 72 6f 79 3e 20 74  sing <Destroy> t
0610: 68 65 20 77 69 6e 64 6f 77 20 69 73 20 74 61 67  he window is tag
0620: 67 65 64 20 61 6e 64 20 77 65 20 62 69 6e 64 20  ged and we bind 
0630: 74 6f 20 74 68 65 20 74 61 67 2e 0d 0a 23 0d 0a  to the tag...#..
0640: 23 20 4b 4e 4f 57 4e 20 49 53 53 55 45 53 0d 0a  # KNOWN ISSUES..
0650: 23 0d 0a 23 20 53 65 65 20 68 74 74 70 3a 2f 2f  #..# See http://
0660: 64 65 76 2e 63 72 79 70 74 2e 63 6f 2e 7a 61 2f  dev.crypt.co.za/
0670: 69 6e 63 75 62 61 74 6f 72 2f 64 6f 63 2f 74 63  incubator/doc/tc
0680: 6c 74 6d 2f 74 6b 2f 77 70 72 6f 70 2e 77 69 6b  ltm/tk/wprop.wik
0690: 69 0d 0a 23 0d 0a 23 20 44 45 42 55 47 47 49 4e  i..#..# DEBUGGIN
06a0: 47 0d 0a 23 20 2d 20 53 6f 6d 65 20 75 73 65 66  G..# - Some usef
06b0: 75 6c 20 64 65 62 75 67 67 69 6e 67 20 63 6f 6d  ul debugging com
06c0: 6d 61 6e 64 73 3a 0d 0a 23 20 20 20 69 6e 66 6f  mands:..#   info
06d0: 20 76 61 72 73 20 3a 3a 77 70 72 6f 70 3a 3a 30   vars ::wprop::0
06e0: 78 2a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  x*              
06f0: 20 3b 23 20 6c 69 73 74 20 6f 66 20 61 6c 6c 20   ;# list of all 
0700: 70 72 6f 70 65 72 74 69 65 73 20 61 72 72 61 79  properties array
0710: 73 0d 0a 23 20 20 20 77 69 6e 66 6f 20 70 61 74  s..#   winfo pat
0720: 68 6e 61 6d 65 20 30 78 30 30 30 34 30 34 30 34  hname 0x00040404
0730: 20 20 20 20 20 20 20 20 20 20 20 3b 23 20 66 69             ;# fi
0740: 6e 64 20 77 69 6e 64 6f 77 20 70 61 74 68 20 66  nd window path f
0750: 72 6f 6d 20 61 72 72 61 79 20 28 77 69 6e 20 69  rom array (win i
0760: 64 29 0d 0a 23 20 20 20 61 72 72 61 79 20 6e 61  d)..#   array na
0770: 6d 65 73 20 3a 3a 77 70 72 6f 70 3a 3a 30 78 30  mes ::wprop::0x0
0780: 30 30 34 30 34 30 34 20 20 20 20 20 20 3b 23 20  0040404      ;# 
0790: 6c 69 73 74 20 61 6c 6c 20 70 72 6f 70 65 72 74  list all propert
07a0: 79 20 6e 61 6d 65 73 20 66 6f 72 20 61 20 77 69  y names for a wi
07b0: 6e 64 6f 77 0d 0a 23 20 20 20 61 72 72 61 79 20  ndow..#   array 
07c0: 6e 61 6d 65 73 20 3a 3a 77 70 72 6f 70 3a 3a 5b  names ::wprop::[
07d0: 77 69 6e 66 6f 20 69 64 20 2e 77 69 6e 5d 20 3b  winfo id .win] ;
07e0: 23 20 6c 69 73 74 20 61 6c 6c 20 70 72 6f 70 65  # list all prope
07f0: 72 74 79 20 6e 61 6d 65 73 20 66 6f 72 20 61 20  rty names for a 
0800: 77 69 6e 64 6f 77 0d 0a 20 0d 0a 0d 0a 6e 61 6d  window.. ....nam
0810: 65 73 70 61 63 65 20 65 76 61 6c 20 3a 3a 77 70  espace eval ::wp
0820: 72 6f 70 20 7b 0d 0a 0d 0a 20 20 73 65 74 20 57  rop {....  set W
0830: 49 4e 44 4f 57 5f 54 41 47 20 22 77 70 72 6f 70  INDOW_TAG "wprop
0840: 22 0d 0a 0d 0a 20 20 23 20 52 65 6d 6f 76 65 20  "....  # Remove 
0850: 70 72 6f 70 65 72 74 69 65 73 20 61 72 72 61 79  properties array
0860: 20 77 68 65 6e 20 74 68 65 20 77 69 6e 64 6f 77   when the window
0870: 20 69 73 20 64 65 73 74 72 6f 79 65 64 2e 0d 0a   is destroyed...
0880: 20 20 62 69 6e 64 20 24 57 49 4e 44 4f 57 5f 54    bind $WINDOW_T
0890: 41 47 20 3c 44 65 73 74 72 6f 79 3e 20 7b 20 0d  AG <Destroy> { .
08a0: 0a 20 20 20 20 61 72 72 61 79 20 75 6e 73 65 74  .    array unset
08b0: 20 5b 6e 61 6d 65 73 70 61 63 65 20 63 75 72 72   [namespace curr
08c0: 65 6e 74 5d 3a 3a 25 69 20 0d 0a 20 20 20 20 63  ent]::%i ..    c
08d0: 6f 6e 74 69 6e 75 65 20 0d 0a 20 20 7d 0d 0a 0d  ontinue ..  }...
08e0: 0a 20 20 23 2a 2a 20 3a 3a 77 70 72 6f 70 3a 3a  .  #** ::wprop::
08f0: 5f 74 61 67 5f 66 6f 72 5f 63 6c 65 61 6e 75 70  _tag_for_cleanup
0900: 20 70 61 74 68 4e 61 6d 65 0d 0a 20 20 23 20 42   pathName..  # B
0910: 69 6e 64 20 61 20 74 61 67 20 74 6f 20 61 20 77  ind a tag to a w
0920: 69 6e 64 6f 77 20 73 6f 20 74 68 61 74 20 77 65  indow so that we
0930: 20 63 61 6e 20 68 6f 6f 6b 20 74 68 65 20 3c 44   can hook the <D
0940: 65 73 74 72 6f 79 3e 20 65 76 65 6e 74 2e 0d 0a  estroy> event...
0950: 20 20 23 20 54 68 65 20 77 69 6e 64 6f 77 20 6d    # The window m
0960: 75 73 74 20 65 78 69 73 74 2e 0d 0a 20 20 23 20  ust exist...  # 
0970: 52 65 74 75 72 6e 73 20 6e 6f 74 68 69 6e 67 2e  Returns nothing.
0980: 0d 0a 20 20 70 72 6f 63 20 5f 74 61 67 5f 66 6f  ..  proc _tag_fo
0990: 72 5f 63 6c 65 61 6e 75 70 20 7b 70 61 74 68 4e  r_cleanup {pathN
09a0: 61 6d 65 7d 20 7b 0d 0a 20 20 20 20 76 61 72 69  ame} {..    vari
09b0: 61 62 6c 65 20 57 49 4e 44 4f 57 5f 54 41 47 0d  able WINDOW_TAG.
09c0: 0a 20 20 20 20 73 65 74 20 74 61 67 73 20 5b 62  .    set tags [b
09d0: 69 6e 64 74 61 67 73 20 24 70 61 74 68 4e 61 6d  indtags $pathNam
09e0: 65 5d 0d 0a 20 20 20 20 69 66 20 7b 20 24 57 49  e]..    if { $WI
09f0: 4e 44 4f 57 5f 54 41 47 20 6e 69 20 24 74 61 67  NDOW_TAG ni $tag
0a00: 73 20 7d 20 7b 0d 0a 20 20 20 20 20 20 62 69 6e  s } {..      bin
0a10: 64 74 61 67 73 20 24 70 61 74 68 4e 61 6d 65 20  dtags $pathName 
0a20: 5b 63 6f 6e 63 61 74 20 24 74 61 67 73 20 5b 6c  [concat $tags [l
0a30: 69 73 74 20 24 57 49 4e 44 4f 57 5f 54 41 47 5d  ist $WINDOW_TAG]
0a40: 5d 0d 0a 20 20 20 20 7d 0d 0a 20 20 20 20 72 65  ]..    }..    re
0a50: 74 75 72 6e 20 7b 7d 0d 0a 20 20 7d 0d 0a 20 20  turn {}..  }..  
0a60: 0d 0a 0d 0a 20 20 23 2a 2a 20 3a 3a 77 70 72 6f  ....  #** ::wpro
0a70: 70 20 76 61 72 69 61 62 6c 65 20 70 61 74 68 4e  p variable pathN
0a80: 61 6d 65 20 6b 65 79 0d 0a 20 20 23 20 52 65 74  ame key..  # Ret
0a90: 75 72 6e 73 20 74 68 65 20 66 75 6c 6c 79 20 71  urns the fully q
0aa0: 75 61 6c 69 66 69 65 64 20 76 61 72 69 61 62 6c  ualified variabl
0ab0: 65 20 6e 61 6d 65 20 66 6f 72 20 61 20 70 72 6f  e name for a pro
0ac0: 70 65 72 74 79 2e 20 20 45 6e 73 75 72 65 73 20  perty.  Ensures 
0ad0: 74 68 61 74 20 61 0d 0a 20 20 23 20 63 6c 65 61  that a..  # clea
0ae0: 6e 75 70 20 68 6f 6f 6b 20 69 73 20 62 6f 75 6e  nup hook is boun
0af0: 64 20 74 6f 20 74 68 65 20 77 69 6e 64 6f 77 2e  d to the window.
0b00: 0d 0a 20 20 23 20 55 73 65 20 77 69 74 68 20 2d  ..  # Use with -
0b10: 76 61 72 69 61 62 6c 65 2c 20 2d 74 65 78 74 76  variable, -textv
0b20: 61 72 69 61 62 6c 65 2c 20 5b 76 77 61 69 74 5d  ariable, [vwait]
0b30: 2c 20 65 74 63 2e 0d 0a 20 20 23 20 54 68 65 20  , etc...  # The 
0b40: 77 69 6e 64 6f 77 20 6d 75 73 74 20 65 78 69 73  window must exis
0b50: 74 2e 0d 0a 20 20 70 72 6f 63 20 5f 76 61 72 69  t...  proc _vari
0b60: 61 62 6c 65 20 7b 70 61 74 68 4e 61 6d 65 20 6b  able {pathName k
0b70: 65 79 7d 20 7b 0d 0a 20 20 20 20 23 20 44 45 53  ey} {..    # DES
0b80: 49 47 4e 20 4e 4f 54 45 3a 20 69 66 20 65 78 74  IGN NOTE: if ext
0b90: 65 72 6e 61 6c 20 6c 6f 67 69 63 20 67 65 74 73  ernal logic gets
0ba0: 20 61 20 72 65 66 65 72 65 6e 63 65 20 74 6f 20   a reference to 
0bb0: 74 68 65 20 75 6e 64 65 72 6c 79 69 6e 67 20 0d  the underlying .
0bc0: 0a 20 20 20 20 23 20 76 61 72 69 61 62 6c 65 2c  .    # variable,
0bd0: 20 77 65 20 6d 75 73 74 20 65 6e 73 75 72 65 20   we must ensure 
0be0: 74 68 61 74 20 74 68 65 20 77 69 6e 64 6f 77 20  that the window 
0bf0: 69 73 20 74 61 67 67 65 64 20 66 6f 72 20 6c 61  is tagged for la
0c00: 74 65 72 20 63 6c 65 61 6e 75 70 2c 0d 0a 20 20  ter cleanup,..  
0c10: 20 20 23 20 65 76 65 6e 20 69 66 20 74 68 65 20    # even if the 
0c20: 76 61 72 69 61 62 6c 65 20 64 6f 65 73 6e 27 74  variable doesn't
0c30: 20 65 78 69 73 74 20 72 69 67 68 74 20 6e 6f 77   exist right now
0c40: 2e 0d 0a 20 20 20 20 73 65 74 20 66 71 61 72 72  ...    set fqarr
0c50: 6e 61 6d 65 20 5b 6e 61 6d 65 73 70 61 63 65 20  name [namespace 
0c60: 63 75 72 72 65 6e 74 5d 3a 3a 5b 77 69 6e 66 6f  current]::[winfo
0c70: 20 69 64 20 24 70 61 74 68 4e 61 6d 65 5d 0d 0a   id $pathName]..
0c80: 20 20 20 20 69 66 20 7b 20 21 20 5b 61 72 72 61      if { ! [arra
0c90: 79 20 65 78 69 73 74 73 20 24 66 71 61 72 72 6e  y exists $fqarrn
0ca0: 61 6d 65 5d 20 7d 20 7b 0d 0a 20 20 20 20 20 20  ame] } {..      
0cb0: 5f 74 61 67 5f 66 6f 72 5f 63 6c 65 61 6e 75 70  _tag_for_cleanup
0cc0: 20 24 70 61 74 68 4e 61 6d 65 0d 0a 20 20 20 20   $pathName..    
0cd0: 7d 20 20 0d 0a 20 20 20 20 72 65 74 75 72 6e 20  }  ..    return 
0ce0: 24 7b 66 71 61 72 72 6e 61 6d 65 7d 28 24 7b 6b  ${fqarrname}(${k
0cf0: 65 79 7d 29 20 0d 0a 20 20 7d 0d 0a 0d 0a 0d 0a  ey}) ..  }......
0d00: 20 20 23 2a 2a 20 3a 3a 77 70 72 6f 70 20 73 65    #** ::wprop se
0d10: 74 20 70 61 74 68 4e 61 6d 65 20 6b 65 79 0d 0a  t pathName key..
0d20: 20 20 23 20 53 65 74 73 20 74 68 65 20 76 61 6c    # Sets the val
0d30: 75 65 20 6f 66 20 61 20 70 72 6f 70 65 72 74 79  ue of a property
0d40: 20 6f 66 20 61 20 77 69 6e 64 6f 77 2e 0d 0a 20   of a window... 
0d50: 20 23 20 54 68 65 20 77 69 6e 64 6f 77 20 6d 75   # The window mu
0d60: 73 74 20 65 78 69 73 74 2e 0d 0a 20 20 23 20 52  st exist...  # R
0d70: 65 74 75 72 6e 73 20 74 68 65 20 28 6e 65 77 29  eturns the (new)
0d80: 20 76 61 6c 75 65 2e 0d 0a 20 20 70 72 6f 63 20   value...  proc 
0d90: 5f 73 65 74 20 7b 70 61 74 68 4e 61 6d 65 20 6b  _set {pathName k
0da0: 65 79 20 76 61 6c 75 65 7d 20 7b 0d 0a 20 20 20  ey value} {..   
0db0: 20 23 20 44 45 53 49 47 4e 20 4e 4f 54 45 3a 20   # DESIGN NOTE: 
0dc0: 72 65 75 73 65 20 74 68 65 20 6c 6f 67 69 63 20  reuse the logic 
0dd0: 69 6e 20 5f 76 61 72 69 61 62 6c 65 20 74 6f 20  in _variable to 
0de0: 65 6e 73 75 72 65 20 74 68 61 74 20 74 68 65 20  ensure that the 
0df0: 77 69 6e 64 6f 77 20 69 73 0d 0a 20 20 20 20 23  window is..    #
0e00: 20 74 61 67 67 65 64 20 66 6f 72 20 6c 61 74 65   tagged for late
0e10: 72 20 63 6c 65 61 6e 75 70 2e 0d 0a 20 20 20 20  r cleanup...    
0e20: 73 65 74 20 5b 5f 76 61 72 69 61 62 6c 65 20 24  set [_variable $
0e30: 70 61 74 68 4e 61 6d 65 20 24 6b 65 79 5d 20 24  pathName $key] $
0e40: 76 61 6c 75 65 0d 0a 20 20 7d 0d 0a 0d 0a 20 20  value..  }....  
0e50: 0d 0a 20 20 23 2a 2a 20 3a 3a 77 70 72 6f 70 20  ..  #** ::wprop 
0e60: 67 65 74 20 70 61 74 68 4e 61 6d 65 20 3f 6b 65  get pathName ?ke
0e70: 79 3f 0d 0a 20 20 23 20 52 65 74 75 72 6e 20 74  y?..  # Return t
0e80: 68 65 20 76 61 6c 75 65 20 6f 66 20 61 20 70 72  he value of a pr
0e90: 6f 70 65 72 74 79 20 6f 66 20 61 20 77 69 6e 64  operty of a wind
0ea0: 6f 77 2e 20 20 0d 0a 20 20 23 20 43 61 6c 6c 20  ow.  ..  # Call 
0eb0: 77 69 74 68 6f 75 74 20 61 20 70 72 6f 70 65 72  without a proper
0ec0: 74 79 20 6b 65 79 20 74 6f 20 72 65 74 75 72 6e  ty key to return
0ed0: 20 61 20 64 69 63 74 20 6f 66 20 61 6c 6c 20 70   a dict of all p
0ee0: 72 6f 70 65 72 74 69 65 73 20 61 73 73 6f 63 69  roperties associ
0ef0: 61 74 65 64 0d 0a 20 20 23 20 77 69 74 68 20 74  ated..  # with t
0f00: 68 65 20 77 69 6e 64 6f 77 2e 20 0d 0a 20 20 23  he window. ..  #
0f10: 20 54 68 72 6f 77 73 20 61 6e 20 65 72 72 6f 72   Throws an error
0f20: 20 69 66 20 74 68 65 20 77 69 6e 64 6f 77 20 6f   if the window o
0f30: 72 20 70 72 6f 70 65 72 74 79 20 64 6f 65 73 20  r property does 
0f40: 6e 6f 74 20 65 78 69 73 74 2e 0d 0a 20 20 70 72  not exist...  pr
0f50: 6f 63 20 67 65 74 20 7b 70 61 74 68 4e 61 6d 65  oc get {pathName
0f60: 20 61 72 67 73 7d 20 7b 0d 0a 20 20 20 20 23 20   args} {..    # 
0f70: 44 45 53 49 47 4e 20 4e 4f 54 45 3a 20 69 6e 74  DESIGN NOTE: int
0f80: 65 72 66 61 63 65 20 69 73 20 73 69 6d 69 6c 61  erface is simila
0f90: 72 20 74 6f 20 5b 64 69 63 74 20 67 65 74 5d 20  r to [dict get] 
0fa0: 77 69 74 68 6f 75 74 20 73 75 70 70 6f 72 74 20  without support 
0fb0: 66 6f 72 0d 0a 20 20 20 20 23 20 6e 65 73 74 65  for..    # neste
0fc0: 64 20 64 69 63 74 73 2e 20 20 54 6f 20 65 6e 73  d dicts.  To ens
0fd0: 75 72 65 20 74 68 61 74 20 74 68 65 72 65 20 61  ure that there a
0fe0: 72 65 20 6e 6f 20 72 65 73 65 72 76 65 64 20 6b  re no reserved k
0ff0: 65 79 73 20 77 65 20 68 61 76 65 20 74 6f 0d 0a  eys we have to..
1000: 20 20 20 20 23 20 64 6f 20 61 6e 20 61 72 67 73      # do an args
1010: 20 68 61 63 6b 20 72 61 74 68 65 72 20 74 68 61   hack rather tha
1020: 6e 20 75 73 65 20 61 6e 20 6f 70 74 69 6f 6e 61  n use an optiona
1030: 6c 20 70 61 72 61 6d 65 74 65 72 2e 0d 0a 20 20  l parameter...  
1040: 20 20 73 77 69 74 63 68 20 2d 2d 20 5b 6c 6c 65    switch -- [lle
1050: 6e 67 74 68 20 24 61 72 67 73 5d 20 7b 0d 0a 20  ngth $args] {.. 
1060: 20 20 20 20 20 30 20 7b 0d 0a 20 20 20 20 20 20       0 {..      
1070: 20 20 72 65 74 75 72 6e 20 5b 61 72 72 61 79 20    return [array 
1080: 67 65 74 20 5b 6e 61 6d 65 73 70 61 63 65 20 63  get [namespace c
1090: 75 72 72 65 6e 74 5d 3a 3a 5b 77 69 6e 66 6f 20  urrent]::[winfo 
10a0: 69 64 20 24 70 61 74 68 4e 61 6d 65 5d 5d 0d 0a  id $pathName]]..
10b0: 20 20 20 20 20 20 7d 0d 0a 20 20 20 20 20 20 31        }..      1
10c0: 20 7b 0d 0a 20 20 20 20 20 20 20 20 6c 61 73 73   {..        lass
10d0: 69 67 6e 20 24 61 72 67 73 20 6b 65 79 0d 0a 20  ign $args key.. 
10e0: 20 20 20 20 20 20 20 73 65 74 20 66 71 76 61 72         set fqvar
10f0: 6e 61 6d 65 20 22 5b 6e 61 6d 65 73 70 61 63 65  name "[namespace
1100: 20 63 75 72 72 65 6e 74 5d 3a 3a 5b 77 69 6e 66   current]::[winf
1110: 6f 20 69 64 20 24 70 61 74 68 4e 61 6d 65 5d 28  o id $pathName](
1120: 24 7b 6b 65 79 7d 29 22 0d 0a 20 20 20 20 20 20  ${key})"..      
1130: 20 20 69 66 20 7b 20 21 20 5b 69 6e 66 6f 20 65    if { ! [info e
1140: 78 69 73 74 73 20 24 66 71 76 61 72 6e 61 6d 65  xists $fqvarname
1150: 5d 20 7d 20 7b 0d 0a 20 20 20 20 20 20 20 20 20  ] } {..         
1160: 20 65 72 72 6f 72 20 22 6e 6f 20 70 72 6f 70 65   error "no prope
1170: 72 74 79 20 5c 22 24 6b 65 79 5c 22 20 66 6f 72  rty \"$key\" for
1180: 20 77 69 6e 64 6f 77 20 5c 22 24 70 61 74 68 4e   window \"$pathN
1190: 61 6d 65 5c 22 22 0d 0a 20 20 20 20 20 20 20 20  ame\""..        
11a0: 7d 20 0d 0a 20 20 20 20 20 20 20 20 72 65 74 75  } ..        retu
11b0: 72 6e 20 5b 73 65 74 20 24 66 71 76 61 72 6e 61  rn [set $fqvarna
11c0: 6d 65 5d 0d 0a 20 20 20 20 20 20 7d 0d 0a 20 20  me]..      }..  
11d0: 20 20 20 20 64 65 66 61 75 6c 74 20 7b 0d 0a 20      default {.. 
11e0: 20 20 20 20 20 20 20 65 72 72 6f 72 20 22 77 72         error "wr
11f0: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75  ong # args: shou
1200: 6c 64 20 62 65 20 5c 22 5b 6c 69 6e 64 65 78 20  ld be \"[lindex 
1210: 5b 69 6e 66 6f 20 6c 65 76 65 6c 20 30 5d 20 30  [info level 0] 0
1220: 5d 20 70 61 74 68 4e 61 6d 65 20 3f 6b 65 79 3f  ] pathName ?key?
1230: 5c 22 22 0d 0a 20 20 20 20 20 20 7d 0d 0a 20 20  \""..      }..  
1240: 20 20 7d 0d 0a 20 20 7d 0d 0a 0d 0a 0d 0a 20 20    }..  }......  
1250: 23 2a 2a 20 3a 3a 77 70 72 6f 70 20 65 78 69 73  #** ::wprop exis
1260: 74 73 20 70 61 74 68 4e 61 6d 65 20 6b 65 79 0d  ts pathName key.
1270: 0a 20 20 23 20 52 65 74 75 72 6e 73 20 74 72 75  .  # Returns tru
1280: 65 20 69 66 20 74 68 65 20 70 72 6f 70 65 72 74  e if the propert
1290: 79 20 6b 65 79 20 65 78 69 73 74 73 20 66 6f 72  y key exists for
12a0: 20 74 68 65 20 77 69 6e 64 6f 77 2c 20 6f 72 20   the window, or 
12b0: 66 61 6c 73 65 20 6f 74 68 65 72 77 69 73 65 2e  false otherwise.
12c0: 0d 0a 20 20 23 20 54 68 65 20 77 69 6e 64 6f 77  ..  # The window
12d0: 20 6d 75 73 74 20 65 78 69 73 74 2e 0d 0a 20 20   must exist...  
12e0: 70 72 6f 63 20 65 78 69 73 74 73 20 7b 70 61 74  proc exists {pat
12f0: 68 4e 61 6d 65 20 6b 65 79 7d 20 7b 0d 0a 20 20  hName key} {..  
1300: 20 20 73 65 74 20 66 71 76 61 72 6e 61 6d 65 20    set fqvarname 
1310: 22 5b 6e 61 6d 65 73 70 61 63 65 20 63 75 72 72  "[namespace curr
1320: 65 6e 74 5d 3a 3a 5b 77 69 6e 66 6f 20 69 64 20  ent]::[winfo id 
1330: 24 70 61 74 68 4e 61 6d 65 5d 28 24 7b 6b 65 79  $pathName](${key
1340: 7d 29 22 0d 0a 20 20 20 20 69 6e 66 6f 20 65 78  })"..    info ex
1350: 69 73 74 73 20 24 66 71 76 61 72 6e 61 6d 65 0d  ists $fqvarname.
1360: 0a 20 20 7d 0d 0a 0d 0a 0d 0a 20 20 23 2a 2a 20  .  }......  #** 
1370: 3a 3a 77 70 72 6f 70 20 67 65 74 3f 20 70 61 74  ::wprop get? pat
1380: 68 4e 61 6d 65 20 6b 65 79 0d 0a 20 20 23 20 52  hName key..  # R
1390: 65 74 75 72 6e 73 20 74 68 65 20 76 61 6c 75 65  eturns the value
13a0: 20 6f 66 20 61 20 70 72 6f 70 65 72 74 79 20 6f   of a property o
13b0: 66 20 61 20 77 69 6e 64 6f 77 2c 20 6f 72 20 61  f a window, or a
13c0: 6e 20 65 6d 70 74 79 20 73 74 72 69 6e 67 20 69  n empty string i
13d0: 66 20 74 68 65 0d 0a 20 20 23 20 70 72 6f 70 65  f the..  # prope
13e0: 72 74 79 20 6b 65 79 20 64 6f 65 73 20 6e 6f 74  rty key does not
13f0: 20 65 78 69 73 74 20 66 6f 72 20 74 68 65 20 77   exist for the w
1400: 69 6e 64 6f 77 2e 0d 0a 20 20 23 20 54 68 65 20  indow...  # The 
1410: 77 69 6e 64 6f 77 20 6d 75 73 74 20 65 78 69 73  window must exis
1420: 74 2e 20 0d 0a 20 20 70 72 6f 63 20 67 65 74 3f  t. ..  proc get?
1430: 20 7b 70 61 74 68 4e 61 6d 65 20 6b 65 79 7d 20   {pathName key} 
1440: 7b 0d 0a 20 20 20 20 73 65 74 20 66 71 76 61 72  {..    set fqvar
1450: 6e 61 6d 65 20 22 5b 6e 61 6d 65 73 70 61 63 65  name "[namespace
1460: 20 63 75 72 72 65 6e 74 5d 3a 3a 5b 77 69 6e 66   current]::[winf
1470: 6f 20 69 64 20 24 70 61 74 68 4e 61 6d 65 5d 28  o id $pathName](
1480: 24 7b 6b 65 79 7d 29 22 0d 0a 20 20 20 20 69 66  ${key})"..    if
1490: 20 7b 20 21 20 5b 69 6e 66 6f 20 65 78 69 73 74   { ! [info exist
14a0: 73 20 24 66 71 76 61 72 6e 61 6d 65 5d 20 7d 20  s $fqvarname] } 
14b0: 7b 0d 0a 20 20 20 20 20 20 72 65 74 75 72 6e 20  {..      return 
14c0: 7b 7d 0d 0a 20 20 20 20 7d 0d 0a 20 20 20 20 73  {}..    }..    s
14d0: 65 74 20 24 66 71 76 61 72 6e 61 6d 65 0d 0a 20  et $fqvarname.. 
14e0: 20 7d 0d 0a 0d 0a 0d 0a 20 20 23 2a 2a 20 3a 3a   }......  #** ::
14f0: 77 70 72 6f 70 20 75 6e 73 65 74 20 70 61 74 68  wprop unset path
1500: 4e 61 6d 65 20 3f 6b 65 79 3f 0d 0a 20 20 23 20  Name ?key?..  # 
1510: 44 65 6c 65 74 65 73 20 61 20 70 72 6f 70 65 72  Deletes a proper
1520: 74 79 20 66 72 6f 6d 20 61 20 77 69 6e 64 6f 77  ty from a window
1530: 2e 0d 0a 20 20 23 20 43 61 6c 6c 20 77 69 74 68  ...  # Call with
1540: 6f 75 74 20 61 20 70 72 6f 70 65 72 74 79 20 6b  out a property k
1550: 65 79 20 74 6f 20 64 65 6c 65 74 65 20 61 6c 6c  ey to delete all
1560: 20 70 72 6f 70 65 72 74 69 65 73 20 61 73 73 6f   properties asso
1570: 63 69 61 74 65 64 20 77 69 74 68 20 74 68 65 0d  ciated with the.
1580: 0a 20 20 23 20 77 69 6e 64 6f 77 2e 0d 0a 20 20  .  # window...  
1590: 23 20 54 68 65 20 77 69 6e 64 6f 77 20 6d 75 73  # The window mus
15a0: 74 20 65 78 69 73 74 2e 0d 0a 20 20 23 20 52 65  t exist...  # Re
15b0: 74 75 72 6e 73 20 6e 6f 74 68 69 6e 67 2e 0d 0a  turns nothing...
15c0: 20 20 70 72 6f 63 20 5f 75 6e 73 65 74 20 7b 70    proc _unset {p
15d0: 61 74 68 4e 61 6d 65 20 61 72 67 73 7d 20 7b 0d  athName args} {.
15e0: 0a 20 20 20 20 73 77 69 74 63 68 20 2d 2d 20 5b  .    switch -- [
15f0: 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 20 7b  llength $args] {
1600: 0d 0a 20 20 20 20 20 20 30 20 7b 0d 0a 20 20 20  ..      0 {..   
1610: 20 20 20 20 20 73 65 74 20 66 71 61 72 72 6e 61       set fqarrna
1620: 6d 65 20 5b 6e 61 6d 65 73 70 61 63 65 20 63 75  me [namespace cu
1630: 72 72 65 6e 74 5d 3a 3a 5b 77 69 6e 66 6f 20 69  rrent]::[winfo i
1640: 64 20 24 70 61 74 68 4e 61 6d 65 5d 0d 0a 20 20  d $pathName]..  
1650: 20 20 20 20 20 20 61 72 72 61 79 20 75 6e 73 65        array unse
1660: 74 20 24 66 71 61 72 72 6e 61 6d 65 0d 0a 20 20  t $fqarrname..  
1670: 20 20 20 20 20 20 23 20 44 45 53 49 47 4e 20 4e        # DESIGN N
1680: 4f 54 45 3a 20 64 6f 20 4e 4f 54 20 75 6e 74 61  OTE: do NOT unta
1690: 67 20 74 68 65 20 77 69 6e 64 6f 77 2e 20 20 45  g the window.  E
16a0: 76 65 6e 20 74 68 6f 75 67 68 20 77 65 20 68 61  ven though we ha
16b0: 76 65 20 64 65 6c 65 74 65 64 0d 0a 20 20 20 20  ve deleted..    
16c0: 20 20 20 20 23 20 74 68 65 20 61 72 72 61 79 2c      # the array,
16d0: 20 65 78 74 65 72 6e 61 6c 20 6c 6f 67 69 63 20   external logic 
16e0: 6d 61 79 20 73 74 69 6c 6c 20 68 6f 6c 64 20 64  may still hold d
16f0: 69 72 65 63 74 20 72 65 66 65 72 65 6e 63 65 73  irect references
1700: 20 74 6f 20 61 72 72 61 79 0d 0a 20 20 20 20 20   to array..     
1710: 20 20 20 23 20 76 61 72 69 61 62 6c 65 73 20 61     # variables a
1720: 6e 64 20 63 6f 75 6c 64 20 72 65 63 72 65 61 74  nd could recreat
1730: 65 20 74 68 65 6d 2e 0d 0a 20 20 20 20 20 20 7d  e them...      }
1740: 0d 0a 20 20 20 20 20 20 31 20 7b 0d 0a 20 20 20  ..      1 {..   
1750: 20 20 20 20 20 23 20 44 45 53 49 47 4e 20 4e 4f       # DESIGN NO
1760: 54 45 3a 20 64 6f 20 6e 6f 74 20 75 73 65 20 5b  TE: do not use [
1770: 61 72 72 61 79 20 75 6e 73 65 74 5d 20 68 65 72  array unset] her
1780: 65 2c 20 61 73 20 74 68 61 74 20 77 69 6c 6c 20  e, as that will 
1790: 63 61 75 73 65 20 24 6b 65 79 0d 0a 20 20 20 20  cause $key..    
17a0: 20 20 20 20 23 20 74 6f 20 62 65 20 69 6e 74 65      # to be inte
17b0: 72 70 72 65 74 65 64 20 61 73 20 61 20 70 61 74  rpreted as a pat
17c0: 74 65 72 6e 20 28 75 6e 6c 69 6b 65 20 65 76 65  tern (unlike eve
17d0: 72 79 77 68 65 72 65 20 65 6c 73 65 29 2e 0d 0a  rywhere else)...
17e0: 20 20 20 20 20 20 20 20 6c 61 73 73 69 67 6e 20          lassign 
17f0: 24 61 72 67 73 20 6b 65 79 0d 0a 20 20 20 20 20  $args key..     
1800: 20 20 20 73 65 74 20 66 71 76 61 72 6e 61 6d 65     set fqvarname
1810: 20 22 5b 6e 61 6d 65 73 70 61 63 65 20 63 75 72   "[namespace cur
1820: 72 65 6e 74 5d 3a 3a 5b 77 69 6e 66 6f 20 69 64  rent]::[winfo id
1830: 20 24 70 61 74 68 4e 61 6d 65 5d 28 24 7b 6b 65   $pathName](${ke
1840: 79 7d 29 22 0d 0a 20 20 20 20 20 20 20 20 69 66  y})"..        if
1850: 20 7b 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20   { [info exists 
1860: 24 66 71 76 61 72 6e 61 6d 65 5d 20 7d 20 7b 0d  $fqvarname] } {.
1870: 0a 20 20 20 20 20 20 20 20 20 20 75 6e 73 65 74  .          unset
1880: 20 24 66 71 76 61 72 6e 61 6d 65 0d 0a 20 20 20   $fqvarname..   
1890: 20 20 20 20 20 7d 0d 0a 20 20 20 20 20 20 7d 0d       }..      }.
18a0: 0a 20 20 20 20 20 20 64 65 66 61 75 6c 74 20 7b  .      default {
18b0: 0d 0a 20 20 20 20 20 20 20 20 65 72 72 6f 72 20  ..        error 
18c0: 22 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73  "wrong # args: s
18d0: 68 6f 75 6c 64 20 62 65 20 5c 22 5b 6c 69 6e 64  hould be \"[lind
18e0: 65 78 20 5b 69 6e 66 6f 20 6c 65 76 65 6c 20 30  ex [info level 0
18f0: 5d 20 30 5d 20 70 61 74 68 4e 61 6d 65 20 3f 6b  ] 0] pathName ?k
1900: 65 79 3f 5c 22 22 0d 0a 20 20 20 20 20 20 7d 0d  ey?\""..      }.
1910: 0a 20 20 20 20 7d 0d 0a 20 20 7d 0d 0a 0d 0a 0d  .    }..  }.....
1920: 0a 20 20 23 20 43 72 65 61 74 65 20 74 68 65 20  .  # Create the 
1930: 3a 3a 77 70 72 6f 70 20 65 6e 73 65 6d 62 6c 65  ::wprop ensemble
1940: 0d 0a 20 20 6e 61 6d 65 73 70 61 63 65 20 65 6e  ..  namespace en
1950: 73 65 6d 62 6c 65 20 63 72 65 61 74 65 20 2d 63  semble create -c
1960: 6f 6d 6d 61 6e 64 20 5b 6e 61 6d 65 73 70 61 63  ommand [namespac
1970: 65 20 63 75 72 72 65 6e 74 5d 20 5c 0d 0a 20 20  e current] \..  
1980: 20 20 2d 73 75 62 63 6f 6d 6d 61 6e 64 73 20 7b    -subcommands {
1990: 76 61 72 69 61 62 6c 65 20 73 65 74 20 67 65 74  variable set get
19a0: 20 65 78 69 73 74 73 20 67 65 74 3f 20 75 6e 73   exists get? uns
19b0: 65 74 7d 20 5c 0d 0a 20 20 20 20 2d 6d 61 70 20  et} \..    -map 
19c0: 7b 73 65 74 20 5f 73 65 74 20 75 6e 73 65 74 20  {set _set unset 
19d0: 5f 75 6e 73 65 74 20 76 61 72 69 61 62 6c 65 20  _unset variable 
19e0: 5f 76 61 72 69 61 62 6c 65 7d 0d 0a 0d 0a 7d 0d  _variable}....}.
19f0: 0a                                               .