# jtextmouse.tcl - support for Text mouse bindings
#
###############################################################################
#  Copyright 1992-2002 by Jay Sekora.  This file may be freely distributed,   #
#  modified or unmodified, for any purpose, provided that this copyright      #
#  notice is retained verbatim in all copies and no attempt is made to        #
#  obscure the authorship of this file.  If you distribute any modified       #
#  versions, I ask, but do not require, that you clearly mark any changes     #
#  you make as such and that you provide your users with instructions for     #
#  getting the original sources.                                              #
###############################################################################

# TO DO:
# generalise movement to copying-to-cutbuffer and deletion

######################################################################
# global variables:
#
global J_PREFS env
::aq::default J_PREFS(bindings) basic
::aq::default J_PREFS(typeover) 1
#
######################################################################


###############################################################################
#                                                              j:text_select_to
# slight variant of tkTextSelectTo from Tk library; changes word breaks
# to avoid selecting gobs and gobs of punctuation (sometimes several lines
# worth!) around each word

proc j:text_select_to { w x y {extend 0}} {
  global tkPriv tcl_platform

  set cur [tkTextClosestGap $w $x $y]
  if {[catch {$w index anchor}]} {
    $w mark set anchor $cur
  }
  set anchor [$w index anchor]
  if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {
    set tkPriv(mouseMoved) 1
  }
  switch $tkPriv(selectMode) {
    char {
      if {[$w compare $cur < anchor]} {
        set first $cur
        set last anchor
      } else {
        set first anchor
        set last $cur
      }
    }
    word {
      if {[$w compare $cur < anchor]} {
###         set first [tkTextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
        set first [$w index "$cur wordstart"]
        if { !$extend } {
###           set last [tkTextNextPos $w "anchor" tcl_wordBreakAfter]
          set last [$w index "anchor wordend"]
        } else {
          set last anchor
        }
      } else {
###         set last [tkTextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
        set last [$w index "$cur wordend"]
        if { !$extend } {
###           set first [tkTextPrevPos $w anchor tcl_wordBreakBefore]
          set first [$w index "anchor wordstart"]
        } else {
          set first anchor
        }
      }
    }
    line {
      if {[$w compare $cur < anchor]} {
        set first [$w index "$cur linestart"]
        set last [$w index "anchor - 1c lineend + 1c"]
      } else {
        set first [$w index "anchor linestart"]
        set last [$w index "$cur lineend + 1c"]
      }
    }
  }
  if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) "char"]} {
    if {[string compare $tcl_platform(platform) "unix"] \
      && [$w compare $cur < anchor]} {
      $w mark set insert $first
    } else {
      $w mark set insert $last
    }
    $w tag remove sel 0.0 $first
    $w tag add sel $first $last
    $w tag remove sel $last end
    update idletasks
  }
}

######################################################################
# routines to let scanning and pasting to double-up on the same button
# based on code by Tom Phelps <phelps@cs.berkeley.edu>
# modified by jay to make it a little easier to paste
######################################################################

# j:tmb:scanpaste_press W x y t - start a drag or paste, recording
#   current location and time so we can later decide whether to paste or drag
# BIND TO <ButtonPress-N>
proc j:tmb:scanpaste_press { W x y t } {
  global j_teb
  
  # don't fire if we're chorded; see start of j:tmb:smart_extend_selection
  if {[info exists j_teb(chord)]} {
    if {$j_teb(chord)} {
      return
    }
  }
  
  $W scan mark $x $y
  set j_teb(scanpaste,time) $t
  set j_teb(scanpaste,x) $x
  set j_teb(scanpaste,y) $y
  set j_teb(scanpaste,pasting) 1
}

# j:tmb:scanpaste_drag W x y t - scan the entry, and mark the fact that
#   we're scanning, not pasting.  won't scan if the mouse has moved only
#   one pixel.
# BIND TO <BN-Motion>
proc j:tmb:scanpaste_drag { W x y t } {
  global j_teb
  
  # don't fire if we're chorded; see start of j:tmb:smart_extend_selection
  if {[info exists j_teb(chord)]} {
    if {$j_teb(chord)} {
      return
    }
  }
  
  set xdiff [expr {abs($x - $j_teb(scanpaste,x))}]
  set ydiff [expr {abs($y - $j_teb(scanpaste,y))}]
  
  if {$xdiff >= 2 || $ydiff >= 2} {
    $W scan dragto $x $y
    set j_teb(scanpaste,pasting) 0
  }
}

# j:tmb:scanpaste_release W x y t - if we haven't been scanning, and it's
#   been less than 500ms since button-down, paste selection
# BIND TO <ButtonRelease-N>
proc j:tmb:scanpaste_release { W x y t } {
  global j_teb
  
  # don't fire if we're chorded; see start of j:tmb:smart_extend_selection
  if {[info exists j_teb(chord)]} {
    if {$j_teb(chord)} {
      set j_teb(chord) 0	;# treat next Button-2 press normally
      return
    }
  }
  
  if {$j_teb(scanpaste,pasting) &&
      [expr {$t-$j_teb(scanpaste,time)}] < 500} {
    # j:tb:paste_selection $W
    catch {
      focus $W
      j:text:insert $W [selection get]
    }
  }
}

######################################################################
# routines to allow scrolling during text selection
# from raines@cgibm1.slac.stanford.edu (Paul E. Raines)
# modifications by js@aq.org (Jay Sekora) to make it a little
#   harder to make a selection, so you don't do it accidentally
#   when you just want to move.
#   Also merged in John's <ouster@tcl.eng.sun.com> scrolling mechanism
#   for Tk4
######################################################################

# j:tmb:movesel_press W x y - move and begin a selection
proc j:tmb:movesel_press { W x y t } {
  global j_teb J_PREFS tk_priv tkPriv
  set j_teb(dragscroll,txnd) 0
  set j_teb(dragscroll,x) $x
  set j_teb(dragscroll,y) $y
  
  set my_name [lindex [info level 0] 0]
  set j_teb(last_command,$W) $my_name	;# solves Emacs ^K, click, ^K problem
  
  if $J_PREFS(typeover) {
    # clear current selection:
    $W tag remove sel 1.0 end
  }
  # do what normal Tk binding does:
  set tkPriv(selectMode) char
  set tkPriv(mouseMoved) 0
  set tkPriv(pressX) $x
  j:text:move $W @$x,$y
  $W mark set anchor insert
  if {[lindex [$W config -state] 4] == "normal"} {focus $W}
}

# j:tmb:move W x y - move, don't change selection
proc j:tmb:move { W x y t } {
  global j_teb
  set my_name [lindex [info level 0] 0]
  set j_teb(last_command,$W) $my_name	;# solves Emacs ^K, click, ^K problem
  
  j:text:move $W @$x,$y
  $W mark set anchor insert
  if {[lindex [$W config -state] 4] == "normal"} {focus $W}
}

# j:tmb:movesel_drag W x y - begin dragging out selection
proc j:tmb:movesel_drag { W x y t } {
  global j_teb tkPriv
  
  # If the mouse enters the window from outside, this proc might get
  # called without appropriate variables set.  This is a bug, and here 
  # is not the right place to fix it, but it was quick. :-)
  # 
  if {! [info exists j_teb(dragscroll,x)]} return
  if {! [info exists j_teb(dragscroll,y)]} return
  
  set tkPriv(x) $x
  set tkPriv(y) $y
  
  set xdiff [expr {abs($x - $j_teb(dragscroll,x))}]
  set ydiff [expr {abs($y - $j_teb(dragscroll,y))}]
  
  if {$xdiff < 3 && $ydiff < 3} {
    return
  }
  
  j:text_select_to $W $x $y
}

# j:tmb:double_1 W x y t - double mouse 1 click; set select mode to word
proc j:tmb:double_1 { W x y t } {
  global tkPriv
  set tkPriv(selectMode) word
  j:text_select_to $W $x $y
  catch {$W mark set insert sel.first}
}

# j:tmb:triple_1 W x y t - triple mouse 1 click; set select mode to line
proc j:tmb:triple_1 { W x y t } {
  global tkPriv
  set tkPriv(selectMode) line
  j:text_select_to $W $x $y
  catch {$W mark set insert sel.first}
}

# j:tmb:smart_extend_selection W x y t - extend selection to include logical
#   elements
# THIS REALLY SHOULD BE APP-EXTENSIBLE!  Want different stuff for editing
#   HTML, C, Tcl, prose, etc.
proc j:tmb:smart_extend_selection { W x y t } {
  global tkPriv j_teb
  
  set j_teb(chord) 1	;# tell B2/B3 bindings not to fire
  
  switch $tkPriv(selectMode) {
    char {
      return		;# should select contiguous similar characters
    }
    word {
      # find start of URL
      #    (watch out for infinite loop at start of text widget)
      set char [$W get "sel.first - 1c"]
      while {[$W compare "sel.first - 1c" < sel.first] &&
             [string match {[-@.,a-zA-Z0-9_:/~+&%=]} $char]} {
        $W tag add sel "sel.first - 1c"
        set char [$W get "sel.first - 1c"]
      }
      
      # select following URL components:
      #    (watch out for infinite loop at end of text widget)
      set char [$W get sel.last]
      while {[$W compare "sel.last" < end] &&
             [string match {[-@.,a-zA-Z0-9_:/~+&%=]} $char]} {
        $W tag add sel sel.last
        set char [$W get sel.last]
      }
      # trim trailing period or comma, which are likely sentence punctuation
      #   rather than part of the URL
      if {[string match {[,.]} [$W get "sel.last - 1c"] ]} {
        $W tag remove sel "sel.last - 1c"
      }
    }
    line {
      # select between blank lines
      
      set anchorline [lindex [split [$W index anchor] .] 0]
      
      # first select up to latest blank line above.
      # check bounds to avoid infinite loop at top.
      set startline $anchorline
      set prevline [expr {$startline - 1}]
      while {($startline > 1) &&
             [string length [$W get $prevline.0 "$prevline.0 lineend"] ]} {
        set startline $prevline
        set prevline [expr {$startline - 1}]
      }
      
      # now select down to next blank line, or EOF
      # check bounds to avoid infinite loop at end
      set endline $anchorline
      set nextline [expr {$endline + 1}]
      while {[$W compare $endline.0 < "end linestart"] &&
             [string length [$W get $nextline.0 "$nextline.0 lineend"] ]} {
        set endline $nextline
        set nextline [expr {$endline + 1}]
      }
      
      $W tag add sel $startline.0 "$endline.0 lineend + 1c"
    }
  }
}

### # j:tmb:extend_sel W x y t - drag out a selection, scrolling if necessary
### proc j:tmb:extend_sel { W x y t } {
###   global j_teb
### 
###   if {$j_teb(dragscroll,txnd)} {
###     if {$j_teb(dragscroll,direction) == "down"} {
###       $W tag add sel sel.first sel.last+1l
###       $W yview -pickplace sel.last+1l
###     } else {
###       if {$j_teb(dragscroll,direction) == "up"} {
###         $W tag add sel sel.first sel.last-1l
###         $W yview -pickplace sel.first-1l
###       } else { return }
###     }
###     after $j_teb(dragscroll,delay) j:tmb:extend_sel $W $x $y $t
###   }
### }

# j:tmb:movesel_release W - finish a selection
proc j:tmb:movesel_release { W args } {
  global j_teb
  set j_teb(dragscroll,txnd) 0
  tkCancelRepeat
}

######################################################################
# set up text mouse bindings
#   these supplement, rather than replace, the standard Tk bindings.
######################################################################

proc j:tb:mouse_bind { W } {
  global j_teb
  
  # mouse bindings (for motion and scrolling selections)
  bind $W <Button-1>		{j:tmb:movesel_press %W %x %y %t}
  bind $W <Double-Button-1>	{j:tmb:double_1 %W %x %y %t}
  bind $W <Triple-Button-1>	{j:tmb:triple_1 %W %x %y %t}
  bind $W <Control-Button-1>	{j:tmb:move %W %x %y %t}
  bind $W <B1-Motion>		{j:tmb:movesel_drag %W %x %y %t}
  bind $W <ButtonRelease-1>	{j:tmb:movesel_release %W %x %y %t}
  # much slower with following:
  bind $W <B1-Leave> {
    set tkPriv(x) %x
    set tkPriv(y) %y
    tkTextAutoScan %W
    break
  }
  bind $W <B1-Enter> {
    tkCancelRepeat
    break
  }
  
  # mouse bindings (for scanning and pasting)
  bind $W <Button-2>		{j:tmb:scanpaste_press %W %x %y %t}
  bind $W <B2-Motion>		{j:tmb:scanpaste_drag %W %x %y %t}
  bind $W <ButtonRelease-2>	{j:tmb:scanpaste_release %W %x %y %t}
  
  # special complex bindings for adjusting selection
  #  THESE WOULD BE MUCH EASIER TO TYPE IF B1 WAS THE MODIFIER
  #  that requires coordinating with the other bindings
  bind $W \
    <B1-Button-2>	{j:tmb:smart_extend_selection %W %x %y %t; break}
}


