# xentry.tcl --
#
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
# RCS: @(#) $Id: xentry.tcl,v 1.2 2001/07/26 09:24:28 commeau Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

package provide xentry 2.0

#-------------------------------------------------------------------------
# Elements of tkPriv that are used in this file:
#
# afterId -             If non-null, it means that auto-scanning is underway
#                       and it gives the "after" id for the next auto-scan
#                       command to be executed.
# mouseMoved -          Non-zero means the mouse has moved a significant
#                       amount since the button went down (so, for example,
#                       start dragging out a selection).
# pressX -              X-coordinate at which the mouse button was pressed.
# selectMode -          The style of selection currently underway:
#                       char, word, or line.
# x, y -                Last known mouse coordinates for scanning
#                       and auto-scanning.
# data -                Used for Cut and Copy
#-------------------------------------------------------------------------

## xentry -- create the xentry widget, its data and initialize it
#
# le tableau xentry
#   contiendra tout ce qui est commun à tous les widget xentry
# le tableau $w
#   contiendra ce qui est spécifique à chaque widget
#   (état courant, ...)
#   En particulier $w intégrera l'ancien xentry...)
#
# la variable globales "stead" devra progressivement disparaitre de ce
# fichier (ou plutot de ce répertoire :-)
#
proc xentry {w args} {
    global xentry
    global stead
    
    # construction du widget :
    # ENTRY est le widget "entry" original de tk 
    # 
    eval ENTRY $w -exportselection 0 $args
    bindtags $w [list $w  [winfo class .] XEntry . all]

    # La variable propre à ce widget sont de la forme
    #   xentry($w,XXX)
    # mais pourront avoir leur propre  nom du style
    #   upvar #0 $w data


    # Initialisation à faire une seul fois : bindings et tableau xentry
    if {![info exists xentry(initialised)]} {
        xentryInit
    }

    xentryInitWidget $w
    
    return $w
}

# xentryInit --
#
# Initialise les bindings pour la classe XEntry et le tableau xentry lors
# de la première utilisation d'un widget xentry
# 
# Le tableau xtentry() contiendra les données communes à tous les widget 
# "xentry"
# 
proc xentryInit {} {
    global xentry

    set xentry(afterId) {}
    set xentry(mouseMoved) 0
    set xentry(pressX) 0
    set xentry(selectMode) char
    set xentry(x) 0
    set xentry(y) 0
    
    xentryInitBindings

    # Cette variable sera supprimé quand on connaitre une variable de nom
    # fiable de xentry()  (i.e qui ne soit pas positionée par stead elle même !)
    #
    set xentry(initialised) 1

} ;# endproc xentryInit

# xentryInitWidget -- A MODIFIER xtext --> xentry !!!
#
# Initialise les variable propres à chaque widget
#
proc xentryInitWidget {w} {
    global xentry

    # Initialisation des variables propres à cette instance de widget :
    #
    # Les variables propres à ce widget sont de la forme
    #   xtext($w,XXX)
    # mais pourront avoir leur propre nom du style
    #   upvar #0 $w data
    # 
    # la variable xentry sera alors réservée au données commune à tout widget
    # xentry. Pour les données liées à un widget particulier, on utilisera
    # data (par un upvar)
    # 

    upvar #0 $w data
    
    # état modifier du widget text :
    #   - mis à 1 à chaque modification
    #   - remis à 0 par l'application lors d'une sauvegarde
    # Peut être utiliser par un procédure de trace pour modifier l'icone ou
    # le nom de l'application : "mon_fichier.cc" -> "!mon_fichier.cc"
    # 
    set data(modified) 0

    # contiendra les messages d'erreur et cie
    set data(msg) ""

    
    # Gestion de la pile de undo (states) de ce widget
    # 
    # set data(states,pointer)  0
    # set data(states,text,$p)  "popop"
    # set data(states,state,$p) {5 5 8}  ;# {ins sel1 sel2}
    # 
    set data(states,pointer) 0

}

proc xentryInitBindings {args} {
    global stead
    global xentry
    global tcl_platform
    global tk_strictMotif


    # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
    # Otherwise, if a widget binding for one of these is defined, the
    # <KeyPress> class binding will also fire and insert the character,
    # which is wrong.  Ditto for Escape, Return, and Tab.

    bind XEntry <Alt-KeyPress> {# nothing}
    bind XEntry <$stead(Meta)-KeyPress> {# nothing}
    bind XEntry <Control-KeyPress> {# nothing}
    bind XEntry <Escape> {# nothing}
    bind XEntry <Return> {# nothing}
    bind XEntry <KP_Enter> {# nothing}
    bind XEntry <Tab> {# nothing}
    if {[string equal $tcl_platform(platform) "macintosh"]} {
        bind XEntry <Command-KeyPress> {# nothing}
    }
    
    #---------------------------------------------------------------------
    # The code below creates the default class bindings for entries.
    #---------------------------------------------------------------------

    bind XEntry <<Cut>>            {xentry_cut %W}
    bind XEntry <<Copy>>           {xentry_copy %W}
    bind XEntry <<Paste>>          {xentry_paste %W}
    bind XEntry <<Clear>>          {xentry_delSel %W}
    bind XEntry <<PasteSelection>> {xentry_pasteSel %W %x}
    
    # Mac like bindings
    # 
    bind XEntry <$stead(Meta)-x> {
        event generate %W <<Cut>>
    }
    bind XEntry <$stead(Meta)-c> {
        event generate %W <<Copy>>
    }
    bind XEntry <$stead(Meta)-v> {
        event generate %W <<Paste>>
    }
    bind XEntry <$stead(Meta)-d> {
        event generate %W <<PasteSelection>>
    }
    bind XEntry <$stead(Meta)-z> {
        xentry_undo %W
    }
    bind XEntry <$stead(Meta)-a> {
        xentry_selectAll %W
    }
    bind XEntry <$stead(Meta)-Z> {
        xentry_redo %W
    }
    
    # Standard Motif bindings:
    # 
    bind XEntry <1> {
        xentry_button1 %W %x
        %W selection clear
        xentry_updateCursorSize %W
    }
    bind XEntry <B1-Motion> {
        set xentry(x) %x
        xentry_mouseSelect %W %x
    }
    bind XEntry <Double-1> {
        set xentry(selectMode) word
        xentry_mouseSelect %W %x
        catch {%W icursor sel.first}
    }
    bind XEntry <Triple-1> {
        set xentry(selectMode) line
        xentry_mouseSelect %W %x
        %W icursor 0
    }
    bind XEntry <Shift-1> {
        set xentry(selectMode) char
        %W selection adjust @%x
        xentry_updateCursorSize %W
    }
    bind XEntry <Double-Shift-1>        {
        set xentry(selectMode) word
        xentry_mouseSelect %W %x
    }
    bind XEntry <Triple-Shift-1>        {
        set xentry(selectMode) line
        xentry_mouseSelect %W %x
    }
    bind XEntry <B1-Leave> {
        set xentry(x) %x
        xentry_autoScan %W
    }
    bind XEntry <B1-Enter> {
        xentry_tkCancelRepeat
    }
    bind XEntry <ButtonRelease-1> {
        xentry_tkCancelRepeat
    }
    bind XEntry <Control-1> {
        %W icursor @%x
    }
    
    bind XEntry <Left> {
        xentry_setCursor %W [expr {[%W index insert] - 1}]
    }
    bind XEntry <Right> {
        xentry_setCursor %W [expr {[%W index insert] + 1}]
    }
    bind XEntry <Shift-Left> {
        xentry_keySelect %W [expr {[%W index insert] - 1}]
        xentry_seeInsert %W
    }
    bind XEntry <Shift-Right> {
        xentry_keySelect %W [expr {[%W index insert] + 1}]
        xentry_seeInsert %W
    }
    bind XEntry <Control-Left> {
        xentry_setCursor %W [xentry_previousWord %W insert]
    }
    bind XEntry <Control-Right> {
        xentry_setCursor %W [xentry_nextWord %W insert]
    }
    bind XEntry <Shift-Control-Left> {
        xentry_keySelect %W [xentry_previousWord %W insert]
        xentry_seeInsert %W
    }
    bind XEntry <Shift-Control-Right> {
        xentry_keySelect %W [xentry_nextWord %W insert]
        xentry_seeInsert %W
    }
    bind XEntry <Home> {
        xentry_setCursor %W 0
    }
    bind XEntry <Shift-Home> {
        xentry_keySelect %W 0
        xentry_seeInsert %W
    }
    bind XEntry <End> {
        xentry_setCursor %W end
    }
    bind XEntry <Shift-End> {
        xentry_keySelect %W end
        xentry_seeInsert %W
    }
    
    bind XEntry <Delete> {xentry_delete %W insert insert}
    bind XEntry <BackSpace> { xentry_backspace %W } 
    bind XEntry <Control-space> {
        %W selection from insert
        xentry_updateCursorSize %W
    }
    bind XEntry <Select> {
        %W selection from insert
        xentry_updateCursorSize %W
    }
    bind XEntry <Control-Shift-space> {
        %W selection adjust insert
        xentry_updateCursorSize %W
    }
    bind XEntry <Shift-Select> {
        %W selection adjust insert
        xentry_updateCursorSize %W
    }
    bind XEntry <Control-slash> {
        %W selection range 0 end
        xentry_updateCursorSize %W
    }
    bind XEntry <Control-backslash> {
        %W selection clear
        xentry_updateCursorSize %W
    }
    bind XEntry <KeyPress>  { 
        xentry_insert %W %A 
    } 

    # On Windows, paste is done using Shift-Insert.  Shift-Insert already
    # generates the <<Paste>> event, so we don't need to do anything here.
    if {[string compare $tcl_platform(platform) "windows"]} {
        bind XEntry <Insert> {
            catch {xentry_insert %W [selection get -displayof %W]}
        }
    }
    
    # Additional emacs-like bindings:
    
    bind XEntry <Control-a> {
        xentry_setCursor %W 0
    }
    bind XEntry <Control-b> {
        xentry_setCursor %W [expr {[%W index insert] - 1}]
    }
    bind XEntry <Control-d> {
        xentry_delete $w
    }

    bind XEntry <Control-e> {
        xentry_setCursor %W end
    }
    bind XEntry <Control-f> {
        xentry_setCursor %W [expr {[%W index insert] + 1}]
    }
    bind XEntry <Control-h> {
        xentry_backspace %W
    }
    bind XEntry <Control-k> {
        xentry_delete %W insert end
    }
    bind XEntry <Control-t> {
        xentry_transpose %W
    }
    bind XEntry <$stead(Meta)-b> {
        xentry_setCursor %W [xentry_previousWord %W insert]
    }
    bind XEntry <Control-d> {
        xentry_pushState %W
        %W delete insert [xentry_nextWord %W insert]
        xentry_updateCursorSize %W
    }
    bind XEntry <$stead(Meta)-f> {
        xentry_setCursor %W [xentry_nextWord %W insert]
    }
    bind XEntry <$stead(Meta)-BackSpace> {
        xentry_pushState %W
        %W delete [xentry_previousWord %W insert] insert
        xentry_updateCursorSize %W
    }
    bind XEntry <$stead(Meta)-Delete> {
        xentry_pushState %W
        %W delete [xentry_previousWord %W insert] insert
        xentry_updateCursorSize %W
    }
    
    # A few additional bindings of my own.

    bind XEntry <2> {
        %W scan mark %x
        set xentry(x) %x
        set xentry(y) %y
        set xentry(mouseMoved) 0
    }
    bind XEntry <B2-Motion> {
        if {abs(%x-$xentry(x)) > 2} {
            set xentry(mouseMoved) 1
        }
        %W scan dragto %x
    }
    # Gestion de la copie directe de la sélection sur le relachement de <2>
    bind XEntry <ButtonRelease-2> {
        if {!$xentry(mouseMoved)} {
            xentry_pasteSel %W
        }
    }

    # # Pour que l'entry soit sélectionnée quand elle reçoit le focus
    # # NON : à faire lors du premier focus par l'appli utilisatrice de cette
    # # entry !
    # 
    # bind XEntry <FocusIn> {
    #     xentry_selectAll %W
    # }
} ;# endproc xentryInitBindings
#./
