lib/tcl/mousehint.tcl

   1 #------------------------------------------------------------------------
   2 # Mouse button hints---written by James Vernon March 2006
   3 #------------------------------------------------------------------------
   4
   5 #------------------------------------------------------------------------
   6 # Write 3 strings corresponding to the 3 mouse button functions
   7 # Use the "bindkey -compat" to get the current button bindings
   8 #------------------------------------------------------------------------
   9
  10 proc xcircuit::automousehint {window} {
  11
  12    set frame [winfo top $window]
  13    set btext [$window bindkey -compat Button1]
  14    ${frame}.infobar.mousehints.left configure -text $btext
  15    set btext [$window bindkey -compat Button2]
  16    ${frame}.infobar.mousehints.middle configure -text $btext
  17    set btext [$window bindkey -compat Button3]
  18    ${frame}.infobar.mousehints.right configure -text $btext
  19 }
  20
  21 #------------------------------------------------------------------------
  22 # Creates a canvas showing the 3 buttons of a 3 button mouse
  23 # and adds labels that can contain strings telling the user what
  24 # the current function of those buttons is
  25 #------------------------------------------------------------------------
  26
  27 proc xcircuit::mousehint_create {name} {
  28
  29   frame ${name}.infobar.mousehints -background beige
  30
  31   label ${name}.infobar.mousehints.title -background beige -foreground brown4 \
  32         -anchor e -text "Button bindings: "
  33   button ${name}.infobar.mousehints.left -background beige -relief groove
  34   button ${name}.infobar.mousehints.middle -background beige -relief groove
  35   button ${name}.infobar.mousehints.right -background beige -relief groove
  36
  37   grid ${name}.infobar.mousehints.title -row 0 -column 0 -sticky news
  38   grid ${name}.infobar.mousehints.left -row 0 -column 1 -sticky news
  39   grid ${name}.infobar.mousehints.middle -row 0 -column 2 -sticky news
  40   grid ${name}.infobar.mousehints.right -row 0 -column 3 -sticky news
  41
  42   grid columnconfigure ${name}.infobar.mousehints 0 -weight 0
  43   grid columnconfigure ${name}.infobar.mousehints 1 -weight 0
  44   grid columnconfigure ${name}.infobar.mousehints 2 -weight 0
  45   grid columnconfigure ${name}.infobar.mousehints 3 -weight 0
  46
  47   mousehint_bindings ${name} ${name}.infobar.mousehints
  48
  49   xcircuit::automousehint ${name}.mainframe.mainarea.drawing
  50
  51   xcircuit::mousehint_show ${name}
  52 }
  53
  54 #------------------------------------------------------------------------
  55 # Displays the mouse_canvas that shows a picture of the 3
  56 # buttons on a mouse in the top right corner of the top level window
  57 # and moves the menubar.message widget under the menu buttons
  58 #------------------------------------------------------------------------
  59
  60 proc xcircuit::mousehint_show { name } {
  61
  62   pack forget ${name}.infobar.message2
  63   pack ${name}.infobar.mousehints -padx 2 -side left -ipadx 6 -fill y
  64   pack ${name}.infobar.message2 -side left -padx 2 -ipadx 6 -expand true -fill both
  65
  66   bind ${name}.infobar.mode <ButtonPress-1> "::xcircuit::mousehint_hide ${name}"
  67 }
  68
  69 #------------------------------------------------------------------------
  70 # Hides the mouse_canvas that shows a picture of the 3
  71 # buttons on a mouse and moves the menubar.message label
  72 # back in its place.
  73 #------------------------------------------------------------------------
  74
  75 proc xcircuit::mousehint_hide { name } {
  76
  77   pack forget ${name}.infobar.mousehints
  78   bind ${name}.infobar.mode <ButtonPress-1> "::xcircuit::mousehint_show ${name}"
  79 }
  80
  81 #------------------------------------------------------------------------
  82 # Highlights buttons on the mouse_canvas when the user
  83 # presses the corresponding mouse buttons
  84 # Seems unnecessary, but without it who would guess that those
  85 # rectangles are supposed to look like mouse buttons?
  86 #------------------------------------------------------------------------
  87
  88 proc xcircuit::mousehint_bindings { name mouse_frame } {
  89
  90    bind ${name} <Button-1> "${mouse_frame}.left configure -state active ; \
  91         xcircuit::automousehint ${name}.mainframe.mainarea.drawing"
  92    bind ${name} <Button-2> "${mouse_frame}.middle configure -state active ; \
  93         xcircuit::automousehint ${name}.mainframe.mainarea.drawing"
  94    bind ${name} <Button-3> "${mouse_frame}.right configure -state active ; \
  95         xcircuit::automousehint ${name}.mainframe.mainarea.drawing"
  96
  97    bind ${name} <ButtonRelease-1> "${mouse_frame}.left configure -state normal"
  98    bind ${name} <ButtonRelease-2> "${mouse_frame}.middle configure -state normal"
  99    bind ${name} <ButtonRelease-3> "${mouse_frame}.right configure -state normal"
 100
 101    bind ${name} <KeyPress> "xcircuit::automousehint ${name}.mainframe.mainarea.drawing"
 102
 103    bind ${mouse_frame}.title <ButtonPress-1> "::xcircuit::mousehint_hide ${name}"
 104 }
 105
 106 #------------------------------------------------------------------------