Command completion in the iFile console

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