164 lines
5.9 KiB
Tcl
164 lines
5.9 KiB
Tcl
|
###########################################################
|
||
|
# Tcl/Tk Project Manager #
|
||
|
# Distrubuted under GPL #
|
||
|
# Copyright (c) "CONERO lab", 2002, http://conero.lrn.ru #
|
||
|
# Author: Sergey Kalinin (aka BanZaj) banzaj@lrn.ru #
|
||
|
###########################################################
|
||
|
# AutoCompletition Procedure #
|
||
|
# Author Alex DEDERER #
|
||
|
# Modify by Sergey (BanZaj) Kalinin 23.05.2002 #
|
||
|
###########################################################
|
||
|
|
||
|
proc auto_completition { widget } {
|
||
|
set start_word [$widget get "insert - 1 chars wordstart" insert]
|
||
|
set box [$widget bbox insert]
|
||
|
set box_x [expr [lindex $box 0] + [winfo rootx $widget] ]
|
||
|
set box_y [expr [lindex $box 1] + [winfo rooty $widget] + [lindex $box 3] ]
|
||
|
|
||
|
set cnt 0
|
||
|
set pos "1.0"
|
||
|
set last_pos ""
|
||
|
set pattern "$start_word\\w*"
|
||
|
|
||
|
set list_word($start_word) 1
|
||
|
while { ([set start [$widget search -count cnt -regexp -- $pattern $pos end]] != "") } {
|
||
|
set word [$widget get $start "$start + $cnt chars"]
|
||
|
if { ![string equal $start_word $word] } { set list_word($word) 1 }
|
||
|
set pos [$widget index "$pos + [expr $cnt + 1] chars"]
|
||
|
if { [string equal $last_pos $pos] } { break }
|
||
|
set last_pos $pos
|
||
|
} ;# while
|
||
|
|
||
|
bindtags $widget [list CompletitionBind [winfo toplevel $widget] $widget Text sysAfter all]
|
||
|
bind CompletitionBind <Escape> "bindtags $widget {[list [winfo toplevel $widget] $widget Text sysAfter all]}; catch { destroy .aCompletition }"
|
||
|
bind CompletitionBind <Key> { auto_completition_key %W %K %A ; break}
|
||
|
eval auto_completition_win $box_x $box_y [array names list_word]
|
||
|
} ;# proc auto_completition
|
||
|
|
||
|
## PROCEDURE LIST ##
|
||
|
## by BanZaj ##
|
||
|
proc AutoComplit {} {
|
||
|
global cmd activeFile nb
|
||
|
set node $activeFile
|
||
|
if {$node == ""} {return}
|
||
|
set widget "$nb.f$node.f.text"
|
||
|
|
||
|
set start_word [$widget get "insert - 1 chars wordstart" insert]
|
||
|
set box [$widget bbox insert]
|
||
|
set box_x [expr [lindex $box 0] + [winfo rootx $widget] ]
|
||
|
set box_y [expr [lindex $box 1] + [winfo rooty $widget] + [lindex $box 3] ]
|
||
|
|
||
|
set cnt 0
|
||
|
set pos "1.0"
|
||
|
set last_pos ""
|
||
|
set pattern "$start_word\\w*"
|
||
|
set i 0
|
||
|
|
||
|
for {set j 0} {$j <= [llength $cmd(all)]} {incr j} {
|
||
|
set line [lindex $cmd(all) $j]
|
||
|
if [regexp -nocase -all -- {(\\)([a-zA-Z]*)(\{\})} $line word] {
|
||
|
set word [string trim $word "\\"]
|
||
|
if {[string match "$start_word*" $word]} {
|
||
|
set list_word($word) $word
|
||
|
incr i
|
||
|
}
|
||
|
}
|
||
|
if {[string match "$start_word*" $line]} {
|
||
|
set list_word($line) $line
|
||
|
incr i
|
||
|
}
|
||
|
}
|
||
|
if {[array names list_word] == ""} {
|
||
|
return
|
||
|
}
|
||
|
bindtags $widget [list CompletitionBind [winfo toplevel $widget] $widget Text sysAfter all]
|
||
|
bind CompletitionBind <Escape> "bindtags $widget {[list [winfo toplevel $widget] $widget Text sysAfter all]}; catch { destroy .aCompletition }"
|
||
|
bind CompletitionBind <Key> {auto_completition_key %W %K %A ; break}
|
||
|
eval auto_completition_win $box_x $box_y [array names list_word]
|
||
|
} ;# proc auto_completition_proc
|
||
|
|
||
|
|
||
|
proc auto_completition_win { x y args} {
|
||
|
set win .aCompletition
|
||
|
if { [winfo exists $win] } { destroy $win }
|
||
|
toplevel $win
|
||
|
wm transient $win .
|
||
|
wm overrideredirect $win 1
|
||
|
|
||
|
listbox $win.lBox -width 30 -border 2 -yscrollcommand "$win.yscroll set" -border 1
|
||
|
scrollbar $win.yscroll -orient vertical -command "$win.lBox yview" -width 13 -border 1
|
||
|
pack $win.lBox -expand true -fill y -side left
|
||
|
pack $win.yscroll -side left -expand false -fill y
|
||
|
|
||
|
foreach { word } $args {
|
||
|
$win.lBox insert end $word
|
||
|
} ;# foreach | insert all word
|
||
|
|
||
|
catch { $win.lBox activate 0 ; $win.lBox selection set 0 0 }
|
||
|
|
||
|
if { [set height [llength $args]] > 10 } { set height 10 }
|
||
|
$win.lBox configure -height $height
|
||
|
|
||
|
bind $win <Escape> " destroy $win "
|
||
|
bind $win.lBox <Escape> " destroy $win "
|
||
|
|
||
|
wm geom $win +$x+$y
|
||
|
} ;# auto_completition_win
|
||
|
|
||
|
|
||
|
|
||
|
proc auto_completition_key { widget K A } {
|
||
|
set win .aCompletition
|
||
|
set ind [$win.lBox curselection]
|
||
|
|
||
|
switch -- $K {
|
||
|
Prior {
|
||
|
set up [expr [$win.lBox index active] - [$win.lBox cget -height]]
|
||
|
if { $up < 0 } { set up 0 }
|
||
|
$win.lBox activate $up
|
||
|
$win.lBox selection clear 0 end
|
||
|
$win.lBox selection set $up $up
|
||
|
}
|
||
|
Next {
|
||
|
set down [expr [$win.lBox index active] + [$win.lBox cget -height]]
|
||
|
if { $down >= [$win.lBox index end] } { set down end }
|
||
|
$win.lBox activate $down
|
||
|
$win.lBox selection clear 0 end
|
||
|
$win.lBox selection set $down $down
|
||
|
}
|
||
|
Up {
|
||
|
set up [expr [$win.lBox index active] - 1]
|
||
|
if { $up < 0 } { set up 0 }
|
||
|
$win.lBox activate $up
|
||
|
$win.lBox selection clear 0 end
|
||
|
$win.lBox selection set $up $up
|
||
|
}
|
||
|
Down {
|
||
|
set down [expr [$win.lBox index active] + 1]
|
||
|
if { $down >= [$win.lBox index end] } { set down end }
|
||
|
$win.lBox activate $down
|
||
|
$win.lBox selection clear 0 end
|
||
|
$win.lBox selection set $down $down
|
||
|
}
|
||
|
Return {
|
||
|
$widget delete "insert - 1 chars wordstart" "insert wordend - 1 chars"
|
||
|
$widget insert "insert" [$win.lBox get [$win.lBox curselection]]
|
||
|
#$widget mark set insert "insert wordend - 1 chars"
|
||
|
#$widget see insert
|
||
|
eval [bind CompletitionBind <Escape>]
|
||
|
}
|
||
|
default {
|
||
|
$widget insert "insert" $A
|
||
|
eval [bind CompletitionBind <Escape>]
|
||
|
}
|
||
|
}
|
||
|
} ;# proc auto_completition_key
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|