Efektivitas Strategi Ta’bir Mushawwar dalam Pembelajaran Bahasa Arab di Madrasah Ibtidaiyah
Keywords:
Arabic; speaking skill; ta’bir mushawwar
Abstract
Speaking proficiency is one of the main skills in Arabic language learning, but fourth grade students of MI TPI Keramat face difficulties in assembling mufradat and practicing active conversation, mainly due to the lack of varied learning strategies. This study aims to analyze the effectiveness of the ta'bir mushawwar strategy, which uses picture as a media to facilitate students in constructing sentences and telling stories, in improving Arabic speaking skills. With a quantitative approach and pre-experiment design, this study involved 18 students of class IV-C. Data were collected through tests, observations, and interviews, then analyzed descriptively and N-Gain test. The posttest average was 83.06 (very good category) with 88.9% completeness, and the N-Gain score was 0.6398 which showed effectiveness in the medium category. The ta'bir mushawwar strategy offers a solution in the form of a visual and hands-on learning approach that can significantly improve students' speaking skills and make learning more interesting and interactive.
| Server IP : 103.175.217.176 / Your IP : 18.190.176.176 Web Server : Apache/2.4.62 (Debian) System : Linux bilfathvps 5.10.0-33-amd64 #1 SMP Debian 5.10.226-1 (2024-10-03) x86_64 User : root ( 0) PHP Version : 7.4.33 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : OFF | Sudo : ON | Pkexec : ON Directory : /lib/blt2.5/ |
Upload File : |
# ======================================================================
#
# treeview.tcl
#
# ----------------------------------------------------------------------
# Bindings for the BLT treeview widget
# ----------------------------------------------------------------------
#
# AUTHOR: George Howlett
# Bell Labs Innovations for Lucent Technologies
# gah@lucent.com
# http://www.tcltk.com/blt
#
# RCS: $Id: treeview.tcl,v 1.24 2010/05/06 22:26:17 pcmacdon Exp $
#
# ----------------------------------------------------------------------
# Copyright (c) 1998 Lucent Technologies, Inc.
# ----------------------------------------------------------------------
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that the copyright notice and warranty disclaimer appear in
# supporting documentation, and that the names of Lucent Technologies
# any of their entities not be used in advertising or publicity
# pertaining to distribution of the software without specific, written
# prior permission.
#
# Lucent Technologies disclaims all warranties with regard to this
# software, including all implied warranties of merchantability and
# fitness. In no event shall Lucent be liable for any special, indirect
# or consequential damages or any damages whatsoever resulting from loss
# of use, data or profits, whether in an action of contract, negligence
# or other tortuous action, arising out of or in connection with the use
# or performance of this software.
#
# ======================================================================
namespace eval ::blt::tv {
variable afterId ""
variable scroll 0
variable column ""
variable space off
variable x 0
variable y 0
variable script [info script]
variable dirname [file dirname [info script]]
if {[info exists ::tcl_warn(level)] && $::tcl_warn(level)} {
source [file join $dirname tvutil.tcl]
} else {
set ::auto_index(::blt::tv::TableWid) [list source [file join $dirname tvutil.tcl]]
set ::auto_index(::blt::tv::TableLoad) [list source [file join $dirname tvutil.tcl]]
set ::auto_index(::blt::tv::TreeLoad) [list source [file join $dirname tvutil.tcl]]
set ::auto_index(::blt::tv::TreeDump) [list source [file join $dirname tvutil.tcl]]
set ::auto_index(::blt::tv::TreeFill) [list source [file join $dirname tvutil.tcl]]
}
}
image create photo blt::tv::normalCloseFolder -format gif -data {
R0lGODlhEAANAMIAAAAAAH9/f///////AL+/vwAA/wAAAAAAACH5BAEAAAUALAAAAAAQAA0A
AAM8WBrM+rAEQWmIb5KxiWjNInCkV32AJHRlGQBgDA7vdN4vUa8tC78qlrCWmvRKsJTquHkp
ZTKAsiCtWq0JADs=
}
image create photo blt::tv::normalOpenFolder -format gif -data {
R0lGODlhEAANAMIAAAAAAH9/f///////AL+/vwAA/wAAAAAAACH5BAEAAAUALAAAAAAQAA0A
AAM1WBrM+rAEMigJ8c3Kb3OSII6kGABhp1JnaK1VGwjwKwtvHqNzzd263M3H4n2OH1QBwGw6
nQkAOw==
}
image create photo blt::tv::activeCloseFolder -format gif -data {
R0lGODlhEAANAMIAAAAAAH9/f/////+/AL+/vwAA/wAAAAAAACH5BAEAAAUALAAAAAAQAA0A
AAM8WBrM+rAEQWmIb5KxiWjNInCkV32AJHRlGQBgDA7vdN4vUa8tC78qlrCWmvRKsJTquHkp
ZTKAsiCtWq0JADs=
}
image create photo blt::tv::activeOpenFolder -format gif -data {
R0lGODlhEAANAMIAAAAAAH9/f/////+/AL+/vwAA/wAAAAAAACH5BAEAAAUALAAAAAAQAA0A
AAM1WBrM+rAEMigJ8c3Kb3OSII6kGABhp1JnaK1VGwjwKwtvHqNzzd263M3H4n2OH1QBwGw6
nQkAOw==
}
image create photo blt::tv::normalFile -format gif -data {
R0lGODlhFAAQAMIAAP///wAAALq2VYKCgtvb2wAAAAAAAAAAACH5BAEAAAAA
LAAAAAAUABAAAAM7CLrcriHK8BxlsWIgOqCXFkKkyHnT2KjYUFFdjLoPuwS0
dcrCl6+i34Y3ewWNL+EtlVIuBtCodEBgJAAAOw==
}
image create photo blt::tv::openFile -format gif -data {
R0lGODlhEQAQAIUAAPwCBFxaXNze3Ly2rJyanPz+/Ozq7GxqbPz6/PT29HRy
dMzOzDQyNExGBIyKhERCRPz+hPz+BPz29MTCBPzy7PTq3NS+rPz+xPz27Pzu
5PTi1My2pPTm1PTezPTm3PTaxMyynMyqjPTizOzWvOzGrOTi3OzOtMSehNTK
xNTCtAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAARABAAAAaj
QIBQGCgajcMkICBoNgcBQkBJFBSuBcMBIaUysYWEYsFlKBtWsENxeJgBDTik
UaBfE4KBw9yYNyINfXYFEnlvfxMRiYMSFBUWfA0TFxAXE4EFGBkVGhsMfRER
EAUQoXObHB2ecJKUloEJHB4aHyCHirgNGRmzHx8hfH6Agh4iHyMkwEJxghkN
HCXHJiQnb0MNCwsoKRYbICEh1UoBDOXm5wx2QQA7
}
image create photo blt::tv::empty
image create photo blt::tv::downarrow -format gif -data {
R0lGODlhEQAJAPABAAAAAP///yH5BAEAAAEALAAAAAARAAkAAAJXTJgwYcKE
CRMmTJgQIECAAAEiTJgwIUCAAAEiTJgwYUKAAAEiTJgwYcKEAAEiTJgwYcKE
CQEiTJgwYcKECRMiTJgwYcKECRMmTJgwYcKECRMmTJgwYcIUADs=
}
image create photo blt::tv::rightarrow -format gif -data {
R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIdhI+pyxCt
woNHTmpvy3rxnnwQh1mUI52o6rCu6hcAIf5oQ3JlYXRlZCBieSBCTVBUb0dJ
RiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwg
cmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==
}
image create photo blt::tv::ball -format gif -data {
R0lGODlhEQAJAPABAAAAAP///yH5BAEAAAEALAAAAAARAAkAAAJXTJgwYcKE
CRMmTJgwYcKECRMmTJgwYcKAABMmTJgwYcKAAAEmTJgwYcKEAAEiTJgwYcKE
CQEiTJgwYcKECRMmTJgwYcKECRMmTJgwYcKECRMmTJgwYcIUADs=
}
# Seems to be a memory leak in @cursors and another in binds.
if { $tcl_platform(platform) == "windows" } {
if { $tk_version >= 8.3 && ![string match /zvfs* $blt_library]} {
set cursor "@[file join $blt_library treeview.cur]"
} else {
set cursor "size_we"
}
option add *${className}.ResizeCursor [list $cursor]
} else {
option add *${className}.ResizeCursor \
"@$blt_library/treeview.xbm $blt_library/treeview_m.xbm black white"
}
# ----------------------------------------------------------------------
#
# Initialize --
#
# Invoked by internally by Treeview_Init routine. Initializes
# the default bindings for the treeview widget entries. These
# are local to the widget, so they can't be set through the
# widget's class bind tags.
#
# TODO: get rid of most of this in favor of class binds.
#
# ----------------------------------------------------------------------
variable ::blt::tv::oldedit 0
proc ::blt::tv::Initialize { w } {
#
# Active entry bindings
#
variable oldedit
$w bind Entry <Enter> {
%W entry activate current
}
$w bind Entry <Leave> {
%W entry activate ""
}
#
# Button bindings
#
$w button bind all <ButtonRelease-1> {
blt::tv::Toggle %W current
}
$w button bind all <Enter> {
%W button activate current
}
$w button bind all <Leave> {
%W button activate ""
}
#
# ButtonPress-1
#
# Performs the following operations:
#
# 1. Clears the previous selection.
# 2. Selects the current entry.
# 3. Sets the focus to this entry.
# 4. Scrolls the entry into view.
# 5. Sets the selection anchor to this entry, just in case
# this is "multiple" mode.
#
$w bind Entry <ButtonPress-1> {
blt::tv::SetSelectionSetAnchor %W %x %y
set blt::tv::scroll 1
}
#$w bind Entry <Double-ButtonPress-1> { %W toggle current }
#
# B1-Motion
#
# For "multiple" mode only. Saves the current location of the
# pointer for auto-scrolling. Resets the selection mark.
#
$w bind Entry <B1-Motion> {
set blt::tv::x %x
set blt::tv::y %y
set index [%W nearest %x %y]
if { [%W cget -selectmode] == "multiple" } {
%W selection mark $index
} elseif { [%W cget -selectmode] != "none" } {
blt::tv::SetSelectionAnchor %W $index
}
}
#
# ButtonRelease-1
#
# For "multiple" mode only.
#
$w bind Entry <ButtonRelease-1> {
if { [%W cget -selectmode] == "multiple" } {
%W selection anchor current
}
after cancel $blt::tv::afterId
set blt::tv::scroll 0
}
#
# Shift-ButtonPress-1
#
# For "multiple" mode only.
#
$w bind Entry <Shift-ButtonPress-1> {
blt::tv::SetSelectionExtendAnchor %W %x %y
}
$w bind Entry <Shift-Double-ButtonPress-1> {
# do nothing
}
$w bind Entry <Shift-B1-Motion> {
# do nothing
}
$w bind Entry <Shift-ButtonRelease-1> {
after cancel $blt::tv::afterId
set blt::tv::scroll 0
}
#
# Control-ButtonPress-1
#
# For "multiple" mode only.
#
$w bind Entry <Control-ButtonPress-1> {
blt::tv::SetSelectionAdd %W %x %y
}
$w bind Entry <Control-Double-ButtonPress-1> {
# do nothing
}
$w bind Entry <Control-B1-Motion> {
# do nothing
}
$w bind Entry <Control-ButtonRelease-1> {
after cancel $blt::tv::afterId
set blt::tv::scroll 0
}
$w bind Entry <Control-Shift-ButtonPress-1> {
if { [%W cget -selectmode] == "multiple" && [%W selection present] } {
if { [%W index anchor] == "" } {
%W selection anchor current
}
if { [%W selection includes anchor] } {
%W selection set anchor current
} else {
%W selection clear anchor current
%W selection set current
}
} elseif { [%W cget -selectmode] != "none" } {
blt::tv::SetSelectionAnchor %W current
}
}
$w bind Entry <Control-Shift-Double-ButtonPress-1> {
# do nothing
}
$w bind Entry <Control-Shift-B1-Motion> {
# do nothing
}
$w bind Entry <Shift-ButtonPress-3> {
blt::tv::EditColumn %W %X %Y
}
$w column bind all <Enter> {
%W column activate [%W column current]
}
$w column bind all <Leave> {
%W column activate ""
}
$w column bind Rule <Enter> {
%W column activate [%W column current]
%W column resize activate [%W column current]
}
$w column bind Rule <Leave> {
%W column activate ""
%W column resize activate ""
}
$w column bind Rule <ButtonPress-1> {
%W column resize anchor %x
}
$w column bind Rule <B1-Motion> {
%W column resize mark %x
}
$w column bind Rule <ButtonRelease-1> {
%W column configure [%W column current] -width [%W column resize set]
}
set ::blt::tv::curRelief raised
$w column bind all <ButtonPress-1> {
set blt::tv::column [%W column current]
set blt::tv::curRelief [%W column cget $blt::tv::column -titlerelief]
%W column configure $blt::tv::column -titlerelief sunken
}
$w column bind all <ButtonRelease-1> {
set column [%W column current]
if { $column != "" } {
%W column invoke $column
}
%W column configure $blt::tv::column -titlerelief $blt::tv::curRelief
}
if {$oldedit} {
$w bind TextBoxStyle <Alt-ButtonPress-3> {
if { [%W edit -root -test %X %Y] } {
break
}
}
$w bind TextBoxStyle <Shift-ButtonRelease-1> {
if { [%W edit -root -test %X %Y] } {
blt::tv::EditColumn %W %X %Y
break
}
}
$w bind TextBoxStyle <Double-1> {
if { [%W edit -root -test %X %Y] } {
blt::tv::EditColumn %W %X %Y
break
}
}
}
# $w bind CheckBoxStyle <Enter> {
# set column [%W column current]
# if { [%W column cget $column -edit] } {
# %W style activate current $column
# }
# }
# $w bind CheckBoxStyle <Leave> {
# %W style activate ""
# }
$w bind CheckBoxStyle <ButtonPress-1> {
if { [%W edit -root -test %X %Y] } {
event generate %W <<TreeViewEditStart>> -x [%W col index [%W col current]] -y [%W index @%x,%y]
break
}
}
$w bind CheckBoxStyle <B1-Motion> {
if { [%W column cget [%W column current] -edit] } {
break
}
}
$w bind CheckBoxStyle <ButtonRelease-1> {
if { [%W edit -root -test %X %Y] } {
%W edit -root %X %Y
event generate %W <<TreeViewEditEnd>> -x [%W col index [%W col current]] -y [%W index @%x,%y]
break
}
}
if 0 {
$w bind ComboBoxStyle <ButtonPress-1> {
set column [%W column current]
%W style activate focus $column
if { [%W column cget $column -edit] } {
break
}
}
$w bind ComboBoxStyle <ButtonRelease-1> {
%W style activate 0
if { [%W edit -root -test %X %Y] } {
%W edit -root %X %Y
break
}
}
$w bind ComboBoxStyle <Double-1> {
if { [%W edit -root -test %X %Y] } {
blt::tv::EditColumn %W %X %Y
break
}
}
}
if {$oldedit} {
$w bind ComboBoxStyle <Shift-ButtonRelease-1> {
if { [%W edit -root -test %X %Y] } {
blt::tv::EditColumn %W %X %Y
break
}
}
} else {
$w bind ComboBoxStyle <ButtonPress-1> {}
}
$w bind ComboBoxStyle <ButtonRelease-1> {
if { [%W edit -root -test %X %Y] } {
blt::tv::Combobox-List %W %X %Y
}
}
}
proc ::blt::tv::Combobox-List-Done {W entry col args} {
set i [$W index active]
set v [$W get $i]
set l [winfo parent $W]
set w [winfo parent $l]
$w entry set $entry $col $v
event generate $w <<TreeViewEditEnd>> -x [$w col index $col] -y $entry
destroy $l
$w style activate 0
}
proc ::blt::tv::Combobox-List-Close {l} {
set w [winfo parent $l]
destroy $l
$w style activate 0
}
proc ::blt::tv::Combobox-List {w x y} {
# Popup combo-list for combobox.
# TODO: could put frame in toplevel so not clipped.
set Opts {
{ -height 6 "Listbox height" }
{ -leafs False "Edit only leaf nodes" }
{ -leave 1 "Setup handler for leave" }
{ -conf {} "Listbox widget configuration options" }
{ -optscmd {} "Callback to get edit options" -type {cmd w r c} }
{ -readonly False "Do not allow editing" }
{ -useframe 1 "Use a frame below treeview widget" }
{ -usetopframe 0 "Use a frame at toplevel" }
{ -withouttag {} "Edit only entries without tag"}
{ -withtag {} "Edit only entries with tag"}
}
if {[winfo exists $w.edit]} return
set lx [expr {$x-[winfo rootx $w]}]
set ly [expr {$y-[winfo rooty $w]}]
set ind [$w index @$lx,$ly]
#if {[llength [set lst [$w cget -values]]] == 0} return
set col [$w column current]
if {![$w column cget $col -edit]} return
set widopts [$w column cget $col -editopts]
set cellstyle [lindex [$w style get $col $ind] 0]
if {$cellstyle != {}} {
if {[$w style cget $cellstyle -readonly]} return
set widopts [concat $widopts [$w style cget $cellstyle -editopts]]
}
set edopts {}
foreach i $Opts {
set q([lindex $i 0]) [lindex $i 1]
lappend edopts [lindex $i 0] [lindex $i 1]
}
set opts { -activestyle dotbox -bd 2 -pad 10 -relief sunken -selectmode single }
set style $cellstyle
if {$style == {}} {
set style [$w column cget $col -style]
}
set ckey [$w style cget $style -choicekey]
set cmd [$w style cget $style -choicecmd]
set lst [$w style cget $style -choices]
if {$ckey != {}} {
set lst [$w entry get $ind $ckey {}]
}
if {$cmd != {} && $lst == {}} {
set cmd [string map [list %% % %W $w %X $x %Y $y %# $ind %C $col] $cmd]
set lst [namespace eval :: $cmd]
}
set offs [$w column offsets]
set cind [$w column index $col]
set xstart [lindex $offs $cind]
if {$cind >= ([llength $offs]-1)} {
set xend [winfo width $w]
} else {
set xend [lindex $offs [expr {$cind+1}]]
}
if {$q(-optscmd) != {}} {
set ewopts [eval $q(-optscmd) $w $ind $col]
if {[llength $ewopts]%2} {
tclLog "TreeView -optscmd: odd length: '$ewopts' for $w"
} else {
array set q $ewopts
}
}
if {$q(-readonly)} return
if {$q(-leafs) && [llength [$w entry children $ind]]} return
set tags [$w tag names $ind]
if {$q(-withtag) != {}} {
if {[lsearch -exact $tags $q(-withtag)]<0} return
}
if {$q(-withouttag) != {}} {
if {[lsearch -exact $tags $q(-withouttag)]>=0} return
}
set xsiz [expr {$xend-$xstart}]
set entry $ind
set bb [$w bbox -screen $ind]
if {[llength $bb]!=4} return
foreach {xbegin ystart xwidth ywidth} $bb break
#set ystart [lindex $bb 1]
set yend [expr {$ywidth+$ystart}]
#tclLog "COL: $col, $lst, entry=$entry, offs=$offs, cind=$cind, xsiz=$xsiz, xstart=$xstart, bb=$bb"
if {$q(-usetopframe)} {
set wl [string trimright [winfo toplevel $w] .]._list
} else {
set wl $w._list
}
if {[winfo exists $wl]} {
destroy $wl
focus -force $w
$w style activate 0
return
}
event generate $w <<TreeViewEditStart>> -x $cind -y $ind
$w style activate focus $cind
focus $w
if {$q(-useframe) || $q(-usetopframe)} {
canvas $wl
if {$q(-leave)} {
bind $wl <Leave> { ::blt::tv::Combobox-List-Close %W }
}
} else {
toplevel $wl
wm withdraw $wl
wm transient $wl [winfo toplevel $w]
raise [winfo toplevel $w]
wm overrideredirect $wl 1
if {$q(-leave)} {
bind $wl <Leave> { if {[winfo toplevel %W] == "%W"} { ::blt::tv::Combobox-List-Close %W } }
}
}
set h $q(-height)
if {[llength $lst]<=$h} {
set h [expr {1+[llength $lst]}]
}
set opts [concat -height $h $opts]
set l $wl._l
listbox $l
foreach {i j} $opts {
catch { $l conf $i $j }
}
if {$q(-conf) != {}} {
catch { eval $l conf $q(-conf) }
}
bindtags $l [concat [bindtags $l] TVComboBox::List]
$l conf -yscrollcommand [list $wl._vscroll set]
scrollbar $wl._vscroll -orient vertical -command [list $l yview]
if {[llength $lst]>$h} {
grid $wl._vscroll -row 1 -column 2 -sticky ns
}
grid $l -row 1 -column 1 -sticky news
grid columnconf $wl 1 -weight 1
grid rowconf $wl 1 -weight 1
set val [$w get]
foreach i $lst {
$l insert end $i
if {[string equal $i $val]} { $l activate end; $l see end }
}
bind $l <Visibility> [subst -nocommands {
bind $l <Visibility> {}
if {[$l xview] != "0 1"} {
$l conf -xscrollcommand [list $wl._hscroll set]
scrollbar $wl._hscroll -orient horizontal -command [list $wl xview]
grid $wl._hscroll -row 2 -column 1 -sticky we
grid $wl._vscroll -row 1 -column 2 -sticky ns
focus -force $l
}
}]
bind $l <<TVComboBox-List-Done>> [list [namespace current]::Combobox-List-Done $l $entry $col]
set H [winfo reqheight $l]
set Xstart [expr {$xstart+[winfo x $w]}]
set Yend [expr {$yend+[winfo x $w]}]
set wwhig [winfo height $w]
if {!(($ystart+$H) <= $wwhig || ($ystart-$H)<0)} {
set Yend [expr {$ystart-$H}]
}
if {$q(-usetopframe)} {
place $wl -in $w -width ${xsiz} -height $H -x $Xstart -y $Yend
$wl conf -width $xsiz -height $H
} elseif {$q(-useframe)} {
place $wl -in $w -width ${xsiz} -height $H -x $Xstart -y $Yend
$wl conf -width $xsiz -height $H
} else {
wm geometry $wl ${xsiz}x${H}+$Xstart+$Yend
wm deiconify $wl
}
$w edit -noscroll
if {$q(-usetopframe)} {
bind $e <Destroy> +[list catch "$wl edit -scroll" ]
} else {
set tag [namespace current]
bindtags $wl [concat $tag [bindtags $wl]]
bind $tag <Destroy> {catch {[winfo parent %W] edit -scroll}}
}
after idle [list catch "focus -force $l"]
return -code break
}
proc ::blt::tv::Combobox-List-Key {l ch args} {
# Navigate to the first item starting with char ch.
array set p { -now 0 }
array set p $args
if {![string is alpha -strict $ch]} return
set cur [$l index active]
set e [$l index end]
foreach i {0 1} {
set n -1
while {[incr n]<$e} {
set c [string index [$l get $n] 0]
if {$i} { set c [string toupper $c] }
if {[string equal $c $ch]} {
$l activate $n
$l see $n
if {$n == $cur || $p(-now)} {
event generate $l <Return>
}
return
}
}
set ch [string toupper $ch]
}
return -code break
}
proc ::blt::tv::SortColumn {t {column {}} args} {
# Provide sorting for a column.
array set p {-hold 1 -see 1 -highlight 0}
array set p $args
set do 1
if {$column == {}} {
set column [$t column current]
}
if {[string equal $column [$t sort cget -column]]} {
set decr [expr {![$t sort cget -decreasing]}]
if {!$decr} {
$t sort conf -column {} -decreasing 0
if {[$t sort cget -setflat] } {
$t configure -flat no
$t sort configure -setflat no
}
set do 0
}
} else {
set decr 0
}
if {$do} {
set mode [$t column cget $column -sortmode]
if {$mode != "none"} {
$t sort configure -mode $mode
}
$t sort configure -decreasing $decr -column $column
if {![$t cget -flat] } {
$t configure -flat yes
$t sort configure -setflat yes
}
$t sort auto yes
if {$p(-hold)} {
blt::busy hold $t
update
blt::busy release $t
}
if {$p(-highlight)} {
after 300 [list $t column activate $column]
}
} else {
if {$p(-highlight)} {
$t column activate {}
}
}
if {$p(-see)} {
set sel [$t curselection]
if {$sel != {}} {
after idle [list $t see [lindex $sel 0]]
}
}
set cind [$t column index $column]
event generate $t <<TreeViewSortColumn>> -x $cind
}
bind TVComboBox <3> [list blt::tv::Combobox-List %W %x %y]
bind TVComboBox::List <Enter> { focus -force %W }
bind TVComboBox::List <KeyRelease-Escape> { destroy [winfo parent %W] }
bind TVComboBox::List <Return> { event generate %W <<TVComboBox-List-Done>>}
bind TVComboBox::List <space> [bind TVComboBox::List <Return>]
bind TVComboBox::List <ButtonRelease-1> [bind TVComboBox::List <Return>]
bind TVComboBox::List <KeyRelease-space> [bind TVComboBox::List <Return>]
bind TVComboBox::List <Control-n> [bind Listbox <Down>]
bind TVComboBox::List <Control-p> [bind Listbox <Up>]
bind TVComboBox::List <Control-d> [bind Listbox <Next>]
bind TVComboBox::List <Control-u> [bind Listbox <Prior>]
bind TVComboBox::List <KeyPress> [list blt::tv::Combobox-List-Key %W %A]
proc blt::tv::SetSelectionAnchor { w tagOrId } {
if {$tagOrId == ""} return
set index [$w index $tagOrId]
# If the anchor hasn't changed, don't do anything
if { $index != [$w index anchor] } {
$w selection clearall
$w see $index
$w focus $index
$w selection set $index
$w selection anchor $index
}
}
proc blt::tv::SetSelectionSetAnchor { w x y} {
set mode [$w cget -selectmode]
switch -- $mode {
none return
cell { }
multicell {}
default {
set blt::tv::x $x
set blt::tv::y $y
SetSelectionAnchor $w @$x,$y
return
}
}
$w selection clearall
set index [$w index @$x,$y]
set col [$w column nearest $x]
if {$index != {} && $col != {}} {
$w selection set $index $index $col
$w selection anchor $index $col
$w focus $index
}
}
proc blt::tv::SetSelectionAdd {w x y} {
set mode [$w cget -selectmode]
set index [$w index @$x,$y]
switch -- $mode {
none return
cell { $w selection clearall }
multicell { }
multiple {
set index [$w index current]
$w selection toggle $index
$w selection anchor $index
return
}
default {
SetSelectionAnchor $w current
return
}
}
set col [$w column nearest $x]
if {$index != {} && $col != {}} {
$w selection toggle $index $index $col
}
}
proc blt::tv::SetSelectionExtendAnchor {w x y} {
set mode [$w cget -selectmode]
switch -- $mode {
none {}
multiple {
if {[$w selection present] } {
if { [$w index anchor] == "" } {
$w selection anchor current
}
set index [$w index anchor]
$w selection clearall
$w selection set $index current
}
}
single {
blt::tv::SetSelectionAnchor $w current
}
cell {
SetSelectionSetAnchor $w $x $y
}
multicell {
# Select range.
set col [$w column nearest $x]
set oanch [$w selection anchor]
set anch [$w index anchor]
set ocell [lindex $oanch 1]
set index [$w index @$x,$y]
if {$col == {} || $ocell == {}} {
return [SetSelectionSetAnchor $w $x $y]
}
set cols [$w column names]
set coli [lsearch $cols $col]
set ocelli [lsearch $cols $ocell]
if {$coli<0 || $ocelli<0} {
return [SetSelectionSetAnchor $w $x $y]
}
if {$coli<$ocelli} {
set sci $coli
set coli $ocelli
set ocelli $sci
}
set clst {}
foreach c [lrange $cols $ocelli $coli] {
if {$c == "#0"} continue
if {[$w column cget $c -hide]} continue
lappend clst $c
}
set nlst {}
foreach n [$w find $index $anch] {
if {[$w entry cget $n -hide]} continue
lappend nlst $n
}
$w selection clearall
foreach n $nlst {
foreach c $clst {
$w selection set $n $n $c
}
}
}
}
}
# ----------------------------------------------------------------------
#
# AutoScroll --
#
# Invoked when the user is selecting elements in a treeview
# widget and drags the mouse pointer outside of the widget.
# Scrolls the view in the direction of the pointer.
#
# ----------------------------------------------------------------------
proc blt::tv::AutoScroll { w } {
if { ![winfo exists $w] } {
return
}
set x $blt::tv::x
set y $blt::tv::y
set index [$w nearest $x $y]
if {$y >= [winfo height $w]} {
$w yview scroll 1 units
set neighbor down
} elseif {$y < 0} {
$w yview scroll -1 units
set neighbor up
} else {
set neighbor $index
}
if { [$w cget -selectmode] == "single" } {
blt::tv::SetSelectionAnchor $w $neighbor
} elseif { [$w cget -selectmode] != "none" } {
catch {$w selection mark $index}
}
set ::blt::tv::afterId [after 50 blt::tv::AutoScroll $w]
}
proc blt::tv::SetFocus { w tagOrId } {
# Set focus at index given by tagOrId.
if {[catch {$w index $tagOrId} t]} return
if {[catch {$w focus $t}]} return
$w selection clearall
if {[catch {$w selection set $t}]} return
$w selection anchor $t
$w entry activate $t
$w see $t
event generate $w <<TreeViewFocusEvent>>
return $t
}
# ----------------------------------------------------------------------
#
# MoveFocus --
#
# Invoked by KeyPress bindings. Moves the active selection to
# the entry <where>, which is an index such as "up", "down",
# "prevsibling", "nextsibling", etc.
#
# ----------------------------------------------------------------------
proc blt::tv::MoveFocus { w tagOrId {flag 0}} {
set mode [$w cget -selectmode]
switch -- $mode {
multiple {
catch {$w focus $tagOrId}
if {!$flag} {
$w selection clearall
}
if {[catch {$w selection set focus}]} return
$w selection anchor focus
}
single {
catch {$w focus $tagOrId}
$w selection clearall
if {[catch {$w selection set focus}]} return
$w selection anchor focus
}
multicell -
cell {
set cells [$w selection cells]
catch {$w focus $tagOrId}
$w selection clearall
if {[catch {$w selection set focus}]} return
$w selection anchor focus
set ind [$w index focus]
if {$cells != {}} {
set col [lindex $cells 1]
} else {
set vcols [$w column names -visible]
set col [lindex $vcols 0]
}
$w selection set focus focus $col
}
}
$w see focus
event generate $w <<TreeViewFocusEvent>>
}
# ----------------------------------------------------------------------
#
# MovePage --
#
# Invoked by KeyPress bindings. Pages the current view up or
# down. The <where> argument should be either "top" or
# "bottom".
#
# ----------------------------------------------------------------------
proc blt::tv::MovePage { w where } {
# If the focus is already at the top/bottom of the window, we want
# to scroll a page. It's really one page minus an entry because we
# want to see the last entry on the next/last page.
set focus [$w index focus]
if {$where == "top"} {
if {[$w index up] != $focus} {
$w yview scroll -1 pages
$w yview scroll 1 units
}
if {[$w index focus] == $focus} {
catch { $w entry select up }
}
} else {
if {[$w index down] != $focus} {
$w yview scroll 1 pages
$w yview scroll -1 units
}
if {[$w index focus] == $focus} {
catch { $w entry select down }
}
}
update
# Adjust the entry focus and the view. Also activate the entry.
# just in case the mouse point is not in the widget.
$w entry activate view.$where
$w focus view.$where
$w see view.$where
if { [$w cget -selectmode] == "single" } {
$w selection clearall
catch {$w selection set focus}
}
event generate $w <<TreeViewFocusEvent>>
}
# ----------------------------------------------------------------------
#
# NextMatch --
#
# Invoked by KeyPress bindings. Searches for an entry that
# starts with the letter <char> and makes that entry active.
#
# ----------------------------------------------------------------------
proc blt::tv::NextMatch { w key state} {
if {$state != 0 && $state != 1} return
if {[string match {[ -~]} $key]} {
set last [$w index focus]
set next [$w index next]
while { $next != {} && $next != $last } {
set label [$w entry cget $next -label]
set label [string index $label 0]
if { [string tolower $label] == [string tolower $key] } {
break
}
set next [$w index -at $next next]
}
if {$next == {}} return
$w focus $next
if {[$w cget -selectmode] == "single"} {
$w selection clearall
$w selection set focus
event generate $w <<TreeViewFocusEvent>>
}
$w see focus
}
}
#------------------------------------------------------------------------
#
# InsertText --
#
# Inserts a text string into an entry at the insertion cursor.
# If there is a selection in the entry, and it covers the point
# of the insertion cursor, then delete the selection before
# inserting.
#
# Arguments:
# w Widget where to insert the text.
# text Text string to insert (usually just a single character)
#
#------------------------------------------------------------------------
proc blt::tv::InsertText { w text } {
if { [string length $text] > 0 } {
set index [$w index insert]
if { ($index >= [$w index sel.first]) &&
($index <= [$w index sel.last]) } {
$w delete sel.first sel.last
}
$w insert $index $text
}
}
#------------------------------------------------------------------------
#
# Transpose -
#
# This procedure implements the "transpose" function for entry
# widgets. It tranposes the characters on either side of the
# insertion cursor, unless the cursor is at the end of the line.
# In this case it transposes the two characters to the left of
# the cursor. In either case, the cursor ends up to the right
# of the transposed characters.
#
# Arguments:
# w The entry window.
#
#------------------------------------------------------------------------
proc blt::tv::Transpose { w } {
set i [$w index insert]
if {$i < [$w index end]} {
incr i
}
set first [expr {$i-2}]
if {$first < 0} {
return
}
set new [string index [$w get] [expr {$i-1}]][string index [$w get] $first]
$w delete $first $i
$w insert insert $new
}
#------------------------------------------------------------------------
#
# GetSelection --
#
# Returns the selected text of the entry with respect to the
# -show option.
#
# Arguments:
# w Entry window from which the text to get
#
#------------------------------------------------------------------------
proc blt::tv::GetSelection { w } {
set text [string range [$w get] [$w index sel.first] \
[expr {[$w index sel.last] - 1}]]
if {[$w cget -show] != ""} {
regsub -all . $text [string index [$w cget -show] 0] text
}
return $text
}
proc blt::tv::TextCopy {w {edit 0} {aslist 0}} {
# Handle <<Copy>> event, copying selection/focus to clipboard.
if {!$edit} {
catch {
set inds [$w curselection]
if {$inds == {}} {
set inds [$w index focus]
}
set all {}
set n -1
foreach ind $inds {
incr n
set data {}
foreach i [$w column names] {
if {[$w col cget $i -hid]} continue
if {$i == "#0"} {
set val [$w entry cget $ind -label]
} else {
set val [$w entry set $ind $i]
}
if {$aslist} {
lappend data $val
} else {
append data " " $val
}
}
if {$aslist} {
lappend all $data
} else {
if {$n} { append all \n }
append all $data
}
}
clipboard clear -displayof $w
clipboard append -displayof $w $all
}
} else {
catch {
set w [winfo parent $w]
set ind [$w index focus]
set col [$w column current]
if {$col == {}} {
set col $::blt::tv::curCol
}
set data [$w entry set $ind $col]
clipboard clear -displayof $w
clipboard append -displayof $w $data
}
}
}
proc ::blt::tv::Toggle {w ind} {
# Toggle and set view.
set ind [$w index $ind]
if {$ind == {}} return
$w toggle $ind
if {[$w entry isopen $ind] && [$w cget -openanchor] != {} && [$w entry children $ind] != {}} {
$w see -anchor [$w cget -openanchor] $ind
} else {
$w see $ind
}
}
proc ::blt::tv::Click {w x y} {
if {[focus] != $w} { focus $w }
set ::blt::tv::space off
#if {[winfo exists $w.edit]} { destroy $w.edit }
event generate $w <<TreeViewFocusEvent>>
}
bind $className <ButtonRelease-1> {::blt::tv::Click %W %x %y}
bind $className <Double-ButtonPress-1> {blt::tv::EditCol %W %x %y }
bind $className <Alt-ButtonPress-1> {blt::tv::EditCol %W %x %y }
bind $className <Control-minus> {if {[%W index parent]>0} { after idle "%W entry select [%W entry parent focus]"; %W close [%W entry parent focus] }}
bind $className <Control-o> { ::blt::tv::Toggle %W focus }
bind $className <Control-a> { blt::tv::MoveFocus %W parent }
bind $className <Control-Shift-O> { %W open -recurse focus }
bind $className <Control-Shift-C> { %W close -recurse focus }
bind TreeViewEditWin <KeyRelease-Escape> {focus [winfo parent %W]; destroy %W; break}
bind TreeViewEditWin <KeyPress-Return> {event generate %W <<TreeViewEditComplete>>; break}
#bind TreeViewEditWin <KeyPress-Return> {break}
proc ::blt::tv::EditDone {w e x y ind col cind data styledata cellstyle ied endcmd treelabel vcmd} {
# # Handle edit completion: call $endcmd and widget -vcmd if req.
switch -- [winfo class $e] {
Entry - Spinbox {
set newdata [$e get]
}
Text {
set newdata [string trimright [$e get 1.0 end]]
}
default {
set newdata $data
}
}
# Invoke validation for Entry/Spinbox/Text if string changed.
set ok 1
if {![string equal $data $newdata]} {
if {$vcmd == {}} {
set vcmd [$w column cget $col -validatecmd]
}
if {$vcmd != {}} {
if {[string first % $vcmd]>=0} {
set ccmd [string map [list %% % %W $w %X $x %Y $y %# $ind %C $cind %V [list $newdata]] $vcmd]
} else {
set ccmd [concat $vcmd [list $w $newdata $data $ind $col]]
}
set newdata [namespace eval :: $ccmd]
}
if {![winfo exists $w]} return
}
if {![string equal $data $newdata]} {
set istree [$w column istree $cind]
if {$ind == -1} {
$w col conf $cind -title $newdata
} elseif {$istree} {
if {$treelabel} {
[$w cget -tree] label $ind $newdata
} else {
$w entry conf $ind -label $newdata
}
} else {
if {$styledata != {}} {
set newdata [list $styledata $newdata]
}
$w entry set $ind $col $newdata
}
if {$endcmd != {}} {
if {[string first % $endcmd]>=0} {
set ccmd [string map [list %% % %W $w %X $x %Y $y %# $ind %C $cind %V [list $newdata]] $endcmd]
set ccmd [concat $endcmd [list $w $newdata $data $ind $col]]
}
namespace eval :: $ccmd
}
if {![winfo exists $w]} return
event generate $w <<TreeViewEditEnd>> -x $cind -y $ind
}
if {$ied} {
catch { bind $e <Destroy> {} }
$w style set $cellstyle $col $ind
} else {
catch { place forget $e }
}
destroy $e
catch { focus $w }
#after idle [list destroy $e]
}
proc ::blt::tv::TabMove {w ind cind args} {
# Handle Tab char.
#Opts p $args {
# { -cmd {} "Callback to get next cell" -type {cmd ind cind} }
# { -endcol {} "Maximum column (defaults to last col)" }
# { -startcol 0 "Column to start new row at" }
# { -wrap True "At last row return to top" }
#}
array set p { -cmd {} -endcol {} -startcol 0 -wrap True -opts {}}
array set p $args
set vis [$w column names -visible]
set maxc [expr {[llength $vis]-1}]
if {$p(-endcol) == {} || $p(-endcol) > $maxc} {
set p(-endcol) $maxc
}
set maxr [$w index end]
if {$p(-cmd) != {}} {
set ncol [eval $p(-cmd) $ind,$cind]
if {$ncol == {}} return
foreach {ind col} $ncol break
EditCell $w $ind $col
return
}
set down [expr {$p(-wrap)?"next":"down"}]
set cnt 100
while 1 {
if {[incr cnt -1] == 0} return
incr cind 1
if {$cind > $p(-endcol)} {
set cind $p(-startcol)
set ind [$w index $down]
$w focus $ind
}
if {[$w column cget $cind -edit] && ![$w column cget $cind -hide]} break
}
EditCell $w $ind $cind
return
}
proc ::blt::tv::EditCell { w ind col {x {}} {y {}}} {
# Handle text editing of a cell.
if {![winfo exists $w]} return
# Option choices for -editopts.
set Opts {
{ -allowtypes textbox "List of types to allow text editing for (or *)" }
{ -autonl False "Default to text widget if newlines in data"}
{ -choices {} "Choices for combo/spinbox" }
{ -conf {} "Extra entry/text widget options to set" }
{ -embed False "Use an embedded window style for edit window" }
{ -endcmd {} "Command to invoke at end of edit" -type cmd }
{ -leafs False "Edit only leaf nodes" }
{ -nlkeys {<Control-r> <Shift-Return>} "Keys for inserting newline" }
{ -notnull False "Field may not be null" }
{ -optscmd {} "Callback to get edit options" -type {cmd w r c} }
{ -readonly False "Do not allow editing" }
{ -sel True "Value is selected on edit" }
{ -startcmd {} "Command to invoke at start of edit" -type {cmd w r c} }
{ -tab {} "bind Tab char in edit (bool or args passed to TabMove)" }
{ -titles False "Allow edit of titles" }
{ -treelabel True "Edit -tree cmd label rather than treeview label" }
{ -type {} "Support basic Wize types like bool, int, and choice" }
{ -typecol {} "Column/key to get -type from" }
{ -undo True "Text widget enables undo" }
{ -vcmd {} "Validate command to override -validatecmd" -type cmd }
{ -widget {} "Widget to use (defaults to entry)" }
{ -withouttag {} "Edit only entries without tag"}
{ -withtag {} "Edit only entries with tag"}
{ -wrap none "Wrap mode for text widget" }
}
if {[winfo exists $w._list]} return
$w see current
set e $w.edit
if { [winfo exists $e] } { destroy $e }
set ind [$w index $ind]
set cind [$w column index $col]
set ed [$w column cget $col -edit]
if { !$ed } return
set intitle 0
if {$x == {}} {
set bb [$w col bbox $col $ind]
set x [lindex $bb 0]
set y [lindex $bb 1]
}
set istree [$w column istree $col]
set edopts {}
foreach i $Opts {
set q([lindex $i 0]) [lindex $i 1]
lappend edopts [lindex $i 0] [lindex $i 1]
}
set widopts [$w column cget $col -editopts]
set cellstyle [lindex [$w style get $cind $ind] 0]
if {$cellstyle != {}} {
if {[$w style cget $cellstyle -readonly]} return
set widopts [concat $widopts [$w style cget $cellstyle -editopts]]
}
if {$widopts != {}} {
if {[llength $widopts]%2} {
tclLog "TreeView -editopts: odd length: '$widopts' for $w"
} else {
array set q $widopts
if {$q(-optscmd) != {}} {
set ewopts [eval $q(-optscmd) $w $ind $col]
if {[llength $ewopts]%2} {
tclLog "TreeView -optscmd: odd length: '$ewopts' for $w"
} else {
array set q $ewopts
}
}
if {[array size q] != ([llength $edopts]/2)} {
set bad {}
array set r $edopts
set good [lsort [array names r]]
foreach {i j} $widopts {
if {![info exists r($i)]} { lappend bad $i }
}
tclLog "TreeView -editopts: bad option: '$bad' not in '$good'"
}
}
}
if {$q(-typecol) != {} && $q(-type) == {}} {
if {[catch { set q(-type) [$w entry set $ind $q(-typecol)] }] &&
[catch { set q(-type) [[$w cget -tree] get $ind $q(-typecol)] }]} {
tclLog "Failed to get -typecol $q(-typecol)"
}
}
set wopts {}
if {$q(-type) != {}} {
switch -- [lindex $q(-type) 0] {
bool {
set q(-choices) {"" True False}
set q(-widget) spinbox
}
Bool {
lset q(-choices) {True False}
set q(-widget) spinbox
}
int - Int -
double - Double {
array set qq {-min -999999999 -max 99999999 -incr 1}
array set qq [lrange $q(-type) 1 end]
set wopts [list -from $qq(-min) -to $qq(-max) -increment $qq(-incr)]
set q(-widget) spinbox
}
Choice {
set q(-choices) [lrange $q(-type) 1 end]
set q(-widget) spinbox
}
}
}
if {$q(-readonly)} return
if {!$q(-titles) && [set intitle [expr {[$w column nearest $x $y] != {}}]]} return
if {$q(-leafs) && [llength [$w entry children $ind]]} return
set tags [$w tag names $ind]
if {$q(-withtag) != {}} {
if {[lsearch -exact $tags $q(-withtag)]<0} return
}
if {$q(-withouttag) != {}} {
if {[lsearch -exact $tags $q(-withouttag)]>=0} return
}
set styledata {}
if {$intitle} {
set data [$w column cget $col -title]
set ind -1
} elseif {$istree } {
if {$q(-treelabel) && [namespace which [$w cget -tree]] == {}} {
set q(-treelabel) 0
}
if {$q(-treelabel)} {
set data [[$w cget -tree] label $ind]
} else {
set data [$w entry cget $ind -label]
}
} else {
set data [$w entry set $ind $col]
if {[$w cget -inlinedata] && [string first @ $data]>=0} {
if {![catch {llength $data} len] && $len <= 2 &&
[string match @?* [lindex $data 0]] &&
[lsearch -exact [$w style names] [string range [lindex $data 0] 1 end]]>=0} {
#set styledata [lindex $data 0]
set data [lindex $data 1]
}
}
}
set bbox [$w column bbox -visible $col $ind]
if {![llength $bbox]} return
foreach {X Y W H} $bbox break
set wid entry
set style [$w col cget $cind -style]
set rstyle [expr {$cellstyle == {} ? $style : $cellstyle }]
set stype [expr {$rstyle == {} ? {} : [$w style type $rstyle]}]
#if {[$w style cget $style -readonly]} return
if {[lsearch $q(-allowtypes) $stype]<0 && $q(-allowtypes) != "*"} return
if {$widopts != {}} {
if {$q(-widget) != {}} {
set wid $q(-widget)
} elseif {$q(-autonl)} {
if {$stype == "combobox"} {
set wid spinbox
} elseif {[string first \n $data]>=0} {
set wid text
} else {
set wid entry
}
}
}
if {[catch {eval $wid $e} err]} {
entry $e
}
foreach {i j} $wopts {
catch { $e conf $i $j}
}
catch { $e conf -font [$w cget -font] }
set ied 0
if {$q(-embed) && !$istree} {
catch {$w style create windowbox editwin}
if {$bbox != {}} {
#TODO: embedded should temporarily set col width, if currently is 0.
set mwid $W
if {$mwid>16} { incr mwid -10 }
set mhig $H
$w style conf editwin -minheight $mhig -minwidth $mwid
}
$w style set editwin $cind $ind
$w entry set $ind $col $e
bind $e <Destroy> [list $w entry set $ind $col $data]
bind $e <Destroy> +[list $w style set $cellstyle $col $ind]
set ied 1
} else {
place $e -x $X -y $Y -width $W -height $H
}
switch -- [winfo class $e] {
Entry {
$e insert end $data
if {$q(-sel)} { $e selection range 0 end }
foreach i $q(-nlkeys) {
bind $e $i "$e insert insert {\n}; break"
}
}
Spinbox {
$e insert end $data
if {$q(-choices) != {}} {
$e conf -values $q(-choices)
}
if {$q(-sel)} { $e selection range 0 end }
set style [$w col cget $cind -style]
if {$stype == "combobox"} {
set ch [$w style cget $style -choices]
if {$ch == {} && [set ccmd [$w style cget $style -choicecmd]] != {}} {
set ccmd [string map [list %% % %W $w %X $x %Y $y %# $ind %C $cind] $ccmd]
set ch [namespace eval :: $ccmd]
}
if {$ch != {}} {
if {[set nn [lsearch -exact $ch $data]]<0} {
set ch [concat [list $data] $ch]
} elseif {$n != 0} {
set ch [concat [list $data] [lreplace $ch $nn $nn]]
}
$e conf -values $ch
}
}
foreach i $q(-nlkeys) {
bind $e $i "$e insert insert {\n}; break"
}
}
Text {
$e conf -highlightthick 0 -padx 0 -pady 0 -bd 1
$e conf -undo $q(-undo) -wrap $q(-wrap)
$e insert end $data
if {$q(-sel)} { $e tag add sel 1.0 end }
foreach i $q(-nlkeys) {
bind $e $i "$e insert insert {\n}; $e see insert; break"
}
}
}
catch {$e conf -highlightthick 0}
if {$q(-conf) != {}} {
if {[catch {eval $e conf $q(-conf)} err]} {
tclLog "Opts err: $err"
}
}
bind $e <1> [list focus $e]
bindtags $e [concat TreeViewEditWin [bindtags $e]]
tkwait visibility $e
focus $e
after 100 [list catch [list focus $e]]
after 300 [list catch [list focus $e]]
bind $e <<TreeViewEditComplete>> [list ::blt::tv::EditDone $w $e $x $y $ind $col $cind $data $styledata $cellstyle $ied $q(-endcmd) $q(-treelabel) $q(-vcmd)]
if {![string is false $q(-tab)]} {
set topts {}
if {![string is true $q(-tab)]} {
set topts $q(-tab)
}
bind $e <Tab> "event generate $e <<TreeViewEditComplete>>; [namespace current]::TabMove $w $ind $cind $topts; break"
}
event generate $w <<TreeViewEditStart>> -x $cind -y $ind
if {[winfo exists $e] && $q(-startcmd) != {}} {
if {[string first % $vcmd]>=0} {
set ccmd [string map [list %% % %W $w %X $x %Y $y %# $ind %C $cind %V [list $data]] $q(-startcmd)]
} else {
set ccmd [concat $q(-startcmd) [list $w $col $ind] ]
}
namespace eval :: $ccmd
}
if {![winfo exists $e]} return
$w edit -noscroll
set tag [namespace current]
bindtags $e [concat $tag [bindtags $e]]
bind $tag <Destroy> { catch {[winfo parent %W] edit -scroll} }
return
}
proc ::blt::tv::commify {num {sep ,}} {
# Make number comma seperated every 3 digits.
while {[regsub {^([-+]?\d+)(\d\d\d)} $num "\\1$sep\\2" num]} {}
return $num
}
proc ::blt::tv::EditCol { w x y } {
# Main handler for cell-edit/toggle-open.
if {![winfo exists $w]} return
$w see current
set e $w.edit
if { [winfo exists $e] } { destroy $e }
set ::blt::tv::curCol [set col [$w column nearest $x]]
if {$col == {}} return
set cind [$w column index $col]
set ind [$w index @$x,$y]
if { ![$w column cget $col -edit] } {
if {$cind == 0} {
Toggle $w $ind
}
return
} elseif {$cind == 0} {
set object {}
$w nearest $x $y object
if {$object != "label"} {
Toggle $w $ind
return
}
}
EditCell $w $ind $col $x $y
}
proc blt::tv::EditColumn { w x y } {
# Old edit function.
$w see current
if { [winfo exists $w.edit] } {
destroy $w.edit
}
set col [$w column current]
if {$col == {}} return
set ::blt::tv::curCol $col
if { ![$w edit -root -test $x $y] } {
return
}
set ind [$w index @$x,$y]
if {$ind == {}} return
set data [$w entry set $ind $col]
$w edit -root $x $y
update
focus $w.edit
$w.edit selection range 0 end
event generate $w <<TreeViewEditStart>> -x $x -y $y
grab set $w.edit
tkwait window $w.edit
grab release $w.edit
if {[winfo exists $w]} {
event generate $w <<TreeViewEditEnd>> -x $x -y $y
}
}
proc ::blt::tv::SortTree {t column {ind {}} {uselabel 1} {see 1}} {
# Sort the children of tree.
set istree [$t column istree $column]
if {$ind == {}} {
set ind [lindex [$t curselection] 0]
if {$ind == {}} {
if {$istree} { set ind 0 } else { set ind focus }
}
}
set ind [$t index $ind]
set clst [$t entry children $ind]
if {$clst == {}} return
set slst {}
foreach i $clst {
if {$istree} {
set txt [expr {$uselabel?[$t entry cget $i -label]:[$t get $i]}]
} else {
set txt [$t entry set $i $column]
}
lappend slst [list $txt $i]
}
if {[set decreasing [$t sort cget -decreasing]]} {
set dec -decreasing
} else {
set dec -increasing
}
#set decreasing [expr {!$decreasing}]
#$t sort conf -decreasing $decreasing
set mode [$t column cget $column -sortmode]
if {$mode == "none"} {
set mode [$t sort cget -mode]
}
if {$mode == "none"} return
if {$mode == "command"} {
set slst [lsort $dec -command [$t column cget $column -sortcommand] $slst]
} else {
set slst [lsort $dec -$mode $slst]
}
foreach i $slst {
set oi [lindex $i 1]
$t move $oi into $ind
}
if {$see} {
set sel [$t curselection]
if {$sel != {}} {
after idle [list $t see [lindex $sel 0]]
}
}
set cind [$t column index $column]
event generate $t <<TreeViewSortTree>> -x $cind -y $ind
}
#
# ButtonPress assignments
#
# B1-Enter start auto-scrolling
# B1-Leave stop auto-scrolling
# ButtonPress-2 start scan
# B2-Motion adjust scan
# ButtonRelease-2 stop scan
#
bind ${className} <ButtonPress-2> {
focus %W
}
bind ${className} <ButtonPress-2> {
set blt::tv::cursor [%W cget -cursor]
%W configure -cursor hand1
%W scan mark %x %y
}
bind ${className} <B2-Motion> {
catch { %W scan dragto %x %y }
}
bind ${className} <ButtonRelease-2> {
catch { %W configure -cursor $blt::tv::cursor }
}
bind ${className} <B1-Leave> {
if { $blt::tv::scroll } {
blt::tv::AutoScroll %W
}
}
bind ${className} <B1-Enter> {
after cancel $blt::tv::afterId
}
#
# KeyPress assignments
#
# Up
# Down
# Shift-Up
# Shift-Down
# Prior (PageUp)
# Next (PageDn)
# Left
# Right
# space Start selection toggle of entry currently with focus.
# Return Start selection toggle of entry currently with focus.
# Home
# End
# F1
# F2
# ASCII char Go to next open entry starting with character.
#
# KeyRelease
#
# space Stop selection toggle of entry currently with focus.
# Return Stop selection toggle of entry currently with focus.
bind ${className} <KeyPress-Up> {
blt::tv::MoveFocus %W up
if { $blt::tv::space } {
%W selection toggle focus
}
}
bind ${className} <KeyPress-Down> {
blt::tv::MoveFocus %W down
if { $blt::tv::space } {
%W selection toggle focus
}
}
bind ${className} <Control-KeyPress-n> [bind ${className} <KeyPress-Down>]
bind ${className} <Control-KeyPress-p> [bind ${className} <KeyPress-Up>]
bind ${className} <Shift-KeyPress-Up> {
blt::tv::MoveFocus %W up 1
}
bind ${className} <Shift-KeyPress-Down> {
blt::tv::MoveFocus %W down 1
}
bind ${className} <KeyPress-Prior> {
blt::tv::MovePage %W top
}
bind ${className} <KeyPress-Next> {
blt::tv::MovePage %W bottom
}
bind ${className} <Control-KeyPress-d> [bind ${className} <KeyPress-Next>]
bind ${className} <Control-KeyPress-u> [bind ${className} <KeyPress-Prior>]
#bind ${className} <KeyPress-Left> {
# %W close focus
#}
#bind ${className} <KeyPress-Right> {
# %W open focus
# %W see focus -anchor w
#}
proc blt::tv::MoveKey {w cnt} {
set mode [$w cget -selectmode]
set iscell [expr {$mode == "cell" || $mode == "multicell"}]
if {!$iscell} { return [$w xview scroll $cnt unit] }
set cells [$w selection cells]
if {$cells != {}} {
set vcols [$w col names -visible]
foreach {ind col} $cells break
set cind [lsearch $vcols $col]
if {$cind >= 0} {
set cind [expr {$cind+$cnt}]
if {$cind>=[llength $vcols]} {
set cind [expr {[llength $vcols]-1}]
} elseif {$cind < 0} {
set cind 0
}
set ncol [lindex $vcols $cind]
$w selection clearall
$w selection set $ind $ind $ncol
$w column see $ncol
}
}
}
proc blt::tv::MarkPos {w} {
if { [$w cget -selectmode] == "single" } {
if { [$w selection includes focus] } {
$w selection clearall
} else {
$w selection clearall
$w selection set focus
}
} elseif { [$w cget -selectmode] != "none" } {
$w selection toggle focus
}
set blt::tv::space on
}
bind ${className} <KeyPress-Left> { blt::tv::MoveKey %W -1}
bind ${className} <KeyPress-Right> { blt::tv::MoveKey %W 1}
#bind ${className} <KeyPress-Left> { %W xview scroll -1 unit}
#bind ${className} <KeyPress-Right> { %W xview scroll 1 unit}
bind ${className} <Control-KeyPress-Left> { %W xview scroll -1 page}
bind ${className} <Control-KeyPress-Right> { %W xview scroll 1 page}
bind ${className} <KeyPress-space> { catch {blt::tv::MarkPos %W } }
bind ${className} <KeyRelease-space> {
set blt::tv::space off
}
#bind ${className} <KeyPress-Return> {
# blt::tv::MoveFocus %W focus
# set blt::tv::space on
#}
#bind ${className} <KeyRelease-Return> {
# set blt::tv::space off
#}
bind ${className} <KeyPress-Return> {
#set blt::tv::space on
blt::tv::Toggle %W focus
#set blt::tv::space off
}
bind ${className} <KeyRelease-Return> {
#set blt::tv::space off
}
bind ${className} <KeyPress> {
blt::tv::NextMatch %W %A %s
}
bind ${className} <KeyPress-Home> {
blt::tv::MoveFocus %W top
}
bind ${className} <KeyPress-End> {
blt::tv::MoveFocus %W bottom
}
bind ${className} <Control-F1> {
%W open -trees root
}
bind ${className} <Control-F2> {
eval %W close -trees root
}
bind ${className} <Control-F3> {
%W conf -flat [expr {![%W cget -flat]}]
}
bind ${className} <Control-F4> {
eval %W col conf [%W col names] -width 0
}
bind ${className} <MouseWheel> {
if {%D >= 0} {
%W yview scroll [expr {-%D/30}] units
} else {
%W yview scroll [expr {(2-%D)/30}] units
}
}
if {[tk windowingsystem] == "x11"} {
bind ${className} <4> { %W yview scroll -3 unit }
bind ${className} <5> { %W yview scroll 3 unit }
}
#
# Differences between id "current" and operation nearest.
#
# set index [$w index current]
# set index [$w nearest $x $y]
#
# o Nearest gives you the closest entry.
# o current is "" if
# 1) the pointer isn't over an entry.
# 2) the pointer is over a open/close button.
# 3)
#
#
# Edit mode assignments
#
# ButtonPress-3 Enables/disables edit mode on entry. Sets focus to
# entry.
#
# KeyPress
#
# Left Move insertion position to previous.
# Right Move insertion position to next.
# Up Move insertion position up one line.
# Down Move insertion position down one line.
# Return End edit mode.
# Shift-Return Line feed.
# Home Move to first position.
# End Move to last position.
# ASCII char Insert character left of insertion point.
# Del Delete character right of insertion point.
# Delete Delete character left of insertion point.
# Ctrl-X Cut
# Ctrl-V Copy
# Ctrl-P Paste
#
# KeyRelease
#
# ButtonPress-1 Start selection if in entry, otherwise clear selection.
# B1-Motion Extend/reduce selection.
# ButtonRelease-1 End selection if in entry, otherwise use last
# selection.
# B1-Enter Disabled.
# B1-Leave Disabled.
# ButtonPress-2 Same as above.
# B2-Motion Same as above.
# ButtonRelease-2 Same as above.
#
#
# Standard Motif bindings:
bind ${className}Editor <ButtonPress-1> {
%W icursor @%x,%y
%W selection clear
}
bind ${className}Editor <Left> {
%W icursor prev
%W selection clear
}
bind ${className}Editor <Right> {
%W icursor next
%W selection clear
}
bind ${className}Editor <Shift-Left> {
set new [expr {[%W index insert] - 1}]
if {![%W selection present]} {
%W selection from insert
%W selection to $new
} else {
%W selection adjust $new
}
%W icursor $new
}
bind ${className}Editor <Shift-Right> {
set new [expr {[%W index insert] + 1}]
if {![%W selection present]} {
%W selection from insert
%W selection to $new
} else {
%W selection adjust $new
}
%W icursor $new
}
bind ${className}Editor <Home> {
%W icursor 0
%W selection clear
}
bind ${className}Editor <Shift-Home> {
set new 0
if {![%W selection present]} {
%W selection from insert
%W selection to $new
} else {
%W selection adjust $new
}
%W icursor $new
}
bind ${className}Editor <End> {
%W icursor end
%W selection clear
}
bind ${className}Editor <Shift-End> {
set new end
if {![%W selection present]} {
%W selection from insert
%W selection to $new
} else {
%W selection adjust $new
}
%W icursor $new
}
bind ${className}Editor <Delete> {
if { [%W selection present]} {
%W delete sel.first sel.last
} else {
%W delete insert
}
}
bind ${className}Editor <BackSpace> {
if { [%W selection present] } {
%W delete sel.first sel.last
} else {
set index [expr [%W index insert] - 1]
if { $index >= 0 } {
%W delete $index $index
}
}
}
bind ${className}Editor <Control-space> {
%W selection from insert
}
bind ${className}Editor <Select> {
%W selection from insert
}
bind ${className}Editor <Control-Shift-space> {
%W selection adjust insert
}
bind ${className}Editor <Shift-Select> {
%W selection adjust insert
}
bind ${className}Editor <Control-slash> {
%W selection range 0 end
}
bind ${className}Editor <Control-backslash> {
%W selection clear
}
bind ${className}Editor <KeyPress> {
blt::tv::InsertText %W %A
}
# 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 ${className}Editor <Alt-KeyPress> {
# nothing
}
bind ${className}Editor <Meta-KeyPress> {
# nothing
}
bind ${className}Editor <Control-KeyPress> {
# nothing
}
bind ${className}Editor <KeyRelease-Escape> {
%W cancel
}
bind ${className}Editor <Return> {
%W apply
}
bind ${className}Editor <Shift-Return> {
blt::tv::InsertText %W "\n"
}
bind ${className}Editor <KP_Enter> {
# nothing
}
bind ${className}Editor <Tab> {
# nothing
}
if {![string compare $tcl_platform(platform) "macintosh"]} {
bind ${className}Editor <Command-KeyPress> {
# nothing
}
}
# 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"] != 0 } {
bind ${className}Editor <Insert> {
catch {blt::tv::InsertText %W [::tk::GetSelection %W CLIPBOARD]}
#catch {blt::tv::InsertText %W [selection get -displayof %W]}
}
}
bind ${className}Editor <<Paste>> {
catch {blt::tv::InsertText %W [::tk::GetSelection %W CLIPBOARD]}
}
bind ${className}Editor <<Copy>> { ::blt::tv::TextCopy %W 1 }
bind ${className} <<Copy>> { ::blt::tv::TextCopy %W }
# Additional emacs-like bindings:
bind ${className}Editor <Double-1> {
set parent [winfo parent %W]
%W cancel
after idle {
blt::tv::EditColumn $parent %X %Y
}
}
bind ${className}Editor <ButtonPress-3> {
set parent [winfo parent %W]
%W cancel
after idle {
blt::tv::EditColumn $parent %X %Y
}
}
bind ${className}Editor <Control-a> {
%W icursor 0
%W selection clear
}
bind ${className}Editor <Control-b> {
catch {%W icursor [expr {[%W index insert] - 1}]}
%W selection clear
}
bind ${className}Editor <Control-d> {
%W delete insert
}
bind ${className}Editor <Control-e> {
%W icursor end
%W selection clear
}
bind ${className}Editor <Control-f> {
%W icursor [expr {[%W index insert] + 1}]
%W selection clear
}
bind ${className}Editor <Control-h> {
if {[%W selection present]} {
%W delete sel.first sel.last
} else {
set index [expr [%W index insert] - 1]
if { $index >= 0 } {
%W delete $index $index
}
}
}
bind ${className}Editor <Control-k> {
%W delete insert end
}
if 0 {
bind ${className}Editor <Control-t> {
blt::tv::Transpose %W
}
bind ${className}Editor <Meta-b> {
%W icursor [blt::tv::PreviousWord %W insert]
%W selection clear
}
bind ${className}Editor <Meta-d> {
%W delete insert [blt::tv::NextWord %W insert]
}
bind ${className}Editor <Meta-f> {
%W icursor [blt::tv::NextWord %W insert]
%W selection clear
}
bind ${className}Editor <Meta-BackSpace> {
%W delete [blt::tv::PreviousWord %W insert] insert
}
bind ${className}Editor <Meta-Delete> {
%W delete [blt::tv::PreviousWord %W insert] insert
}
# tkEntryNextWord -- Returns the index of the next word position
# after a given position in the entry. The next word is platform
# dependent and may be either the next end-of-word position or the
# next start-of-word position after the next end-of-word position.
#
# Arguments:
# w - The entry window in which the cursor is to move.
# start - Position at which to start search.
if {![string compare $tcl_platform(platform) "windows"]} {
proc ::blt::tv::NextWord {w start} {
set pos [tcl_endOfWord [$w get] [$w index $start]]
if {$pos >= 0} {
set pos [tcl_startOfNextWord [$w get] $pos]
}
if {$pos < 0} {
return end
}
return $pos
}
} else {
proc ::blt::tv::NextWord {w start} {
set pos [tcl_endOfWord [$w get] [$w index $start]]
if {$pos < 0} {
return end
}
return $pos
}
}
# PreviousWord --
#
# Returns the index of the previous word position before a given
# position in the entry.
#
# Arguments:
# w - The entry window in which the cursor is to move.
# start - Position at which to start search.
proc ::blt::tv::PreviousWord {w start} {
set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
if {$pos < 0} {
return 0
}
return $pos
}
}
proc ::blt::tv::FmtStr {str {len 12}} {
# Break a string into fixed size chunks.
if {[string length $str]<=$len} {
return $str
}
set lm [expr {$len-1}]
set rc {}
while {[string length $str]>0} {
append rc [string range $str 0 $lm]
set str [string range $str $len end]
if {$str != {}} { append rc \n }
}
return $rc
}
proc ::blt::tv::FmtString {str {len 12} {class alnum}} {
# Wrap long strings at word boundries.
if {[string length $str]<=$len} {
return $str
}
if {[string is $class $str]} {
return [FmtStr $str $len]
}
set rc {}
set crc {}
set lw 1
foreach i [split $str {}] {
set isw [string is $class $i]
if {(($isw && $lw) || (!$isw && !$lw)) && [string length $crc]<$len} {
append crc $i
} else {
lappend rc $crc
set crc $i
}
set lw $isw
}
if {$crc != {}} {
lappend rc $crc
}
set src {}
set cln {}
foreach i $rc {
if {[string length $cln$i]<=$len} {
append cln $i
} else {
if {$src != {}} { append src \n }
append src $cln
set cln $i
}
}
append src \n $cln
return $src
}
Youez - 2016 - github.com/yon3zu
LinuXploit