# xentry_proc.tcl --
# 
# 
# Voir info dans fichier xtext.tcl
# 

package provide xentry 2.0


## proc te:eb:insert_nondigit : insere un caractere et efface la selection
proc te:eb:insert_nondigit {A W} {
    if {"$A" != ""} {
        te:clear_selection $W 
        $W insert insert $A
    }
}
## te:eb:sel_word W - select current word (at insert point)
# hacked from tk_entryBackword in entry.tcl
# 
proc te:eb:sel_word { W } {
  set string [$W get]
  set length [string length $string]
  set curs [expr [$W index insert]-1]
  if {$curs < 0} return
  for {set x $curs} {$x > 0} {incr x -1} {
    if {[string first [string index $string $x] " \t"] >= 0} {
      incr x
      break
    }
    if {([string first [string index $string $x] " \t"] < 0)
    	&& ([string first [string index $string [expr $x-1]] " \t"]
    	>= 0)} {
      break
    }
  }
  set start $x
  for {set x $curs} {$x < $length} {incr x 1} {
    if {([string first [string index $string $x] " \t"] < 0)
    	&& ([string first [string index $string [expr $x+1]] " \t"]
    	>= 0)} {
      break
    }
  }
  set end $x
  $W select from $start
  $W select to $end
  $W icursor $start
}

## te:eb:sel_line W - select entire entry
proc te:eb:sel_line { W } {
  $W select from 0
  $W select to end
  $W icursor 0
}

## te:go_to_sel_in_entry  - positionne le curseur au debut ou a la fin de la
# selection dans une entrée, renvoie 1 si il y avait une selection, 0 sinon
#
proc te:go_to_sel_in_entry {where W} {
  if {("x[selection own]" == "x$W") && ("x[te:selection_if_any]" != "")} {
  # $W icursor sel.$where
    if { "x$where" == "xfirst" } {
      $W icursor sel.$where
    } else {
      $W icursor [expr {[$W index sel.$where] + 1}]
    }
    return 1
  } else {
    return 0
  }
}
## te:go_to_sel  - positionne le curseur au debut ou a la fin de la
##                  selection
# renvoie 1 si il y avait une selection, 0 sinon
#
proc te:go_to_sel {where W} {
  if {("x[selection own]" == "x$W") && ("x[te:selection_if_any]" != "x")} {
    $W mark set insert sel.$where
    return 1
  } else {
    return 0
  }
}



## te:eb:left W - move one character left
proc te:eb:left { W } {
  if ![te:go_to_sel_in_entry first $W] {
    $W icursor [expr {[$W index insert] - 1}]
  }
  te:unset_selection $W
}

## te:eb:right W - move one character right
proc te:eb:right { W } {
  if ![te:go_to_sel_in_entry last $W] {
    $W icursor [expr {[$W index insert] + 1}]
  }
  te:unset_selection $W
}

## te:eb:bol W - move to beginning of entry
proc te:eb:bol { W } {
  if ![te:go_to_sel_in_entry first $W] {
    $W icursor 0
  }
  te:unset_selection $W
}

## te:eb:eol W - move to end of entry
proc te:eb:eol { W } {
  if ![te:go_to_sel_in_entry last $W] {
    $W icursor end
  }
  te:unset_selection $W
}

## te:eb:word_left W - move one word left
# hacked from tk_entryBackword in entry.tcl
proc te:eb:word_left { W } {

  if ![te:go_to_sel_in_entry first $W] {

    set string [$W get]
    set length [string length $string]
    set curs [expr [$W index insert]-2]
    if {$curs < 0} return
    for {set start $curs} {$start > 0} {incr start -1} {
      if {[string first [string index $string $start] " \t"] >= 0} {
        incr start
        break
      }
      if {([string first [string index $string $start] " \t"] < 0)
          && ([string first [string index $string [expr $start-1]] " \t"]
          >= 0)} {
        break
      }
    }
    $W icursor $start
  
  }
  te:unset_selection $W
}

## te:eb:word_right W - move one word right
# hacked from tk_entryBackword in entry.tcl
proc te:eb:word_right { W } {
  if ![te:go_to_sel_in_entry last $W] {
    set string [$W get]
    set length [string length $string]
    set curs [expr [$W index insert]+1]
  
    for {set end $curs} {$end < $length} {incr end 1} {
      if {[string first [string index $string $end] " \t"] >= 0} {
        break
      }
    }
    $W icursor $end
  }
  te:unset_selection $W
}

######################################################################
###  ENTRY DELETION ROUTINES
######################################################################

## te:eb:delete_left W - delete character before insert
proc te:eb:delete_left { W } {
  # si pas de selection dans l'entry effacement du caractere a gauche 
  # du curseur
  if { "x[selection own]" != "x$W" || "x[te:selection_if_any]" == "x" } {
    if {[$W index insert] != 0} {
      # sauvegarde de l'information des Undo (si on n'est pas au debut de W)
      te:entry:cmd:save_checkpoint $W
      $W delete [expr [$W index insert] -1]
    }
  # sinon effacement de la selection
  } else {
    te:clear_selection $W
  }
}

## te:eb:delete_right W - delete character after insert
proc te:eb:delete_right { W } {
  # si pas de selection dans l'entry effacement du caractere a droite 
  # du curseur
  if { "x[selection own]" != "x$W" || "x[te:selection_if_any]" == "x" } {
    if {[$W index insert] != [$W index end]} {
      # sauvegarde de l'information des Undo (si on n'est pas a la fin de W)
      te:entry:cmd:save_checkpoint $W
      $W delete insert
    }
  # sinon effacement de la selection
  } else {
    te:clear_selection $W
  }
}

## te:eb:kill_eol W - delete to eol
proc te:eb:kill_eol { W } {
  # si pas de selection dans l'entry effacement de tous les caracteres jusqu'a
  # la fin 
  if { "x[selection own]" != "x$W" || "x[te:selection_if_any]" == "x" } {
    if {[$W index insert] != [$W index end]} {
      # sauvegarde de l'information des Undo (si on n'est pas a la fin de W)
      te:entry:cmd:save_checkpoint $W
      $W delete insert end
    }
  # sinon effacement de la selection
  } else {
    te:clear_selection $W
  }
}

## te:eb:kill_selection W - delete selection
proc te:eb:kill_selection { W } {
  # si la selection est dans le texte et est non vide on la detruit
  if {"x[selection own]" == "x$W" && "x[te:selection_if_any]" != "x"} {
     # sauvegarde de l'information des Undo 
    te:entry:cmd:save_checkpoint $W 
    te:clear_selection $W
  }     
}

## te:eb:delete_word_left W - move one word left
# hacked from tk_entryBackword in entry.tcl
proc te:eb:delete_word_left { W } {
  # si pas de selection dans l'entry effacement du mot a gauche 
  # du curseur
  if { "x[selection own]" != "x$W" || "x[te:selection_if_any]" == "x" } {
    if {[$W index insert] != 0} {
      # sauvegarde de l'information des Undo (si on n'est pas au debut de W)
      te:entry:cmd:save_checkpoint $W

      set string [$W get]
      set length [string length $string]
      set curs [expr [$W index insert]-2]
      if {$curs < 0} return
      for {set start $curs} {$start > 0} {incr start -1} {
        if {[string first [string index $string [expr $start-1]] " \t"] >= 0} {
          break
        }
      }
      $W delete $start [expr {$curs+1}]
    }  
  # sinon effacement de la selection
  } else {
    te:clear_selection $W
  }      
}

## te:eb:delete_word_right W - move one word right
# hacked from tk_entryBackword in entry.tcl
proc te:eb:delete_word_right { W } {

  # si pas de selection dans l'entry effacement du mot a droite 
  # du curseur
  if { "x[selection own]" != "x$W" || "x[te:selection_if_any]" == "x" } {
    if {[$W index insert] != [$W index end]} {
      # sauvegarde de l'information des Undo (si on n'est pas a la fin de W)
      te:entry:cmd:save_checkpoint $W

      set string [$W get]
      set length [string length $string]
      set curs [expr [$W index insert]+1]
    
      for {set end $curs} {$end < $length} {incr end 1} {
        if {[string first [string index $string [expr $end+1]] " \t"] >= 0} {
          break
        }
      }
      $W delete insert $end
      
    }
  # sinon effacement de la selection
  } else {
    te:clear_selection $W
  }
}

######################################################################
###  ENTRY MOUSE ROUTINES
######################################################################

##  te:eb:paste_selection W - insert the X selection in an entry
# 
proc te:eb:paste_selection { W args } {
    global OLD_SELECTION
    set selection [te:selection_if_any]
    if {"x$selection" == "x"} {
        $W insert insert $OLD_SELECTION
    } else {
        $W insert insert $selection
        set OLD_SELECTION $selection    
    }
}

######################################################################
# routines to let scanning and pasting to double-up on the same button
# based on code by Tom Phelps <phelps@cs.berkeley.edu>
######################################################################

## te:eb:start_scan_or_paste 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 <ButtonRelease-N>
proc te:eb:start_scan_or_paste { W x y t } {
  global TE_TEB

  $W scan mark $x
  set TE_TEB(scanpaste_time) $t
  set TE_TEB(scanpaste_paste) 1
}

## te:eb:continue_scan W x y t - scan the entry, and mark the fact that
#   we're scanning, not pasting.
# BIND TO <BN-Motion>
proc te:eb:continue_scan { W x y t } {
  global TE_TEB
  $W scan dragto $x
  set TE_TEB(scanpaste_paste) 0
}

## te:eb:end_scan_or_paste 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 te:eb:end_scan_or_paste { W x y t } {
  global TE_TEB
  if {$TE_TEB(scanpaste_paste) &&
      [expr {$t-$TE_TEB(scanpaste_time)}] < 500} {
    te:entry:cmd:xpaste  $W
  }
}

# ./
