if {0} {
fr - A prototype of word completion instant command completion in the iFile 1.1 console. Completion works on first word only in ComboBox entry. The string appended is the longest common beginning of all possible endings. Clickable continuations are displayed in a toplevel widget. Start typing a character, then repeatedly invoke the created buttons to get the wished command.
usage: append this to the iFile script or save this as q.tcl in same dir as iFile.tcl append following line to iFile.tcl PC: source [file join [file dirname [info script]] q.tcl] on PDA (WinCE): source q.tcl additional requirements: font_ce, puts_ce known bug: continuations not up to date when using the keyboard (e.g. tk_messageBox, open, option)
}
namespace eval ::q {
variable tracedvar
variable entry
variable pp ""
variable pattern ""
variable temp [list]
variable suffixlist [list]
variable packages [lsort [package names]]
variable added_prefixes [list]
}
proc ::q::qcoco {entryname varname x mode} {
# puts varname=$varname; puts x=$x; puts mode=$mode
# completion for the first word
if {$::q::ok} {
set v ::
append v $varname\($x\)
set v [subst $$v]
if {![regexp {^\S+\s} $v]} {
set pos 0
# only first word is assumed to be a command
set ns ""
set colon ""
set ::q::pattern ""
regexp -nocase {(^[^:]*)(::)*([a-z0-9_:]*)} $v {&1&2&3} ns colon ::q::pattern
if {$colon == ""} {
set ::q::pattern $ns
set ns ::
} else {
# learn used package names
if {[lsearch -sorted $::q::added_prefixes $ns] < 0} {
if {[lsearch -sorted $::q::packages $ns] >=0} {
lappend ::q::added_prefixes $ns
set ::q::added_prefixes [lsort $::q::added_prefixes]
}
}
}
incr pos [string length $::q::pattern]
set pa ^$::q::pattern
set ::q::pp $::q::pattern*
set l [list]
if {[::q::isnopackage $ns]} {
namespace eval $ns {set ::q::commands [info command $::q::pp]}
foreach x $::q::commands {
lappend l [string range $x $pos end]
}
foreach idx [lsearch -all -sorted -regexp $::q::added_prefixes $pa] {
lappend l [string range [lindex $::q::added_prefixes $idx] $pos end]
}
if {0} {
# package names
foreach x $::q::packages {
if {[regexp $pa $x]} {
lappend l [string range $x $pos end]
}
}
}
} else {
set n ::
append n $ns
append n ::
append n $::q::pattern
set len [string length $n]
append n *
foreach x [info proc $n] {
lappend l [string range $x $len end]
}
}
::q::conti [lsort -unique -dictionary $l]
set add ""
foreach ff [split [lindex $::q::suffixlist 0] {}] ll [split [lindex $::q::suffixlist end] {}] {
expr {$ff==$ll ? [append add $ff] : [break] }
}
append v $add
set xl [llength $l]
if {[llength $l] == 1} {
# no alternatives exist
#append add { }
$entryname insert insert $add
set ::q::suffixlist [list] ;# no need to display
} else {
if {[llength $l]==0} {
# invalid character entered
if {![string equal $v :]} {
set prev [$entryname index insert]
incr prev -1
$entryname selection range $prev end
}
} else {
$entryname insert insert $add
# display continuations as buttons
}
}
} else {
set ::q::text ""
set ::q::suffixlist [list]
}
} else {
set ::q::ok 1
}
::q::topcon $entryname $varname
}
proc ::q::insertpos {entryname x y} {
# todo
# calculate position below insert mark of entry
# add +y positions of .n (notebook).n.f5 (frame) .n.f5.e (ComboBox)
# plus height of ComboBox
upvar $x X
upvar $y Y
set X 20
set Y 110
}
proc ::q::topcon {w var} {
set name .qcon
append name $w
regsub -all -start 1 {\.} $name _ name
#catch {destroy $name}
#destroy & toplevel -> no more winhandle map slots
set len [llength $::q::suffixlist]
catch {wm withdraw $name}
if {$len==0} {return}
if {$len==1 && [lindex $::q::suffixlist] == { } } {return}
if {![winfo exists $name]} {
set widget [toplevel $name]
} else {
foreach x [winfo children $name.f] {
destroy $x
}
destroy $name.f
set widget $name
}
::q::insertpos $w px py
wm geometry $widget +$px+$py
wm overrideredirect $widget 1
set sw $widget
set sf [frame $sw.f]
$sf configure -bg bisque
set ii 0
foreach x $::q::suffixlist {
set j [button $sf.b$ii -text $x -justify left -border 0 -bg white -fg black -activebackground skyblue -activeforeground white -takefocus 0]
pack $j -side top -padx 2 -pady 1 -anchor w
$j configure -command [list ::q::button_invoke $w $x]
incr ii
}
pack $sf -fill both
wm deiconify $name
}
proc ::q::button_invoke {entryname suffix} {
global g
set t [$entryname cget -text]
append t $suffix
$entryname insert insert $suffix
focus $entryname
set g(cmd) $t
}
proc ::q::isnopackage {v} {
if {$v==""} {return 1}
set pattern [format "^%s::" $v]
foreach x $::q::packages {
if {[regexp $pattern $x]} {
return 0
}
}
return 1
}
proc ::q::off {} {
#set k [trace info variable $::q::tracedvar]
# trace vdelete ::g(cmd) [lindex $k {0 1}]
trace vdelete $::q::tracedvar w [list ::q::qcoco $::q::entry]
set ::q::text "::q::on ;# instant command"
bind $::q::entry <Key-BackSpace> {}
}
proc ::q::about {} {
set t {
iFile command completion
basic prototype
Roland Frank, Aalen 2005
www.deltadatentechnik.de
}
catch {destroy.qab}
toplevel .qab
wm title .qab contributors
label .qab.l -justify center -text $t
pack .qab.l -pady 10
}
proc ::q::on {{entryname .n.f5.e.e}} {
# activate command completion in "iFile console"
global g
set g(cmd) ""
set ::q::entry $entryname
set ::q::tracedvar ::[$entryname cget -textvariable]
set ::q::ok 1
bind $entryname <Key-BackSpace> {
set ::q::ok 0
set ::q::suffixlist [list]
}
trace add variable $::q::tracedvar write [list ::q::qcoco $entryname]
$entryname selection range 0 end
}
proc ::q::conti {inlist} {
set ::q::temp [list]
foreach x $inlist {
if {$x == ""} {
set x " "
}
::q::merge $x 0
}
set ::q::suffixlist $::q::temp
set text ""
set n 0
foreach x $::q::temp {
incr n [string length $x]
if {$n>30} {
append text \n
set n 0
} else {
append text " "
incr n
}
append text $x
}
set ::q::text $text
}
proc ::q::merge {value minlen} {
# merge value to common prefix with last element of list
set last [lindex $::q::temp end]
if {$last != ""} {
set lastlen [string length $last]
set c ""
foreach t1 [split $last ""] t2 [split $value ""] {
expr {$t1==$t2 ? [append c $t1] : [break]}
}
if {$c!=""} {
set clen [string length $c]
if {$clen>$minlen} {
if {$clen==$lastlen} {
# skip
#lappend ::q::temp $value
} else {
lset ::q::temp end $c
}
} else {
lappend ::q::temp $value
}
} else {
lappend ::q::temp $value
}
} else {
set ::q::temp [list $value]
}
}
.n.f5.e.e configure -text "::q::on ;# instant command, ::q::off"
$5.l configure -textvariable ::q::text