Artifact 55fa2b68e5792a9475e070b87eb3429e92de3a25:

Attachment "cursor.tcl" to ticket [2082457fff] added by relaxmike 2008-08-29 20:47:27.

---

0000: 23 20 63 75 72 73 6f 72 2e 74 63 6c 20 2d 2d 0d  # cursor.tcl --.
0010: 0a 23 0d 0a 23 20 20 20 20 20 20 20 54 6b 20 63  .#..#       Tk c
0020: 75 72 73 6f 72 20 68 61 6e 64 6c 69 6e 67 20 72  ursor handling r
0030: 6f 75 74 69 6e 65 73 0d 0a 23 0d 0a 23 20 43 6f  outines..#..# Co
0040: 70 79 72 69 67 68 74 20 28 63 29 20 32 30 30 31  pyright (c) 2001
0050: 20 62 79 20 4a 65 66 66 72 65 79 20 48 6f 62 62   by Jeffrey Hobb
0060: 73 0d 0a 23 0d 0a 23 20 53 65 65 20 74 68 65 20  s..#..# See the 
0070: 66 69 6c 65 20 22 6c 69 63 65 6e 73 65 2e 74 65  file "license.te
0080: 72 6d 73 22 20 66 6f 72 20 69 6e 66 6f 72 6d 61  rms" for informa
0090: 74 69 6f 6e 20 6f 6e 20 75 73 61 67 65 20 61 6e  tion on usage an
00a0: 64 20 72 65 64 69 73 74 72 69 62 75 74 69 6f 6e  d redistribution
00b0: 0d 0a 23 20 6f 66 20 74 68 69 73 20 66 69 6c 65  ..# of this file
00c0: 2c 20 61 6e 64 20 66 6f 72 20 61 20 44 49 53 43  , and for a DISC
00d0: 4c 41 49 4d 45 52 20 4f 46 20 41 4c 4c 20 57 41  LAIMER OF ALL WA
00e0: 52 52 41 4e 54 49 45 53 2e 0d 0a 23 20 0d 0a 23  RRANTIES...# ..#
00f0: 20 52 43 53 3a 20 40 28 23 29 20 24 49 64 3a 20   RCS: @(#) $Id: 
0100: 63 75 72 73 6f 72 2e 74 63 6c 2c 76 20 31 2e 32  cursor.tcl,v 1.2
0110: 20 32 30 30 36 2f 31 32 2f 30 38 20 32 33 3a 33   2006/12/08 23:3
0120: 30 3a 33 31 20 68 6f 62 62 73 20 45 78 70 20 24  0:31 hobbs Exp $
0130: 0d 0a 0d 0a 70 61 63 6b 61 67 65 20 72 65 71 75  ....package requ
0140: 69 72 65 20 54 6b 20 38 2e 30 0d 0a 70 61 63 6b  ire Tk 8.0..pack
0150: 61 67 65 20 70 72 6f 76 69 64 65 20 63 75 72 73  age provide curs
0160: 6f 72 20 30 2e 32 0d 0a 0d 0a 6e 61 6d 65 73 70  or 0.2....namesp
0170: 61 63 65 20 65 76 61 6c 20 3a 3a 63 75 72 73 6f  ace eval ::curso
0180: 72 20 7b 0d 0a 20 20 20 20 6e 61 6d 65 73 70 61  r {..    namespa
0190: 63 65 20 65 78 70 6f 72 74 20 70 72 6f 70 61 67  ce export propag
01a0: 61 74 65 20 72 65 73 74 6f 72 65 20 64 69 73 70  ate restore disp
01b0: 6c 61 79 0d 0a 0d 0a 20 20 20 20 76 61 72 69 61  lay....    varia
01c0: 62 6c 65 20 63 75 72 73 6f 72 73 20 5b 6c 69 73  ble cursors [lis
01d0: 74 20 5c 0d 0a 09 20 20 20 20 58 5f 63 75 72 73  t \...    X_curs
01e0: 6f 72 20 61 72 72 6f 77 20 62 61 73 65 64 5f 61  or arrow based_a
01f0: 72 72 6f 77 5f 64 6f 77 6e 20 62 61 73 65 64 5f  rrow_down based_
0200: 61 72 72 6f 77 5f 75 70 20 62 6f 61 74 20 62 6f  arrow_up boat bo
0210: 67 6f 73 69 74 79 20 5c 0d 0a 09 20 20 20 20 62  gosity \...    b
0220: 6f 74 74 6f 6d 5f 6c 65 66 74 5f 63 6f 72 6e 65  ottom_left_corne
0230: 72 20 62 6f 74 74 6f 6d 5f 72 69 67 68 74 5f 63  r bottom_right_c
0240: 6f 72 6e 65 72 20 62 6f 74 74 6f 6d 5f 73 69 64  orner bottom_sid
0250: 65 20 62 6f 74 74 6f 6d 5f 74 65 65 20 5c 0d 0a  e bottom_tee \..
0260: 09 20 20 20 20 62 6f 78 5f 73 70 69 72 61 6c 20  .    box_spiral 
0270: 63 65 6e 74 65 72 5f 70 74 72 20 63 69 72 63 6c  center_ptr circl
0280: 65 20 63 6c 6f 63 6b 20 63 6f 66 66 65 65 5f 6d  e clock coffee_m
0290: 75 67 20 63 72 6f 73 73 20 63 72 6f 73 73 5f 72  ug cross cross_r
02a0: 65 76 65 72 73 65 20 5c 0d 0a 09 20 20 20 20 63  everse \...    c
02b0: 72 6f 73 73 68 61 69 72 20 64 69 61 6d 6f 6e 64  rosshair diamond
02c0: 5f 63 72 6f 73 73 20 64 6f 74 20 64 6f 74 62 6f  _cross dot dotbo
02d0: 78 20 64 6f 75 62 6c 65 5f 61 72 72 6f 77 20 64  x double_arrow d
02e0: 72 61 66 74 5f 6c 61 72 67 65 20 5c 0d 0a 09 20  raft_large \... 
02f0: 20 20 20 64 72 61 66 74 5f 73 6d 61 6c 6c 20 64     draft_small d
0300: 72 61 70 65 64 5f 62 6f 78 20 65 78 63 68 61 6e  raped_box exchan
0310: 67 65 20 66 6c 65 75 72 20 67 6f 62 62 6c 65 72  ge fleur gobbler
0320: 20 67 75 6d 62 79 20 68 61 6e 64 31 20 68 61 6e   gumby hand1 han
0330: 64 32 20 5c 0d 0a 09 20 20 20 20 68 65 61 72 74  d2 \...    heart
0340: 20 69 63 6f 6e 20 69 72 6f 6e 5f 63 72 6f 73 73   icon iron_cross
0350: 20 6c 65 66 74 5f 70 74 72 20 6c 65 66 74 5f 73   left_ptr left_s
0360: 69 64 65 20 6c 65 66 74 5f 74 65 65 20 6c 65 66  ide left_tee lef
0370: 74 62 75 74 74 6f 6e 20 5c 0d 0a 09 20 20 20 20  tbutton \...    
0380: 6c 6c 5f 61 6e 67 6c 65 20 6c 72 5f 61 6e 67 6c  ll_angle lr_angl
0390: 65 20 6d 61 6e 20 6d 69 64 64 6c 65 62 75 74 74  e man middlebutt
03a0: 6f 6e 20 6d 6f 75 73 65 20 70 65 6e 63 69 6c 20  on mouse pencil 
03b0: 70 69 72 61 74 65 20 70 6c 75 73 20 5c 0d 0a 09  pirate plus \...
03c0: 20 20 20 20 71 75 65 73 74 69 6f 6e 5f 61 72 72      question_arr
03d0: 6f 77 20 72 69 67 68 74 5f 70 74 72 20 72 69 67  ow right_ptr rig
03e0: 68 74 5f 73 69 64 65 20 72 69 67 68 74 5f 74 65  ht_side right_te
03f0: 65 20 72 69 67 68 74 62 75 74 74 6f 6e 20 5c 0d  e rightbutton \.
0400: 0a 09 20 20 20 20 72 74 6c 5f 6c 6f 67 6f 20 73  ..    rtl_logo s
0410: 61 69 6c 62 6f 61 74 20 73 62 5f 64 6f 77 6e 5f  ailboat sb_down_
0420: 61 72 72 6f 77 20 73 62 5f 68 5f 64 6f 75 62 6c  arrow sb_h_doubl
0430: 65 5f 61 72 72 6f 77 20 73 62 5f 6c 65 66 74 5f  e_arrow sb_left_
0440: 61 72 72 6f 77 20 5c 0d 0a 09 20 20 20 20 73 62  arrow \...    sb
0450: 5f 72 69 67 68 74 5f 61 72 72 6f 77 20 73 62 5f  _right_arrow sb_
0460: 75 70 5f 61 72 72 6f 77 20 73 62 5f 76 5f 64 6f  up_arrow sb_v_do
0470: 75 62 6c 65 5f 61 72 72 6f 77 20 73 68 75 74 74  uble_arrow shutt
0480: 6c 65 20 73 69 7a 69 6e 67 20 5c 0d 0a 09 20 20  le sizing \...  
0490: 20 20 73 70 69 64 65 72 20 73 70 72 61 79 63 61    spider sprayca
04a0: 6e 20 73 74 61 72 20 74 61 72 67 65 74 20 74 63  n star target tc
04b0: 72 6f 73 73 20 74 6f 70 5f 6c 65 66 74 5f 61 72  ross top_left_ar
04c0: 72 6f 77 20 74 6f 70 5f 6c 65 66 74 5f 63 6f 72  row top_left_cor
04d0: 6e 65 72 20 5c 0d 0a 09 20 20 20 20 74 6f 70 5f  ner \...    top_
04e0: 72 69 67 68 74 5f 63 6f 72 6e 65 72 20 74 6f 70  right_corner top
04f0: 5f 73 69 64 65 20 74 6f 70 5f 74 65 65 20 74 72  _side top_tee tr
0500: 65 6b 20 75 6c 5f 61 6e 67 6c 65 20 75 6d 62 72  ek ul_angle umbr
0510: 65 6c 6c 61 20 5c 0d 0a 09 20 20 20 20 75 72 5f  ella \...    ur_
0520: 61 6e 67 6c 65 20 77 61 74 63 68 20 78 74 65 72  angle watch xter
0530: 6d 20 5c 0d 0a 09 20 20 20 20 5d 0d 0a 0d 0a 20  m \...    ].... 
0540: 20 20 20 73 77 69 74 63 68 20 2d 65 78 61 63 74     switch -exact
0550: 20 24 3a 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d   $::tcl_platform
0560: 28 6f 73 29 20 7b 0d 0a 09 22 77 69 6e 64 6f 77  (os) {..."window
0570: 73 22 20 7b 0d 0a 09 20 20 20 20 6c 61 70 70 65  s" {...    lappe
0580: 6e 64 20 63 75 72 73 6f 72 73 20 6e 6f 20 73 74  nd cursors no st
0590: 61 72 74 69 6e 67 20 73 69 7a 65 20 5c 0d 0a 09  arting size \...
05a0: 09 20 20 20 20 73 69 7a 65 5f 6e 65 5f 73 77 20  .    size_ne_sw 
05b0: 73 69 7a 65 5f 6e 73 20 73 69 7a 65 5f 6e 77 5f  size_ns size_nw_
05c0: 73 65 20 73 69 7a 65 5f 77 65 20 75 70 61 72 72  se size_we uparr
05d0: 6f 77 20 77 61 69 74 0d 0a 09 7d 0d 0a 09 22 6d  ow wait...}..."m
05e0: 61 63 69 6e 74 6f 73 68 22 20 7b 0d 0a 09 20 20  acintosh" {...  
05f0: 20 20 6c 61 70 70 65 6e 64 20 63 75 72 73 6f 72    lappend cursor
0600: 73 20 74 65 78 74 20 63 72 6f 73 73 2d 68 61 69  s text cross-hai
0610: 72 0d 0a 09 7d 0d 0a 09 22 75 6e 69 78 22 20 7b  r...}..."unix" {
0620: 0d 0a 09 20 20 20 20 23 20 6e 6f 20 65 78 74 72  ...    # no extr
0630: 61 20 63 75 72 73 6f 72 73 0d 0a 09 7d 0d 0a 20  a cursors...}.. 
0640: 20 20 20 7d 0d 0a 7d 0d 0a 0d 0a 23 20 3a 3a 63     }..}....# ::c
0650: 75 72 73 6f 72 3a 3a 70 72 6f 70 61 67 61 74 65  ursor::propagate
0660: 20 2d 2d 0d 0a 23 0d 0a 23 09 50 72 6f 70 61 67   --..#..#.Propag
0670: 61 74 65 73 20 61 20 63 75 72 73 6f 72 20 74 6f  ates a cursor to
0680: 20 61 20 77 69 64 67 65 74 20 61 6e 64 20 61 6c   a widget and al
0690: 6c 20 64 65 73 63 65 6e 64 61 6e 74 73 2e 0d 0a  l descendants...
06a0: 23 0d 0a 23 20 41 72 67 75 6d 65 6e 74 73 3a 0d  #..# Arguments:.
06b0: 0a 23 09 77 09 50 61 72 65 6e 74 20 77 69 64 67  .#.w.Parent widg
06c0: 65 74 20 74 6f 20 73 65 74 20 63 75 72 73 6f 72  et to set cursor
06d0: 20 6f 6e 20 28 69 6e 63 6c 75 64 65 73 20 63 68   on (includes ch
06e0: 69 6c 64 72 65 6e 29 0d 0a 23 09 63 75 72 73 6f  ildren)..#.curso
06f0: 72 09 54 68 65 20 63 75 72 73 6f 72 20 74 6f 20  r.The cursor to 
0700: 75 73 65 0d 0a 23 0d 0a 23 20 52 65 73 75 6c 74  use..#..# Result
0710: 73 3a 0d 0a 23 09 53 65 74 20 74 68 65 20 63 75  s:..#.Set the cu
0720: 72 73 6f 72 20 6f 66 20 24 77 20 61 6e 64 20 61  rsor of $w and a
0730: 6c 6c 20 64 65 73 63 65 6e 64 61 6e 74 73 20 74  ll descendants t
0740: 6f 20 24 63 75 72 73 6f 72 0d 0a 0d 0a 70 72 6f  o $cursor....pro
0750: 63 20 3a 3a 63 75 72 73 6f 72 3a 3a 70 72 6f 70  c ::cursor::prop
0760: 61 67 61 74 65 20 7b 77 20 63 75 72 73 6f 72 7d  agate {w cursor}
0770: 20 7b 0d 0a 20 20 20 20 76 61 72 69 61 62 6c 65   {..    variable
0780: 20 43 55 52 53 4f 52 0d 0a 20 20 20 20 23 20 49   CURSOR..    # I
0790: 67 6e 6f 72 65 73 20 7b 7d 20 63 75 72 73 6f 72  gnores {} cursor
07a0: 73 20 6f 72 20 77 69 64 67 65 74 73 20 74 68 61  s or widgets tha
07b0: 74 20 64 6f 6e 27 74 20 68 61 76 65 20 61 20 2d  t don't have a -
07c0: 63 75 72 73 6f 72 20 6f 70 74 69 6f 6e 0d 0a 20  cursor option.. 
07d0: 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b     if {![catch {
07e0: 73 65 74 20 43 55 52 53 4f 52 28 24 77 29 20 5b  set CURSOR($w) [
07f0: 24 77 20 63 67 65 74 20 2d 63 75 72 73 6f 72 5d  $w cget -cursor]
0800: 7d 5d 20 26 26 20 24 43 55 52 53 4f 52 28 24 77  }] && $CURSOR($w
0810: 29 20 21 3d 20 22 22 7d 20 7b 0d 0a 70 75 74 73  ) != ""} {..puts
0820: 20 22 73 65 74 20 43 55 52 53 4f 52 28 24 77 29   "set CURSOR($w)
0830: 20 24 43 55 52 53 4f 52 28 24 77 29 22 0d 0a 70   $CURSOR($w)"..p
0840: 75 74 73 20 22 24 77 20 63 6f 6e 66 69 67 20 2d  uts "$w config -
0850: 63 75 72 73 6f 72 20 24 63 75 72 73 6f 72 22 0d  cursor $cursor".
0860: 0a 09 24 77 20 63 6f 6e 66 69 67 20 2d 63 75 72  ..$w config -cur
0870: 73 6f 72 20 24 63 75 72 73 6f 72 0d 0a 20 20 20  sor $cursor..   
0880: 20 7d 20 65 6c 73 65 20 7b 0d 0a 09 63 61 74 63   } else {...catc
0890: 68 20 7b 75 6e 73 65 74 20 43 55 52 53 4f 52 28  h {unset CURSOR(
08a0: 24 77 29 7d 0d 0a 20 20 20 20 7d 0d 0a 20 20 20  $w)}..    }..   
08b0: 20 66 6f 72 65 61 63 68 20 63 68 69 6c 64 20 5b   foreach child [
08c0: 77 69 6e 66 6f 20 63 68 69 6c 64 72 65 6e 20 24  winfo children $
08d0: 77 5d 20 7b 20 70 72 6f 70 61 67 61 74 65 20 24  w] { propagate $
08e0: 63 68 69 6c 64 20 24 63 75 72 73 6f 72 20 7d 0d  child $cursor }.
08f0: 0a 7d 0d 0a 0d 0a 23 20 3a 3a 63 75 72 73 6f 72  .}....# ::cursor
0900: 3a 3a 72 65 73 74 6f 72 65 73 20 2d 2d 0d 0a 23  ::restores --..#
0910: 0d 0a 23 09 52 65 73 74 6f 72 65 73 20 6f 72 69  ..#.Restores ori
0920: 67 69 6e 61 6c 20 63 75 72 73 6f 72 20 6f 66 20  ginal cursor of 
0930: 61 20 77 69 64 67 65 74 20 61 6e 64 20 61 6c 6c  a widget and all
0940: 20 64 65 73 63 65 6e 64 61 6e 74 73 2e 0d 0a 23   descendants...#
0950: 0d 0a 23 20 41 72 67 75 6d 65 6e 74 73 3a 0d 0a  ..# Arguments:..
0960: 23 09 77 09 50 61 72 65 6e 74 20 77 69 64 67 65  #.w.Parent widge
0970: 74 20 74 6f 20 72 65 73 74 6f 72 65 20 63 75 72  t to restore cur
0980: 73 6f 72 20 66 6f 72 20 28 69 6e 63 6c 75 64 65  sor for (include
0990: 73 20 63 68 69 6c 64 72 65 6e 29 0d 0a 23 09 63  s children)..#.c
09a0: 75 72 73 6f 72 09 54 68 65 20 64 65 66 61 75 6c  ursor.The defaul
09b0: 74 20 63 75 72 73 6f 72 20 74 6f 20 75 73 65 20  t cursor to use 
09c0: 28 69 66 20 6e 6f 6e 65 20 77 61 73 20 63 61 63  (if none was cac
09d0: 68 65 64 20 62 79 20 70 72 6f 70 61 67 61 74 65  hed by propagate
09e0: 29 0d 0a 23 0d 0a 23 20 52 65 73 75 6c 74 73 3a  )..#..# Results:
09f0: 0d 0a 23 09 52 65 73 74 6f 72 65 20 74 68 65 20  ..#.Restore the 
0a00: 63 75 72 73 6f 72 20 6f 66 20 24 77 20 61 6e 64  cursor of $w and
0a10: 20 61 6c 6c 20 64 65 73 63 65 6e 64 61 6e 74 73   all descendants
0a20: 0d 0a 0d 0a 70 72 6f 63 20 3a 3a 63 75 72 73 6f  ....proc ::curso
0a30: 72 3a 3a 72 65 73 74 6f 72 65 20 7b 77 20 61 72  r::restore {w ar
0a40: 67 73 7d 20 7b 0d 0a 20 20 20 20 70 75 74 73 20  gs} {..    puts 
0a50: 22 3a 3a 63 75 72 73 6f 72 3a 3a 72 65 73 74 6f  "::cursor::resto
0a60: 72 65 20 24 77 20 24 61 72 67 73 22 0d 0a 20 20  re $w $args"..  
0a70: 20 20 76 61 72 69 61 62 6c 65 20 43 55 52 53 4f    variable CURSO
0a80: 52 0d 0a 20 20 20 20 23 0d 0a 20 20 20 20 23 20  R..    #..    # 
0a90: 50 72 6f 63 65 73 73 20 6f 70 74 69 6f 6e 73 0d  Process options.
0aa0: 0a 20 20 20 20 23 0d 0a 20 20 20 20 73 65 74 20  .    #..    set 
0ab0: 6e 62 61 72 67 73 20 5b 6c 6c 65 6e 67 74 68 20  nbargs [llength 
0ac0: 24 61 72 67 73 5d 0d 0a 20 20 20 20 69 66 20 7b  $args]..    if {
0ad0: 24 6e 62 61 72 67 73 3d 3d 31 7d 20 74 68 65 6e  $nbargs==1} then
0ae0: 20 7b 0d 0a 20 20 20 20 20 20 20 20 73 65 74 20   {..        set 
0af0: 63 75 72 73 6f 72 20 5b 6c 69 6e 64 65 78 20 24  cursor [lindex $
0b00: 61 72 67 73 20 30 5d 0d 0a 20 20 20 20 20 20 20  args 0]..       
0b10: 20 73 65 74 20 64 65 70 74 68 66 69 72 73 74 20   set depthfirst 
0b20: 31 0d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0d  1..    } else {.
0b30: 0a 20 20 20 20 20 20 20 20 73 65 74 20 63 75 72  .        set cur
0b40: 73 6f 72 20 7b 7d 0d 0a 20 20 20 20 20 20 20 20  sor {}..        
0b50: 73 65 74 20 64 65 70 74 68 66 69 72 73 74 20 31  set depthfirst 1
0b60: 0d 0a 20 20 20 20 20 20 20 20 66 6f 72 65 61 63  ..        foreac
0b70: 68 20 7b 6b 65 79 20 76 61 6c 75 65 7d 20 24 61  h {key value} $a
0b80: 72 67 73 20 7b 0d 0a 20 20 20 20 20 20 20 20 20  rgs {..         
0b90: 20 20 20 73 77 69 74 63 68 20 2d 2d 20 24 6b 65     switch -- $ke
0ba0: 79 20 7b 0d 0a 20 20 20 20 20 20 20 20 20 20 20  y {..           
0bb0: 20 20 20 20 20 22 2d 63 75 72 73 6f 72 22 20 7b       "-cursor" {
0bc0: 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ..              
0bd0: 20 20 20 20 20 20 73 65 74 20 63 75 72 73 6f 72        set cursor
0be0: 20 24 76 61 6c 75 65 0d 0a 20 20 20 20 20 20 20   $value..       
0bf0: 20 20 20 20 20 20 20 20 20 7d 0d 0a 20 20 20 20           }..    
0c00: 20 20 20 20 20 20 20 20 20 20 20 20 22 2d 64 65              "-de
0c10: 70 74 68 66 69 72 73 74 22 20 7b 0d 0a 20 20 20  pthfirst" {..   
0c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0c30: 20 73 65 74 20 64 65 70 74 68 66 69 72 73 74 20   set depthfirst 
0c40: 24 76 61 6c 75 65 0d 0a 20 20 20 20 20 20 20 20  $value..        
0c50: 20 20 20 20 20 20 20 20 7d 0d 0a 20 20 20 20 20          }..     
0c60: 20 20 20 20 20 20 20 20 20 20 20 64 65 66 61 75             defau
0c70: 6c 74 20 7b 0d 0a 20 20 20 20 20 20 20 20 20 20  lt {..          
0c80: 20 20 20 20 20 20 20 20 20 20 65 72 72 6f 72 20            error 
0c90: 22 55 6e 6b 6e 6f 77 6e 20 6b 65 79 20 24 6b 65  "Unknown key $ke
0ca0: 79 2e 22 0d 0a 20 20 20 20 20 20 20 20 20 20 20  y."..           
0cb0: 20 20 20 20 20 7d 0d 0a 20 20 20 20 20 20 20 20       }..        
0cc0: 20 20 20 20 7d 0d 0a 20 20 20 20 20 20 20 20 7d      }..        }
0cd0: 0d 0a 20 20 20 20 7d 0d 0a 20 20 20 20 69 66 20  ..    }..    if 
0ce0: 7b 24 64 65 70 74 68 66 69 72 73 74 3d 3d 30 7d  {$depthfirst==0}
0cf0: 20 74 68 65 6e 20 7b 0d 0a 20 20 20 20 20 20 20   then {..       
0d00: 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74   if {[info exist
0d10: 73 20 43 55 52 53 4f 52 28 24 77 29 5d 7d 20 7b  s CURSOR($w)]} {
0d20: 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75  ..            pu
0d30: 74 73 20 22 24 77 20 63 6f 6e 66 69 67 20 2d 63  ts "$w config -c
0d40: 75 72 73 6f 72 20 24 43 55 52 53 4f 52 28 24 77  ursor $CURSOR($w
0d50: 29 22 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20  )"..            
0d60: 24 77 20 63 6f 6e 66 69 67 20 2d 63 75 72 73 6f  $w config -curso
0d70: 72 20 24 43 55 52 53 4f 52 28 24 77 29 0d 0a 20  r $CURSOR($w).. 
0d80: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0d         } else {.
0d90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 23 20 4e  .            # N
0da0: 6f 74 20 61 6c 6c 20 77 69 64 67 65 74 73 20 68  ot all widgets h
0db0: 61 76 65 20 2d 63 75 72 73 6f 72 0d 0a 20 20 20  ave -cursor..   
0dc0: 20 20 20 20 20 20 20 20 20 63 61 74 63 68 20 7b           catch {
0dd0: 24 77 20 63 6f 6e 66 69 67 20 2d 63 75 72 73 6f  $w config -curso
0de0: 72 20 24 63 75 72 73 6f 72 7d 0d 0a 20 20 20 20  r $cursor}..    
0df0: 20 20 20 20 7d 0d 0a 20 20 20 20 7d 0d 0a 20 20      }..    }..  
0e00: 20 20 66 6f 72 65 61 63 68 20 63 68 69 6c 64 20    foreach child 
0e10: 5b 77 69 6e 66 6f 20 63 68 69 6c 64 72 65 6e 20  [winfo children 
0e20: 24 77 5d 20 7b 0d 0a 20 20 20 20 20 20 20 20 73  $w] {..        s
0e30: 65 74 20 63 6d 64 20 5b 63 6f 6e 63 61 74 20 72  et cmd [concat r
0e40: 65 73 74 6f 72 65 20 24 63 68 69 6c 64 20 24 61  estore $child $a
0e50: 72 67 73 5d 0d 0a 20 20 20 20 20 20 20 20 65 76  rgs]..        ev
0e60: 61 6c 20 24 63 6d 64 0d 0a 20 20 20 20 7d 0d 0a  al $cmd..    }..
0e70: 20 20 20 20 69 66 20 7b 24 64 65 70 74 68 66 69      if {$depthfi
0e80: 72 73 74 3d 3d 31 7d 20 74 68 65 6e 20 7b 0d 0a  rst==1} then {..
0e90: 20 20 20 20 20 20 20 20 69 66 20 7b 5b 69 6e 66          if {[inf
0ea0: 6f 20 65 78 69 73 74 73 20 43 55 52 53 4f 52 28  o exists CURSOR(
0eb0: 24 77 29 5d 7d 20 7b 0d 0a 20 20 20 20 20 20 20  $w)]} {..       
0ec0: 20 20 20 20 20 70 75 74 73 20 22 24 77 20 63 6f       puts "$w co
0ed0: 6e 66 69 67 20 2d 63 75 72 73 6f 72 20 24 43 55  nfig -cursor $CU
0ee0: 52 53 4f 52 28 24 77 29 22 0d 0a 20 20 20 20 20  RSOR($w)"..     
0ef0: 20 20 20 20 20 20 20 24 77 20 63 6f 6e 66 69 67         $w config
0f00: 20 2d 63 75 72 73 6f 72 20 24 43 55 52 53 4f 52   -cursor $CURSOR
0f10: 28 24 77 29 0d 0a 20 20 20 20 20 20 20 20 7d 20  ($w)..        } 
0f20: 65 6c 73 65 20 7b 0d 0a 20 20 20 20 20 20 20 20  else {..        
0f30: 20 20 20 20 23 20 4e 6f 74 20 61 6c 6c 20 77 69      # Not all wi
0f40: 64 67 65 74 73 20 68 61 76 65 20 2d 63 75 72 73  dgets have -curs
0f50: 6f 72 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20  or..            
0f60: 63 61 74 63 68 20 7b 24 77 20 63 6f 6e 66 69 67  catch {$w config
0f70: 20 2d 63 75 72 73 6f 72 20 24 63 75 72 73 6f 72   -cursor $cursor
0f80: 7d 0d 0a 20 20 20 20 20 20 20 20 7d 0d 0a 20 20  }..        }..  
0f90: 20 20 7d 0d 0a 7d 0d 0a 0d 0a 0d 0a 23 20 3a 3a    }..}......# ::
0fa0: 63 75 72 73 6f 72 3a 3a 64 69 73 70 6c 61 79 20  cursor::display 
0fb0: 2d 2d 0d 0a 23 0d 0a 23 09 53 68 6f 77 20 61 6c  --..#..#.Show al
0fc0: 6c 20 6b 6e 6f 77 6e 20 63 75 72 73 6f 72 73 20  l known cursors 
0fd0: 66 6f 72 20 76 69 65 77 69 6e 67 0d 0a 23 0d 0a  for viewing..#..
0fe0: 23 20 41 72 67 75 6d 65 6e 74 73 3a 0d 0a 23 09  # Arguments:..#.
0ff0: 77 09 50 61 72 65 6e 74 20 77 69 64 67 65 74 20  w.Parent widget 
1000: 74 6f 20 75 73 65 20 66 6f 72 20 64 69 61 6c 6f  to use for dialo
1010: 67 0d 0a 23 0d 0a 23 20 52 65 73 75 6c 74 73 3a  g..#..# Results:
1020: 0d 0a 23 09 50 6f 70 73 20 75 70 20 61 20 64 69  ..#.Pops up a di
1030: 61 6c 6f 67 0d 0a 0d 0a 70 72 6f 63 20 3a 3a 63  alog....proc ::c
1040: 75 72 73 6f 72 3a 3a 64 69 73 70 6c 61 79 20 7b  ursor::display {
1050: 7b 72 6f 6f 74 20 2e 7d 7d 20 7b 0d 0a 20 20 20  {root .}} {..   
1060: 20 76 61 72 69 61 62 6c 65 20 63 75 72 73 6f 72   variable cursor
1070: 73 0d 0a 20 20 20 20 69 66 20 7b 24 72 6f 6f 74  s..    if {$root
1080: 20 3d 3d 20 22 2e 22 7d 20 7b 0d 0a 09 73 65 74   == "."} {...set
1090: 20 74 20 2e 5f 5f 63 75 72 73 6f 72 44 69 73 70   t .__cursorDisp
10a0: 6c 61 79 0d 0a 20 20 20 20 7d 20 65 6c 73 65 20  lay..    } else 
10b0: 7b 0d 0a 09 73 65 74 20 74 20 24 72 6f 6f 74 2e  {...set t $root.
10c0: 5f 5f 63 75 72 73 6f 72 44 69 73 70 6c 61 79 0d  __cursorDisplay.
10d0: 0a 20 20 20 20 7d 0d 0a 20 20 20 20 64 65 73 74  .    }..    dest
10e0: 72 6f 79 20 24 74 0d 0a 20 20 20 20 74 6f 70 6c  roy $t..    topl
10f0: 65 76 65 6c 20 24 74 0d 0a 20 20 20 20 77 6d 20  evel $t..    wm 
1100: 77 69 74 68 64 72 61 77 20 24 74 0d 0a 20 20 20  withdraw $t..   
1110: 20 6c 61 62 65 6c 20 24 74 2e 6c 62 6c 20 2d 74   label $t.lbl -t
1120: 65 78 74 20 22 53 65 6c 65 63 74 20 61 20 63 75  ext "Select a cu
1130: 72 73 6f 72 3a 22 20 2d 61 6e 63 68 6f 72 20 77  rsor:" -anchor w
1140: 0d 0a 20 20 20 20 6c 69 73 74 62 6f 78 20 24 74  ..    listbox $t
1150: 2e 6c 62 20 2d 73 65 6c 65 63 74 6d 6f 64 65 20  .lb -selectmode 
1160: 73 69 6e 67 6c 65 20 2d 79 73 63 72 6f 6c 6c 63  single -yscrollc
1170: 6f 6d 6d 61 6e 64 20 5b 6c 69 73 74 20 24 74 2e  ommand [list $t.
1180: 73 79 20 73 65 74 5d 0d 0a 20 20 20 20 73 63 72  sy set]..    scr
1190: 6f 6c 6c 62 61 72 20 24 74 2e 73 79 20 2d 6f 72  ollbar $t.sy -or
11a0: 69 65 6e 74 20 76 20 2d 63 6f 6d 6d 61 6e 64 20  ient v -command 
11b0: 5b 6c 69 73 74 20 24 74 2e 6c 62 20 79 76 69 65  [list $t.lb yvie
11c0: 77 5d 0d 0a 20 20 20 20 62 75 74 74 6f 6e 20 24  w]..    button $
11d0: 74 2e 64 20 2d 74 65 78 74 20 44 69 73 6d 69 73  t.d -text Dismis
11e0: 73 20 2d 63 6f 6d 6d 61 6e 64 20 5b 6c 69 73 74  s -command [list
11f0: 20 64 65 73 74 72 6f 79 20 24 74 5d 0d 0a 20 20   destroy $t]..  
1200: 20 20 70 61 63 6b 20 24 74 2e 64 20 2d 73 69 64    pack $t.d -sid
1210: 65 20 62 6f 74 74 6f 6d 0d 0a 20 20 20 20 70 61  e bottom..    pa
1220: 63 6b 20 24 74 2e 6c 62 6c 20 2d 73 69 64 65 20  ck $t.lbl -side 
1230: 74 6f 70 20 2d 66 69 6c 6c 20 78 0d 0a 20 20 20  top -fill x..   
1240: 20 70 61 63 6b 20 24 74 2e 73 79 20 2d 73 69 64   pack $t.sy -sid
1250: 65 20 72 69 67 68 74 20 2d 66 69 6c 6c 20 79 0d  e right -fill y.
1260: 0a 20 20 20 20 70 61 63 6b 20 24 74 2e 6c 62 20  .    pack $t.lb 
1270: 2d 73 69 64 65 20 72 69 67 68 74 20 2d 66 69 6c  -side right -fil
1280: 6c 20 62 6f 74 68 20 2d 65 78 70 61 6e 64 20 31  l both -expand 1
1290: 0d 0a 20 20 20 20 65 76 61 6c 20 5b 6c 69 73 74  ..    eval [list
12a0: 20 24 74 2e 6c 62 20 69 6e 73 65 72 74 20 65 6e   $t.lb insert en
12b0: 64 5d 20 24 63 75 72 73 6f 72 73 0d 0a 20 20 20  d] $cursors..   
12c0: 20 62 69 6e 64 20 24 74 2e 6c 62 20 3c 42 75 74   bind $t.lb <But
12d0: 74 6f 6e 2d 31 3e 20 7b 20 25 57 20 63 6f 6e 66  ton-1> { %W conf
12e0: 69 67 20 2d 63 75 72 73 6f 72 20 5b 25 57 20 67  ig -cursor [%W g
12f0: 65 74 20 5b 25 57 20 6e 65 61 72 65 73 74 20 25  et [%W nearest %
1300: 79 5d 5d 20 7d 0d 0a 20 20 20 20 77 6d 20 64 65  y]] }..    wm de
1310: 69 63 6f 6e 69 66 79 20 24 74 0d 0a 7d 0d 0a 0d  iconify $t..}...
1320: 0a                                               .