huawei-utils/cmd-generator/cmdgen.tcl

1068 lines
40 KiB
Tcl
Raw Blame History

This file contains ambiguous Unicode characters!

This file contains ambiguous Unicode characters that may be confused with others in your current locale. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to highlight these characters.

#!/usr/bin/wish
######################################################
# HUAWEI command generator
# Distributed under GNU Public License
# Author: Sergey Kalinin
# Copyright (c) "Vimpelcom ltd", 2010,
######################################################
set ver 1.1.2
package require tablelist
package require BWidget
package require Ttk
#BWidget::use -package ttk -setoptdb 1 -style default
set dirWork [pwd]
set rootDir $dirWork
set dirFields $dirWork
set fontNormal "tahoma 10 normal roman"
# Bold Font #
set fontBold "tahoma 10 bold roman"
######################################################
# создаём файло со списком полей каждой таблицы из кучи файлов.
######################################################
proc ReadField {dir} {
global dirWork dirFields
cd $dir
set lstFiles [glob -nocomplain *.txt]
#set filesCount [llength $lstFiles]
#ProgressDlg .prg -textvariable PROGTXT -variable PROGINC \
-type nonincremental_infinite -maximum 100
destroy .frmStatus.frmActive.prg
ProgressBar .frmStatus.frmActive.prg -variable PROGINC -type nonincremental_infinite -maximum 100
pack .frmStatus.frmActive.lblActive -fill x -side left
pack .frmStatus.frmActive.prg -side left
set ::PROGTXT "Reading the files"
set ::PROGINC -1
foreach file [lsort $lstFiles] {
set ::PROGTXT "Reading the - $file"
set f [open $file r]
while {[gets $f line]>=0} {
if [regexp -nocase -all -- {([a-zA-Z]+)\s([a-zA-Z0-9]+):(.+?)} $line match command table params] {
set l [split $params ", "]
for {set i 1} {$i < [llength $l]} {incr i} {
if [regexp -nocase -all -- {([a-zA-Z0-9]+)=(.+?)} [lindex $l $i] match par val] {
if {[info exists lst($table)] == 0} {
lappend lst($table) "$par"
} else {
if {[lsearch -exact $lst($table) $par] < 0} {
lappend lst($table) "$par"
} else {
}
}
}
}
}
incr ::PROGINC
}
}
update
set fOut [open [file join $dirFields fields] w]
foreach n [array names lst] {puts $fOut "$n : [string toupper $lst($n)]"}
close $fOut
destroy .frmStatus.frmActive.prg
destroy .frmStatus.frmActive.lblActive
}
#########################################
## Читаем файл со списком полей и делаем массив списков #
########################################
proc ReadHeader {file} {
global arrFields dirWork
if [info exists arrFields] {
unset arrFields
}
if {[file exists $file] == 0} {
set dir [tk_chooseDirectory -title "Select directory with CVTMML files"]
ReadField $dir
}
set f [open $file r]
while {[gets $f line]>=0} {
if [regexp -nocase -all -- {([a-zA-Z0-9]+)\s:\s(.+?)} $line match table params] {
set l [split $params " "]
for {set i 0} {$i < [llength $l]} {incr i} {
set par [lindex $l $i]
lappend arrFields($table) "$par"
}
}
}
}
proc ReadFile {file} {
global lst
if [info exists lst] {
unset lst
}
set f [open $file r]
gets $f line
if [regexp -nocase -all -- {([a-zA-Z]+)\s([a-zA-Z0-9]+):(.+?)} $line match command table params] {
set l [split $params ", "]
for {set i 1} {$i < [llength $l]} {incr i} {
if [regexp -nocase -all -- {([a-zA-Z]+)=(.+?)} [lindex $l $i] match par val] {
lappend lst($table) "$par=$val"
}
}
}
}
proc CloseFile {} {
global noteBook bookmarkList
set node [$noteBook raise]
if {$node eq ""} {
return
}
set index [$noteBook index $node]
$noteBook delete $node 1
unset bookmarkList($node)
set firstNode [$noteBook pages 0]
$noteBook raise $firstNode
if {$firstNode eq ""} {
.frmTool.btnFileClose configure -state disable
.frmTool.btnSaveTable configure -state disable
.frmTool.btnSaveText configure -state disable
.frmTool.entFilter configure -text ""
.frmTool.entFilter configure -state disabled
.frmTool.btnFilterOn configure -state disable
.frmTool.btnFilterOff configure -state disable
.frmStatus.frmLine.lblLine configure -text ""
}
}
proc CloseAllFile {} {
global noteBook bookmarkList
foreach node [$noteBook pages] {
set index [$noteBook index $node]
$noteBook delete $node 1
if [info exists bookmarkList($node)] {
unset bookmarkList($node)
}
}
.frmTool.btnFileClose configure -state disable
.frmTool.btnSaveTable configure -state disable
.frmTool.btnSaveText configure -state disable
.frmTool.entFilter configure -text ""
.frmTool.entFilter configure -state disabled
.frmTool.btnFilterOn configure -state disable
.frmTool.btnFilterOff configure -state disable
.frmStatus.frmLine.lblLine configure -text ""
.frmStatus.frmFilter.lblFilter configure -text ""
}
##################################
## Centered window ##
##################################
proc CentreWindow {w {width 640} {height 480} } {
set x [expr { ( [winfo vrootwidth $w] - $width ) / 2 }]
set y [expr { ( [winfo vrootheight $w] - $height ) / 2 }]
wm geometry $w ${width}x${height}+${x}+${y}
}
# sync scroll
proc Scroll {lst txt args} {
if {[lindex $args 0] eq "scroll"} {
$lst yview [lindex $args 0] [lindex $args 1] [lindex $args 2]
$txt yview [lindex $args 0] [lindex $args 1] [lindex $args 2]
#.frmBody.frmCat.lst yview [lindex $args 0] [lindex $args 1] [lindex $args 2]
#.frmBody.frmCat.txt yview [lindex $args 0] [lindex $args 1] [lindex $args 2]
} elseif {[lindex $args 0] eq "moveto"} {
#.frmBody.frmCat.lst yview [lindex $args 0] [lindex $args 1]
#.frmBody.frmCat.txt yview [lindex $args 0] [lindex $args 1]
$lst yview [lindex $args 0] [lindex $args 1]
$txt yview [lindex $args 0] [lindex $args 1]
}
}
##################################
## Create Pane Widget ##
##################################
namespace eval pane {
namespace export create
proc create { f1 f2 args } {
set t(-orient) vertical
set t(-percent) 0.25
set t(-gripcolor) gray75
set t(-gripposition) 0.95
set t(-gripcursor) crosshair
set t(-in) [winfo parent $f1]
array set t $args
set master $t(-in)
upvar #0 [namespace current]::Pane$master pane
array set pane [array get t]
if {! [string match v* $pane(-orient)] } {
set pane(-gripcursor) sb_v_double_arrow
set height 5 ; set width 3000
} else {
set pane(-gripcursor) sb_h_double_arrow
set height 3000 ; set width 5
}
set pane(1) $f1
set pane(2) $f2
set pane(grip) [frame $master.grip -background $pane(-gripcolor) \
-width $width -height $height \
-bd 1 -relief raised -cursor $pane(-gripcursor)]
if {! [string match v* $pane(-orient)] } {
set pane(D) Y
place $pane(1) -in $master -x 0 -rely 0.0 -anchor nw -relwidth 1.0 -height -1
place $pane(2) -in $master -x 0 -rely 1.0 -anchor sw -relwidth 1.0 -height -1
place $pane(grip) -in $master -anchor c -relx $pane(-gripposition)
} else {
set pane(D) X
place $pane(1) -in $master -relx 0.0 -y 0 -anchor nw -relheight 1.0 -width -1
place $pane(2) -in $master -relx 1.0 -y 0 -anchor ne -relheight 1.0 -width -1
place $pane(grip) -in $master -anchor c -rely 0 ;#$pane(-gripposition)
}
$master configure -background gray50
bind $master <Configure> [list [namespace current]::PaneGeometry $master]
bind $pane(grip) <ButtonPress-1> \
[list [namespace current]::PaneDrag $master %$pane(D)]
bind $pane(grip) <B1-Motion> \
[list [namespace current]::PaneDrag $master %$pane(D)]
bind $pane(grip) <ButtonRelease-1> \
[list [namespace current]::PaneStop $master]
[namespace current]::PaneGeometry $master
}
proc PaneDrag { master D } {
upvar #0 [namespace current]::Pane$master pane
if {[info exists pane(lastD)]} {
set delta [expr double($pane(lastD) - $D) \
/ $pane(size)]
set pane(-percent) [expr $pane(-percent) - $delta]
if {$pane(-percent) < 0.0} {
set pane(-percent) 0.0
} elseif {$pane(-percent) > 1.0} {
set pane(-percent) 1.0
}
[namespace current]::PaneGeometry $master
}
set pane(lastD) $D
}
proc PaneStop { master } {
upvar #0 [namespace current]::Pane$master pane
catch {unset pane(lastD)}
}
proc PaneGeometry { master } {
upvar #0 [namespace current]::Pane$master pane
if {$pane(D) == "X"} {
place $pane(1) -relwidth $pane(-percent)
place $pane(2) -relwidth [expr 1.0 - $pane(-percent)]
place $pane(grip) -relx $pane(-percent)
set pane(size) [winfo width $master]
} else {
place $pane(1) -relheight $pane(-percent)
place $pane(2) -relheight [expr 1.0 - $pane(-percent)]
place $pane(grip) -rely $pane(-percent)
set pane(size) [winfo height $master]
}
}
}
##################################
## Exit procedure ##
#################################
proc Quit {} {
global bookmarkList rootDir tcl_platform
set f [open [file join $rootDir .bookmarks] w]
foreach item [array names bookmarkList] {
puts $f [file nativename $bookmarkList($item)]
}
close $f
if {$tcl_platform(os) eq "Windows NT"} {
#file attributes [file join $rootDir .bookmarks] -hidden true
}
exit
}
proc PopupMenuTable {x y} {
global fontNormal
if [winfo exists .popupTbl] {
destroy .popupTbl
}
set m .popupTbl
set menu [menu $m -font $fontNormal -title Clipboard]
$m add command -label "Copy cell" -command {Copy cell}\
-font $fontNormal -accelerator "Ctrl+C"
$m add command -label "Copy row" -command {Copy row}\
-font $fontNormal
$m add command -label "Copy command" -command CopySelectedCommand\
-font $fontNormal
$m add separator
$m add command -label "Filter" -command {FilterOn menu}\
-font $fontNormal
tk_popup $menu $x $y
}
##################################
## Opened file procedure ##
##################################
proc OpenFile {{file_ ""}} {
global arrFields dirWork dirFields noteBook fontNormal bookmarkList lstColumnWidth
set types {
{{Text Files} {.txt} }
{{All Files} * }
}
if {$file_ eq ""} {
set file [tk_getOpenFile -filetypes $types -initialdir $dirWork]
} else {
set file $file_
}
if {$file eq ""} {
return
}
set dirWork [file dirname $file]
# заменяем пробелы в имени файла для удобства работы
regsub -all -- {\s} [file rootname [file tail $file]] "_" nodeName
# открываем файл и читаем до тех пор пока не попадется строка соответствующая шаблону
# и вставляем страницу в noteBook
set f [open $file r]
while [gets $f l] {
if [regexp -nocase -all -- {([a-zA-Z]+)\s([a-zA-Z0-9]+):(.+?)} $l match command tableName params] {
set node [$noteBook insert end $nodeName -text "$tableName" -raisecmd RaisedNodeService]
break ;# дальше можно не читать - название таблицы получено
}
}
# переместим указатель в файле на начало
seek $f 0 start
## CREATE PANE ##
set frmBody [frame $node.frm -border 1 -relief raised]
pack $frmBody -side top -expand true -fill both
set frmText [frame $frmBody.frmText -relief sunken -border 1]
#set frmText [ScrollableFrame $frmBody.frmText -xscrollincrement 0 -yscrollincrement 0]
pack $frmText -side left -fill both -expand true
#set frmTable [frame $frmBody.frmTable -border 1 -relief sunken]
set frmTable [ScrolledWindow $node.frmTable]
pack $frmTable -side left -fill both -expand true
pane::create $frmText $frmTable -orient horizontal
set listBox [text $frmText.lst -yscrollcommand "$frmText.yscroll set" -width 6 -borderwidth 0 -relief flat -font $fontNormal]
set txt [text $frmText.txt -wrap none -yscrollcommand "$frmText.yscroll set" -borderwidth 0 -relief flat -font $fontNormal -width 30]
scrollbar $frmText.yscroll -relief sunken -borderwidth {1} -width {10} -takefocus 0 -command "Scroll $listBox $txt"
#scrollbar $frmBody.xscroll -relief sunken -borderwidth {1} -width {10} -takefocus 0 -command "$txt xview"
#pack $frmText.yscroll -side top -fill y
pack $listBox -side left -fill y
pack $txt -side left -fill both -expand true
pack $frmText.yscroll -side left -fill y
# $frmText setwidget $listBox
#$frmText setwidget $txt
#bind $txt <Button-4> "$listBox yview scroll -3 units"
#bind $listBox <Button-5> "$listBox yview scroll 3 units"
#bind $txt <Button-4> "Scroll $listBox $txt"
#bind $listBox <Button-5> "Scroll $listBox $txt"
if [info exists arrFields($tableName)] {
set tbl [CreateTable $arrFields($tableName) $frmTable $txt]
} else {
set doit [MessageDlg .msg -type yesno -title "Info message" -message "$tableName not found in =fields= file. Needed reinitialisation. Do it?"]
switch -exact $doit {
0 {
CloseAllFile
ReadField [file dirname $file]
ReadHeader [file join $dirFields fields]
#CloseFile
#OpenFile $file
return
}
1 {$noteBook delete $nodeName; return}
# tk_messageBox -title Error -icon error -type ok -message "Reinitialisation needed"
}
}
## TABS popups ##
set bookmarkList($nodeName) $file
#ProgressDlg .prg -textvariable PROGTXT -variable PROGINC -type infinite -maximum 1000
ProgressBar .frmStatus.frmActive.prg -variable PROGINC -type nonincremental_infinite -maximum 100
pack .frmStatus.frmActive.prg -fill x -side left
set ::PROGTXT "Reading the file"
set ::PROGINC -1
$listBox delete 0.0 end
$txt delete 0.0 end
set rowCount 0
if [info exists lstColumnName] {
unset lstColumnName
}
# список с размерами полей, для первого максимально 6 знаков
set lstColumnWidth($nodeName,0) 6
for {set col 1} {$col < [$tbl columncount]} {incr col} {
set lstColumnWidth($nodeName,$col) 0
# делаем список содержащий имена параметров
# опосля, их заменим на значения и сунем в таблицу
lappend lstColumnName "=[$tbl columncget $col -name]="
}
while {[gets $f line]>=0} {
$txt insert end "$line\n"
set line [string trim $line ";"]
$listBox insert end "$rowCount\n"
if [info exists lstVal] {
unset lstVal
}
lappend lstVal $rowCount
set lstVal [concat $lstVal $lstColumnName]
if [regexp -nocase -all -- {([a-zA-Z]+)\s([a-zA-Z0-9]+):(.+?)} $line match command table params] {
set l [split $params ", "]
set y 1
for {set i 0} {$i < [llength $l]} {incr i} {
if [regexp -nocase -all -- {([a-zA-Z0-9]+)=(.+?)} [lindex $l $i] match par val] {
##### FUCK ########
# заменяем в списке имена параметров на их значения
set item [lsearch -exact $lstVal "=[string toupper $par]="]
# проверяем наличие параметра из командника в fields если нету запустим переинициализацию
if {$item eq -1} {
set doit [MessageDlg .msg -type yesnocancel -title "Info message" -message "Parametr =$par= not found in =fields= file. Needed reinitialisation. Do it?"]
switch -exact $doit {
0 {
CloseAllFile
ReadField [file dirname $file]
ReadHeader [file join $dirFields fields]
OpenFile $file
#return
}
1 {}
2 { update; destroy .prg; return}
}
}
set lstVal [lreplace $lstVal $item $item [string trim $val "\""]]
# вычисляем макс. кол-во символов для каждого столбца
set length [string length $val]
if [info exists lstColumnWidth($nodeName,$y)] {
if {$lstColumnWidth($nodeName,$y) < $length} {
set lstColumnWidth($nodeName,$y) $length
}
}
incr y
}
}
# меняем оставшиеся потроха на пустое значение
while {[lsearch -glob $lstVal "=*="] !=-1} {
set item [lsearch -glob $lstVal "=*="]
set lstVal [lreplace $lstVal $item $item " "]
#puts "$item $lstVal"
}
$tbl insert end $lstVal
}
incr ::PROGINC
incr rowCount
}
update
destroy .frmStatus.frmActive.prg
close $f
$noteBook raise $nodeName
# уберём упомнинание о включенном фильтре
.frmStatus.frmFilter.lblFilter configure -text ""
# включим нужные кнопочки окошечки
.frmTool.btnFileClose configure -state normal
.frmTool.btnSaveTable configure -state normal
.frmTool.btnSaveText configure -state normal
.frmTool.entFilter configure -state normal
.frmTool.btnFilterOn configure -state normal
.frmStatus.frmLine.lblLine configure -text "$rowCount str."
}
##################################
## Created table widget ##
##################################
proc CreateTable {lstHeader frmTbl text} {
set tbl [tablelist::tablelist $frmTbl.tbl -stretch all -selectmode extended -selecttype cell -background white \
-showseparators yes -stripebackground #ecf6eb -xscrollcommand "" -yscrollcommand ""]
$frmTbl setwidget $tbl
#pack $frmTbl -side left -fill both -expand true
set i 1
$tbl insertcolumns end 0 "#"
foreach n $lstHeader {
set n [string toupper $n]
$tbl insertcolumns end 0 "$n"
$tbl columnconfigure $i -sortmode ascii -name $n
incr i
}
$tbl columnconfigure 0 -sortmode integer -name "number"
bind [$tbl bodytag] <Double-Button-1> {
foreach {tablelist::W tablelist::x tablelist::y} \
[tablelist::convEventFields %W %x %y] {}
#puts "clicked on cell [$tbl containingcell $tablelist::x $tablelist::y]"
SearchText
}
bind [$tbl bodytag] <Button-3> {catch [PopupMenuTable %X %Y]}
return $tbl
}
##################################
#### ищем текст и подсвечиваем его #####
##################################
proc SearchText {} {
global noteBook
set txt .frmBody.noteBook.f[$noteBook raise].frm.frmText.txt
set tbl .frmBody.noteBook.f[$noteBook raise].frmTable.tbl
set listBox .frmBody.noteBook.f[$noteBook raise].frm.frmText.lst
set row [$tbl containing $tablelist::y]
if {$row eq "-1"} {
return
}
set ind [expr [$tbl getcells $row,0] +1]
$txt tag delete select
$txt tag configure select -background grey
$txt tag add select $ind.0 $ind.end
$listBox tag delete select
$listBox tag configure select -background grey
$listBox tag add select $ind.0 $ind.end
$txt see $ind.0
$listBox see $ind.0
}
############################################
#### ищем команды в тексте для фильтрованных записей #####
###########################################
proc SearchFilteredText {} {
global noteBook
set txt .frmBody.noteBook.f[$noteBook raise].frm.frmText.txt
set tbl .frmBody.noteBook.f[$noteBook raise].frmTable.tbl
set listBox .frmBody.noteBook.f[$noteBook raise].frm.frmText.lst
$txt tag delete filtered
$txt tag configure filtered -background #abedbb
$listBox tag delete filtered
$listBox tag configure filtered -background #abedbb
# получаем индексы строк
foreach ind [$tbl getkeys 0 end] {
# проверям скрыты или нет
if {[$tbl rowcget $ind -hide] == 0} {
set index [expr [$tbl getcells $ind,0] +1]
#puts "$index - visible"
#set ind [expr [$tbl getcells $row,0] +1]
$txt tag add filtered $index.0 $index.end
$listBox tag add filtered $index.0 $index.end
$txt see $index.0
$listBox see $index.0
}
}
}
##############################################
#### Копируем в буфер команды на основе выделенных ячеек #####
##############################################
proc CopySelectedCommand {} {
global noteBook
clipboard clear
set txt .frmBody.noteBook.f[$noteBook raise].frm.frmText.txt
set tbl .frmBody.noteBook.f[$noteBook raise].frmTable.tbl
set listBox .frmBody.noteBook.f[$noteBook raise].frm.frmText.lst
#$tbl selection includes index
#puts
foreach ind [$tbl curselection ] {
# проверям скрыты или нет
if {[$tbl rowcget $ind -hide] == 0} {
set index [expr [$tbl getcells $ind,0] +1]
append selectedCommand "[string trim [$txt get $index.0 $index.end]]\n"
#$listBox tag add filtered $index.0 $index.end
#$txt see $index.0
#$listBox see $index.0
}
}
clipboard append [string trim $selectedCommand]
}
##########################################
#### Копируем в буфер содержимое выделенных ячеек #####
##########################################
proc Copy {type} {
global noteBook
clipboard clear
set txt .frmBody.noteBook.f[$noteBook raise].frm.frmText.txt
set tbl .frmBody.noteBook.f[$noteBook raise].frmTable.tbl
switch $type {
"cell" {
foreach row [$tbl curselection ] {
foreach ind [$tbl curcellselection ] {
set rowInd [lindex [split $ind ","] 0]
if {$rowInd eq $row} {
append selectedData "[string trim [$tbl getcells $ind]]\t"
}
}
append selectedData "\n"
}
}
"row" {
foreach ind [$tbl curselection ] {
append selectedData "[string trim [$tbl getcells $ind,0 $ind,end]]\n"
puts [regsub -all -- "\{ \}" $selectedData " " selectedData]
}
}
}
clipboard append [string trim $selectedData]
}
##################################
#### главная процедурка в программе #####
##################################
proc AboutDialog {} {
global ver fontNormal fontBold
set w ".about"
set w_exist [winfo exists $w]
if !$w_exist {
toplevel $w
wm title $w "About"
wm overrideredirect $w 0
wm positionfrom $w program
wm resizable $w 0 0
CentreWindow $w 500 200
#frame $w.frmImg -borderwidth 2 -relief ridge -background white
#set imgAbout [image create photo -data $picturedata]
#image create photo imgAbout -format gif -file $homeDir/img/mytcladmin.gif
frame $w.frm -borderwidth 2 -relief ridge
#label $w.frm.lblImg -image $imgAbout
#pack $w.frmImg.lblImg -side top -expand true -fill both
frame $w.frm.frmlbl -borderwidth 0 -relief ridge
label $w.frm.frmlbl.lblHeader -font $fontNormal -text "This is visual tool for working with files generated by HUAWEI CVTmml"
label $w.frm.frmlbl.lblVersion -font $fontNormal -text "Version: $ver"
label $w.frm.frmlbl.lblLicense -font $fontNormal -text "Licensed by GNU Public License"
label $w.frm.frmlbl.lblCompany -font $fontNormal -text "Copyright: Sergey Kalinin, 2010"
label $w.frm.frmlbl.lblAuthor -font $fontNormal -text "Author: Sergey Kalinin"
label $w.frm.frmlbl.lblEmail -font $fontNormal -cursor hand1 -text "E-Mail: banzaj28@gmail.com"
pack $w.frm.frmlbl.lblHeader $w.frm.frmlbl.lblVersion $w.frm.frmlbl.lblLicense $w.frm.frmlbl.lblCompany \
$w.frm.frmlbl.lblAuthor $w.frm.frmlbl.lblEmail -side top -padx 5
frame $w.frmBtn -borderwidth 2 -relief ridge
button $w.frmBtn.btnOk -text "Close" -font $fontNormal -borderwidth {1} \
-command "destroy .about"
bind $w <KeyRelease-Return> "destroy .about"
pack $w.frmBtn.btnOk -pady 5
#pack $w.frm.lblImg $w.frm.frmlbl -side left -expand true -fill x -anchor center
pack $w.frm.frmlbl -side left -expand true -fill x -anchor center
pack $w.frm -side top -expand true -fill both
pack $w.frmBtn -side top -fill x
focus $w.frmBtn.btnOk
bind .about <Escape> {destroy .about}
}
}
proc HelpDialog {} {
global ver fontNormal fontBold tcl_platform
set w ".help"
set w_exist [winfo exists $w]
if !$w_exist {
toplevel $w
wm title $w "Help"
wm overrideredirect $w 0
wm positionfrom $w user
wm resizable $w 1 1
CentreWindow $w 640 480
frame $w.frmTxtHelp -borderwidth 2 -relief ridge
frame $w.frmBtn -borderwidth 2 -relief ridge
pack $w.frmTxtHelp -expand true -fill both
pack $w.frmBtn -fill x
set helpText [text $w.frmTxtHelp.txt -wrap none -yscrollcommand "$w.frmTxtHelp.yscroll set" -borderwidth 0 -relief flat -wrap word -font $fontNormal]
scrollbar $w.frmTxtHelp.yscroll -relief sunken -borderwidth {1} -width {10} -takefocus 0 -command {$helpText yview }
pack $helpText -fill both -expand true -side left
pack $w.frmTxtHelp.yscroll -fill y -expand true -side left
button $w.frmBtn.btnOk -text "Close" -font $fontNormal -borderwidth {1} -command "destroy .help"
bind $w <KeyRelease-Return> "destroy .help"
pack $w.frmBtn.btnOk -pady 5
focus $w.frmBtn.btnOk
bind .help <Escape> {destroy .help}
set text "See README.html"
$helpText insert end $text
}
}
#######################################################
#### включаем фильтру для отображения записей согласно критерия ########
######################################################
proc FilterOn {args} {
global noteBook filtered
set tblName [$noteBook raise]
set txt .frmBody.noteBook.f$tblName.frm.frmText.txt
set tbl .frmBody.noteBook.f$tblName.frmTable.tbl
set listBox .frmBody.noteBook.f$tblName.frm.frmText.lst
switch $args {
"menu" {
$tbl sortbycolumn [lindex [split [$tbl curcellselection ] ","] 1] -increasing
set data [string trim [$tbl getcells [$tbl curcellselection ]]]
.frmTool.entFilter configure -text "$data"
}
}
set text [.frmTool.entFilter get ]
if {$text eq ""} {
MessageDlg .msg -type ok -title "Info message" -message "Enter filter criteria"
return
}
set colindex [$tbl sortcolumn]
if {$colindex == -1} {
MessageDlg .msg -type ok -title "Info message" -message "Select sorting column first."
return
}
set rowIndex 0
foreach item [$tbl getcells 0,$colindex end,$colindex] {
if {[string match [string tolower $text] [string tolower $item]] == 0 } {
$tbl rowconfigure $rowIndex -hide 1
}
incr rowIndex
}
set filtered($tblName) [list [string toupper [$tbl columncget $colindex -title]] $text]
.frmStatus.frmFilter.lblFilter configure -text "[string toupper [$tbl columncget $colindex -title]]=\"$text\""
.frmTool.btnFilterOff configure -state normal
SearchFilteredText
}
proc FilterOff {} {
global noteBook filtered
set tblName [$noteBook raise]
set tbl .frmBody.noteBook.f$tblName.frmTable.tbl
set txt .frmBody.noteBook.f$tblName.frm.frmText.txt
set listBox .frmBody.noteBook.f$tblName.frm.frmText.lst
foreach ind [$tbl getkeys 0 end] {
$tbl rowconfigure $ind -hide 0
}
.frmStatus.frmFilter.lblFilter configure -text ""
unset filtered($tblName)
.frmTool.btnFilterOff configure -state disable
$txt tag delete filtered
$listBox tag delete filtered
}
###################################
## сохраняем все данные из таблици в текстовик ##
proc SaveTable {} {
global noteBook lstColumnWidth
set nodeName [$noteBook raise]
set tbl .frmBody.noteBook.f$nodeName.frmTable.tbl
#global tbl
if {[info exists tbl] == 0} {
return
}
set types {
{{Tabbed text file} {.txt}}
{{CSV file} {.csv}}
}
set file [tk_getSaveFile -filetypes $types -defaultextension ".txt"]
if {$file eq ""} {
return
}
set f [open $file w]
if {[file extension $file] eq ".csv"} {
set separator ";"
} elseif {[file extension $file] eq ".txt"} {
set separator "\t"
}
foreach i [$tbl cget -columntitles] {
set i [string toupper $i]
puts -nonewline $f "$i$separator"
}
puts $f ""
foreach ind [$tbl getkeys 0 end] {
if {[$tbl rowcget $ind -hide] == 0} {
set colInd 0
foreach j [$tbl get $ind] {
# хитрый выебон для добавления пробелов до необходимой ширины
if {[string length $j] < $lstColumnWidth($nodeName,$colInd)} {
set delta [expr $lstColumnWidth($nodeName,$colInd) - [string length $j]]
for {set y 0} {$y < $delta} {incr y} {
append j " "
}
#puts "$j - $lstColumnWidth($nodeName,$colInd) - $delta"
}
puts -nonewline $f "$j\t"
incr colInd
}
puts $f ""
}
}
close $f
}
########################################
## сохраняем меченные данные из текстового поля в текстовик ##
########################################
proc SaveTextMarked {} {
global noteBook
set nodeName [$noteBook raise]
set txt .frmBody.noteBook.f$nodeName.frm.frmText.txt
set tbl .frmBody.noteBook.f$nodeName.frmTable.tbl
#global tbl
if {[info exists txt] == 0} {
return
}
set types {
{{Text file} {.txt}}
}
set file [tk_getSaveFile -filetypes $types -defaultextension ".txt"]
if {$file eq ""} {
return
}
set f [open $file w]
# получаем индексы строк
foreach ind [$tbl getkeys 0 end] {
# проверям скрыты или нет
if {[$tbl rowcget $ind -hide] == 0} {
set index [expr [$tbl getcells $ind,0] +1]
puts $f [$txt get $index.0 $index.end]
puts [$txt get $index.0 $index.end]
}
}
close $f
}
########################################
## сохраняем все данные из текстового поля в текстовик ##
########################################
proc SaveText {} {
global noteBook
set nodeName [$noteBook raise]
set txt .frmBody.noteBook.f$nodeName.frm.frmText.txt
#global tbl
if {[info exists txt] == 0} {
return
}
set types {
{{Tabbed text file} {.txt}}
}
set file [tk_getSaveFile -filetypes $types -defaultextension ".txt"]
if {$file eq ""} {
return
}
set f [open $file w]
puts $f [$txt get 0.0 end]
close $f
}
########################################
## обновление строки статуса при активации закладок ##
########################################
proc RaisedNodeService {} {
global noteBook filtered
set nodeName [$noteBook raise]
set tbl .frmBody.noteBook.f$nodeName.frmTable.tbl
.frmStatus.frmLine.lblLine configure -text "[$tbl index end] str."
if [info exists filtered($nodeName)] {
.frmTool.entFilter configure -text [lindex $filtered($nodeName) 1]
.frmStatus.frmFilter.lblFilter configure -text "[lindex $filtered($nodeName) 0]=\"[lindex $filtered($nodeName) 1]\""
.frmTool.btnFilterOff configure -state normal
} else {
.frmTool.entFilter configure -text ""
.frmStatus.frmFilter.lblFilter configure -text ""
.frmTool.btnFilterOff configure -state disable
}
}
###################################################
## GUI ####################################
##################################################
wm geometry . 800x600+0+0
wm title . "Msoft Command Generator: $ver"
wm iconname . "MCG $ver"
wm protocol . WM_DELETE_WINDOW Quit
wm overrideredirect . 0
wm positionfrom . program
CentreWindow . 800 600
#wm resizable . 0 0
option add *Tablelist.labelCommand tablelist::sortByColumn
option add *Tablelist.labelCommand2 tablelist::addToSortColumns
#option add *Tablelist.setGrid yes
option add *Tablelist.movableColumns yes
frame .frmMenu -border 1 -relief raised
frame .frmTool -border 1 -relief raised
frame .frmBody -border 1 -relief raised
frame .frmStatus -border 1 -relief sunken
pack .frmMenu -side top -padx 1 -fill x
pack .frmTool -side top -padx 1 -fill x
pack .frmBody -side top -padx 1 -fill both -expand true
pack .frmStatus -side top -padx 1 -fill x
########## CREATE MENU LINE ##########
menubutton .frmMenu.mnuFile -text "File" -menu .frmMenu.mnuFile.m -font $fontNormal
set m [menu .frmMenu.mnuFile.m]
$m add command -label "Open command file" -command {OpenFile} -font $fontNormal -accelerator "Ctrl+O"
$m add command -label "Close file" -command {CloseFile} -font $fontNormal -accelerator "Ctrl+W"
$m add command -label "Close all files" -command {CloseAllFile} -font $fontNormal
$m add separator
$m add command -label "Exit" -command Quit -font $fontNormal -accelerator "Ctrl+Q"
menubutton .frmMenu.mnuService -text "Service" -menu .frmMenu.mnuService.m -font $fontNormal
set m [menu .frmMenu.mnuService.m]
$m add cascade -label "Text" -menu $m.text -font $fontNormal
$m add cascade -label "Table" -menu $m.table -font $fontNormal
$m add separator
$m add command -label "Reread files structure" -font $fontNormal -command {
CloseAllFile
ReadField [tk_chooseDirectory -title "Select directory with CVTMML files"]
ReadHeader [file join $dirFields fields]
}
set m1 [menu $m.text]
$m1 add command -label "Save all text" -command SaveText -font $fontNormal -accelerator "Ctrl+T"
$m1 add command -label "Save market text" -command SaveTextMarked -font $fontNormal -accelerator "Ctrl+M"
set m2 [menu $m.table]
$m2 add command -label "Export table" -command SaveTable -font $fontNormal -accelerator "Ctrl+S"
$m2 add command -label "Copy selected cells" -command {Copy cell} -font $fontNormal -accelerator "Ctrl+C"
$m2 add command -label "Copy row" -command {Copy row} -font $fontNormal
$m2 add command -label "Copy command" -command CopySelectedCommand -font $fontNormal
menubutton .frmMenu.mnuHelp -text "Help" -menu .frmMenu.mnuHelp.m -underline 0 -font $fontNormal
set m [menu .frmMenu.mnuHelp.m]
$m add command -label "Help" -command HelpDialog -accelerator F1 -font $fontNormal
$m add command -label "About ..." -command AboutDialog -font $fontNormal
#pack .frmMenu.mnuFile .frmMenu.mnuEdit .frmMenu.mnuView .frmMenu.mnuService -side left
pack .frmMenu.mnuFile .frmMenu.mnuService -side left
pack .frmMenu.mnuHelp -side right
################ toolbar ######################
Button .frmTool.btnFileOpen -text "Open" -command OpenFile -relief link -helptext "Open cvtMML command file"
Button .frmTool.btnFileClose -text "Close" -command CloseFile -relief link -state disable -helptext "Close file"
Button .frmTool.btnSaveTable -text "Export table" -command SaveTable -relief link -state disable -helptext "Export table into file"
#Button .frmTool.btnSaveText -text "Save text" -command SaveText -relief link -state disable -helptext "Save text as file"
menubutton .frmTool.btnSaveText -text "Save text" -menu .frmTool.btnSaveText.m -state disabled
set m [menu .frmTool.btnSaveText.m]
$m add command -label "Save all" -command SaveText -font $fontNormal
$m add command -label "Save marked" -command SaveTextMarked -font $fontNormal
label .frmTool.lblSeparator1 -relief groove -text ""
Entry .frmTool.entFilter -state disabled -helptext "Enter here filter criteria"
Button .frmTool.btnFilterOn -text "Filter on" -command FilterOn -relief link -state disable -helptext "Data filter on"
Button .frmTool.btnFilterOff -text "Filter off" -command FilterOff -relief link -state disable -helptext "Data filter off"
label .frmTool.lblSeparator2 -relief groove -text ""
Button .frmTool.btnExit -text "Exit" -command Quit -relief link
pack .frmTool.btnFileOpen .frmTool.btnFileClose .frmTool.btnSaveTable .frmTool.btnSaveText -side left
pack .frmTool.lblSeparator1 -fill y -side left
pack .frmTool.entFilter .frmTool.btnFilterOn .frmTool.btnFilterOff -side left
pack .frmTool.lblSeparator2 -fill y -side left
pack .frmTool.btnExit -side right
set noteBook [NoteBook .frmBody.noteBook -font $fontNormal -side bottom]
pack $noteBook -fill both -expand true -padx 2 -pady 2
#set frmCat [frame .frmBody.frmCat -border 1 -relief sunken]
#pack $frmCat -side left -fill y -fill both
set frmWork [frame .frmBody.frmWork -border 1 -relief sunken]
pack $frmWork -side left -fill both -expand true
## Create StatusBAr ##
set frm2 [frame .frmStatus.frmActive -relief groove]
set frm4 [frame .frmStatus.frmLine]
set frm5 [frame .frmStatus.frmFile]
set frm6 [frame .frmStatus.frmFilter]
pack $frm4 -side left -fill x
pack $frm5 -side left
pack $frm6 -side left -fill x -expand true
pack $frm2 -side left -fill x
#pack -side left -fill x -expand true
label $frm4.lblLine -width 10 -relief sunken -font $fontNormal -anchor center
pack $frm4.lblLine -fill x
label $frm2.lblActive -relief sunken -font $fontNormal -anchor center -textvariable ::PROGTXT
label $frm5.lblFile -width 10 -relief sunken -font $fontNormal -anchor e -text Filter:
pack $frm5.lblFile
label $frm6.lblFilter -relief sunken -font $fontBold -anchor w
pack $frm6.lblFilter -fill x -expand true
bind . <Control-q> Quit
bind . <Control-s> SaveTable
bind . <Control-t> SaveText
bind . <Control-o> OpenFile
bind . <F1> HelpDialog
bind . <Control-w> CloseFile
bind .frmTool.entFilter <KeyRelease-Return> FilterOn
## startup procedure ##
ReadHeader [file join $dirWork fields]
if [file exists [file join $dirWork .bookmarks]] {
set f [open [file join $dirWork .bookmarks] r]
while {[gets $f line]>=0} {
OpenFile $line
}
}