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