#---------------------------------------------------------------------------
# ntkWidget ntkTEntry.tcl --
#
# This file contains a ntk entry commands implementation
#
# this code is derived from the tile/ttk implementation written by
# Joe English
#
# Copyright (c) 2013 by Arnulf P. Wiedemann
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# @(#) $Id: ntkTEntry.tcl
#--------------------------------------------------------------------------
namespace eval ::ntk {
::itcl::extendedclass entry {
inherit classes::tentryBase
private variable entryEventMask [list FocusChange]
constructor {args} {}
public method ComputeTextLayout {font string numChars wrapLength justify flags widthVar heightVar}
public method EntryUpdateTextLayout {}
public method EntryConfigure {recordPtr mask}
public method EntryEventProc {args}
public method EntryInitialize {recordPtr}
}
#================================ constructor ============================
#
#=========================================================================
::itcl::body entry::constructor {args} {
set EntrySelectionCommands [dict create]
set EntryCommands [dict create]
dict set EntryCommands bbox EntryBBoxCommand
dict set EntryCommands cget WidgetCget
dict set EntryCommands configure WidgetConfigure
dict set EntryCommands delete EntryDeleteCommand
dict set EntryCommands get EntryGetCommand
dict set EntryCommands icursor EntryICursorCommand
dict set EntryCommands identify WidgetIdentify
dict set EntryCommands index EntryIndexCommand
dict set EntryCommands insert EntryInsertCommand
dict set EntryCommands instate WidgetInState
dict set EntryCommands selection EntrySelectionCommand
dict set EntryCommands state WidgetState
set widgetSpec [dict create]
dict set widgetSpec className "TEntry"
dict set widgetSpec commands $EntryCommands
dict set widgetSpec initializeProc EntryInitialize
dict set widgetSpec cleanupProc EntryCleanup
dict set widgetSpec configureProc EntryConfigure
dict set widgetSpec postConfigureProc EntryPostConfigure
dict set widgetSpec getLayoutProc WidgetGetLayout
dict set widgetSpec sizeProc WidgetSize
dict set widgetSpec layoutProc EntryDoLayout
dict set widgetSpec displayProc EntryDisplay
dict set core widgetSpec $widgetSpec
WidgetInit $args
dict set core takeFocus 1
}
#================================ ComputeTextLayout ============================
#
#
#=========================================================================
::itcl::body entry::ComputeTextLayout {font string numChars wrapLength justify flags widthVar heightVar} {
upvar $widthVar width
upvar $heightVar height
puts stderr "entry::ComputeTextLayout called!"
set width [expr {[string length $string] * 8}]
set height 14
}
#================================ EntryUpdateTextLayout ============================
# Recompute textLayout, layoutWidth, and layoutHeight
# from displayString and fontObj.
#=========================================================================
::itcl::body entry::EntryUpdateTextLayout {} {
puts stderr "entry::EntryUpdateTextLayout called!"
set wrapLength 0
set ignoreNewlines 1
dict set entry textLayout [ComputeTextLayout [cget -font] [dict get $entry displayString] [dict get $entry numChars] $wrapLength [cget -justify] $ignoreNewlines layoutWidth layoutHeight]
dict set entry layoutWidth $layoutWidth
dict set entry layoutHeight $layoutHeight
}
#================================ EntryConfigure ============================
# Configure hook for Entry widgets.
#=========================================================================
::itcl::body entry::EntryConfigure {recordPtr mask} {
#puts stderr "entry::EntryConfigure called!$mask!"
set textVarName [dict get $entry textVariable]
if {[lsearch $mask textvarChanged] >= 0} {
if {$textVarName ne ""} {
trace add variable [cget -textvariable] write TextVariableChanged
}
}
CoreConfigure $mask
# Update derived resources:
if {[lsearch $mask textvarChanged] >= 0} {
if {[dict get $entry textVariableTrace] ne ""} {
}
}
# Claim the selection, in case we've suddenly started exporting it.
if {[dict get $entry exportSelection] && [dict get $entry selectFirst] != -1} {
EntryOwnSelection
}
if {[lsearch $mask scrollcmdChanged] >= 0} {
ScrollbarUpdateRequired [dict get $entry xscrollHandle]
}
# Recompute the displayString, in case showChar changed:
if {[dict get $entry displayString] ne [dict get $entry string]} {
if {[dict get $entry showChar] ne ""} {
dict set entry displayString [EntryDisplayString [dict get $entry showChar] [dict get $entry numChars]]
} else {
dict set entry displayString [dict get $entry string]
}
}
# Update textLayout:
EntryUpdateTextLayout
return 1
}
#================================ EntryEventProc ============================
#
#=========================================================================
::itcl::body entry::EntryEventProc {args} {
puts stderr "entry::EntryEventProc called!$args!"
}
#================================ EntryInitialize ============================
#
#=========================================================================
::itcl::body entry::EntryInitialize {recordPtr} {
#puts stderr "entry::EntryInitialize called!$recordPtr!"
::ntk::classes::widgetInfo::CreateEventHandler [string trimleft $this :] $entryEventMask EntryEventProc $this
# CreateSelHandler
# BlinkCursor
}
} ; # end namspace ::ntk::classes