Initial release

This commit is contained in:
Sergey Kalinin 2018-05-16 14:17:27 +03:00
commit e4dc98ad34
11 changed files with 243 additions and 0 deletions

11
1c_srv.cfg Normal file
View File

@ -0,0 +1,11 @@
######################################################
# Rac GUI
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Copyright (c) "http://nuk-svk.ru", 2018,
# https://bitbucket.org/svk28/rac-gui
######################################################
set host 1c-vm-srv
set port 1541

9
CHANGELOG Normal file
View File

@ -0,0 +1,9 @@
######################################################
# Rac GUI
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Home page: https://bitbucket.org/svk28/rac-gui
######################################################
16/05/2018
- Beginning the project

7
COPYING Normal file
View File

@ -0,0 +1,7 @@
######################################################
# Rac GUI
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Home page: https://bitbucket.org/svk28/rac-gui
######################################################

7
INSTALL Normal file
View File

@ -0,0 +1,7 @@
######################################################
# Rac GUI
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Home page: https://bitbucket.org/svk28/rac-gui
######################################################

7
README Normal file
View File

@ -0,0 +1,7 @@
######################################################
# Rac GUI
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Home page: https://bitbucket.org/svk28/rac-gui
######################################################

7
TODO Normal file
View File

@ -0,0 +1,7 @@
######################################################
# Rac GUI
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Home page: https://bitbucket.org/svk28/rac-gui
######################################################

0
errors Normal file
View File

60
lib/function.tcl Normal file
View File

@ -0,0 +1,60 @@
######################################################
# Rac GUI
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Copyright (c) "http://nuk-svk.ru", 2018
# https://bitbucket.org/svk28/rac-gui
######################################################
proc Quit {} {
exit
}
proc TreePress {tree} {
global host
set cluster [$tree item [$tree selection] -values]
set root [$tree selection]
RunCommand $root "infobase summary list --cluster=$cluster $host"
}
proc RunCommand {root par} {
global dir rac_cmd cluster
set pipe [open "|$rac_cmd $par" "r"]
while {[gets $pipe line]>=0} {
puts "$line"
set str [split $line ":"]
set param [string trim [lindex $str 0]]
set val [string trim [lindex $str 1]]
.frm_work.tree_work insert {} end -text "$param" -values "$val"
#.frm_work.tree_work insert {} end -text "$val" -values "$val"
if {$param eq "cluster"} {
set cluster $val
}
if {$param eq "name"} {
set cluster_name $val
.frm_tree.tree insert $root end -text "$val" -values "$cluster"
}
}
close $pipe
# fileevent $pipe readable [list DebugInfo .frm_work.tree_work $pipe]
# fconfigure $pipe -buffering none -blocking no
}
proc DebugInfo {widget f} {
if {[eof $f]} {
catch [close $f] msg
if {$msg != ""} {
puts $msg
} else {
puts $msg
}
}
while {[gets $f line]>=0} {
puts "$line"
$widget insert {} end -text "$line" -values "$line"
}
}

81
lib/gui.tcl Normal file
View File

@ -0,0 +1,81 @@
######################################################
# Rac GUI
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Copyright (c) "http://nuk-svk.ru"
# 2018, https://bitbucket.org/svk28/rac-gui
######################################################
if {[info exists topLevelGeometry]} {
wm geometry . $topLevelGeometry
} else {
wm geometry . 1024x768+0+0
}
wm title . "1C Rac GUI"
wm iconname . "1C Rac Gui"
#image create photo icon -data {}
#wm iconphoto . icon
wm protocol . WM_DELETE_WINDOW Quit
wm overrideredirect . 0
wm positionfrom . user
set frm_tree [frame .frm_tree]
ttk::scrollbar $frm_tree.hsb1 -orient horizontal -command [list $frm_tree.tree xview]
ttk::scrollbar $frm_tree.vsb1 -orient vertical -command [list $frm_tree.tree yview]
set tree [ttk::treeview $frm_tree.tree -xscrollcommand [list $frm_tree.hsb1 set] -yscrollcommand [list $frm_tree.vsb1 set]]
grid $tree -row 0 -column 0 -sticky nsew
grid $frm_tree.vsb1 -row 0 -column 1 -sticky nsew
grid $frm_tree.hsb1 -row 1 -column 0 -sticky nsew
grid columnconfigure $frm_tree 0 -weight 1
grid rowconfigure $frm_tree 0 -weight 1
#bind $frm_tree.tree <ButtonRelease> "TreePress %x %y %X %Y $frm_tree.tree"
bind $frm_tree.tree <ButtonRelease> "TreePress $frm_tree.tree"
#$tree insert {} end -id Languages -text "Languages"
#$tree insert Languages end -text C -values [list "Dennis Ritchie" "1990"]
#$tree insert "" end -id Direct -text "Direct"
#$tree insert Direct end -text C -values [list "Dennis Ritchie" "1990"]
set frm_work [frame .frm_work]
ttk::scrollbar $frm_work.hsb -orient horizontal -command [list $frm_work.tree_work xview]
ttk::scrollbar $frm_work.vsb -orient vertical -command [list $frm_work.tree_work yview]
set tree_work [ttk::treeview $frm_work.tree_work -columns "par val" -displaycolumns "par val" -xscrollcommand [list $frm_work.hsb set] -yscrollcommand [list $frm_work.vsb set]]
#set tree_work [ttk::treeview $frm_work.tree_work \
#$tree_work heading Creator -text "Creator" -anchor center
#$tree_work heading Year -text "Year" -anchor center
grid $tree_work -row 0 -column 0 -sticky nsew
grid $frm_work.vsb -row 0 -column 1 -sticky nsew
grid $frm_work.hsb -row 1 -column 0 -sticky nsew
grid columnconfigure $frm_work 0 -weight 1
grid rowconfigure $frm_work 0 -weight 1
#pack $tree_work -expand true -fill both
#pack $frm_tree -side left -expand true -fill both
pack $frm_tree $frm_work -side left -expand true -fill both
# $tree_work insert {} end -id Languages -text "Languages"
# $tree_work insert Languages end -text C -values [list "Dennis Ritchie" "1990"]
# $tree_work insert "" end -id Direct -text "Direct"
# $tree_work insert Direct end -text C -values [list "Dennis Ritchie" "1990"]
#
# #toplevel .
# text .t.txt -wrap none -xscroll {.t.h set} -yscroll {.t.v set}
# scrollbar .t.v -orient vertical -command {.t.txt yview}
# scrollbar .t.h -orient horizontal -command {.t.txt xview}
#
# # Lay them out
# grid .t.txt .t.v -sticky nsew
# grid .t.h -sticky nsew
#
# # Tell the text widget to take all the extra room
# grid rowconfigure .t .t.txt -weight 1
# grid columnconfigure .t .t.txt -weight 1

10
rac_gui.cfg Normal file
View File

@ -0,0 +1,10 @@
######################################################
# Rac GUI
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Copyright (c) "http://nuk-svk.ru", 2018,
# https://bitbucket.org/svk28/rac-gui
######################################################
set locale "ru"
set rac_cmd "/opt/1C/v8.3/x86_64/rac"
set dir(lib) [file join [pwd] lib]

44
rac_gui.tcl Normal file
View File

@ -0,0 +1,44 @@
#!/bin/sh
# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "$@"
######################################################
# Rac GUI
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Home page: https://bitbucket.org/svk28/rac-gui
######################################################
source [file join [pwd] rac_gui.cfg]
source [file join [pwd] 1c_srv.cfg]
set dir(root) [pwd]
set dir(msg) "[file join $dir(root) msgs]"
set dir(lib) "[file join $dir(root) lib]"
## SETTINGS ENVIRONMENT LANGUAGE ##
if [info exists env(LANG)] {
set locale $env(LANG)
} else {
set locale $locale
}
::msgcat::mclocale $locale
::msgcat::mcload $dir(msg)
## LOAD FILE ##
# Load modules but maain.tcl must last loaded
foreach modFile [lsort [glob -nocomplain [file join $dir(lib) *.tcl]]] {
if {[file tail $modFile] ne "gui.tcl"} {
source $modFile
puts "Loaded module $modFile"
}
}
source [file join $dir(lib) gui.tcl]
puts "$rac_cmd $dir(lib)"
.frm_tree.tree insert {} end -id "$host" -text "$host" -values "$host"
RunCommand $host "cluster list $host $port"