svk
/
rac-gui
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Добавлена тема Black 

Заменены стандартные виджеты на аналогичные ttk
master
Sergey Kalinin 2018-08-02 13:10:23 +03:00
parent df5bedff6c
commit 08e683dd97
5 changed files with 367 additions and 199 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

410
lib/function.tcl
View File

@ -47,9 +47,9 @@ proc SetGlobalVarFromTreeItems {tree id} {
proc InsertItemsWorkList {lst} {
global work_list_row_count
if [expr $work_list_row_count % 2] {
set tag dark
} else {
set tag light
} else {
set tag dark
}
foreach i $lst {
if [regexp -nocase -all -- {(\D+)(\s*?|)(:)(\s*?|)(.*)} $i match param v2 v3 v4 value] {
@ -148,10 +148,10 @@ proc AuthorisationDialog {txt} {
set frm [AddToplevel "$txt" administrator_grey_64 .auth_win]
wm title .auth_win [::msgcat::mc "Authorization"]
label $frm.lbl_name -text [::msgcat::mc "User name"]
entry $frm.ent_name
label $frm.lbl_pwd -text [::msgcat::mc "Password"]
entry $frm.ent_pwd
ttk::label $frm.lbl_name -text [::msgcat::mc "User name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_pwd -text [::msgcat::mc "Password"]
ttk::entry $frm.ent_pwd
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
@ -723,6 +723,30 @@ proc Add {} {
#puts "$key, $id , $values"
Add::$key .frm_tree.tree $host $values
}
proc AddToplevel_ {lbl img {win_name .add}} {
set cmd "destroy $win_name"
if [winfo exists $win_name] {destroy $win_name}
toplevel $win_name
wm title $win_name [::msgcat::mc "Add record"]
wm iconphoto $win_name tcl
set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
set frm_btn [ttk::frame $win_name.frm_btn ]
ttk::label $frm_btn.lbl -image $img
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }
ttk::button $frm_btn.btn_cancel -command $cmd -image quit_grey_24
grid $frm_btn -row 0 -column 0 -sticky sn -padx 1 -pady 1
grid $frm -row 0 -column 1 -sticky nwe -padx 1 -pady 1
pack $frm_btn.lbl -side top
pack $frm_btn.btn_cancel $frm_btn.btn_ok -side bottom -fill x -padx 5 -pady 5
#pack $frm_btn.btn_ok -side bottom -padx 1
return $frm
}
proc AddToplevel {lbl img {win_name .add}} {
set cmd "destroy $win_name"
@ -730,20 +754,19 @@ proc AddToplevel {lbl img {win_name .add}} {
toplevel $win_name
wm title $win_name [::msgcat::mc "Add record"]
wm iconphoto $win_name tcl
ttk::label $win_name.lbl -image $img
ttk::label $win_name.lbl -image $img -anchor nw
set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
set frm_btn [frame $win_name.frm_btn -border 0]
set frm_btn [ttk::frame $win_name.frm_btn ]
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }
ttk::button $frm_btn.btn_cancel -command $cmd -image quit_grey_24
grid $win_name.lbl -row 0 -column 0 -sticky nw -padx 5 -pady 10
grid $frm -row 0 -column 1 -sticky nw -padx 5 -pady 5
grid $frm_btn -row 1 -column 1 -sticky se -padx 5 -pady 5
pack $frm_btn.btn_cancel -side right
pack $frm_btn.btn_ok -side right -padx 10
grid $win_name.lbl -row 0 -column 0 -sticky nsw -padx 0 -pady 1 -rowspan 2
grid $frm -row 0 -column 1 -sticky nw -padx 2 -pady 2
grid $frm_btn -row 1 -column 1 -sticky sew -padx 0 -pady 0
pack $frm_btn.btn_ok $frm_btn.btn_cancel -side right -padx 5 -pady 5
#pack $frm_btn.btn_ok -side right -padx 2
return $frm
}
@ -758,16 +781,16 @@ proc Add::agent_admin {tree host value} {
set frm [AddToplevel [::msgcat::mc "Agent cluster addministrator"] administrator_grey_64]
set auth [lindex $default(auth) 0]
label $frm.lbl_name -text [::msgcat::mc "User name"]
entry $frm.ent_name
label $frm.lbl_pwd -text [::msgcat::mc "Password"]
entry $frm.ent_pwd
label $frm.lbl_descr -text [::msgcat::mc "Description"]
entry $frm.ent_descr
label $frm.lbl_auth -text [::msgcat::mc "Authentication method"]
ttk::label $frm.lbl_name -text [::msgcat::mc "User name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_pwd -text [::msgcat::mc "Password"]
ttk::entry $frm.ent_pwd
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_auth -text [::msgcat::mc "Authentication method"]
ttk::combobox $frm.cb_auth -textvariable auth -values $default(auth)
label $frm.lbl_os_user -text [::msgcat::mc "OS user name"]
entry $frm.ent_os_user
ttk::label $frm.lbl_os_user -text [::msgcat::mc "OS user name"]
ttk::entry $frm.ent_os_user
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
@ -831,15 +854,15 @@ proc Add::server {} {
global default
set frm [AddToplevel [::msgcat::mc "Main server"] server_grey_64]
label $frm.lbl_host -text [::msgcat::mc "Address"]
entry $frm.ent_host
label $frm.lbl_port -text [::msgcat::mc "Port"]
entry $frm.ent_port
ttk::label $frm.lbl_host -text [::msgcat::mc "Address"]
ttk::entry $frm.ent_host
ttk::label $frm.lbl_port -text [::msgcat::mc "Port"]
ttk::entry $frm.ent_port
$frm.ent_port insert end $default(port)
grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.ent_host -row 0 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.ent_port -row 1 -column 1 -sticky new -padx 5 -pady 5
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
#set frm_btn [frame .add.frm_btn -border 0]
@ -864,45 +887,45 @@ proc Add::servers {tree host values} {
#set active_cluster $values
set frm [AddToplevel [::msgcat::mc "Work server"] server_grey_64]
label $frm.lbl_name -text [::msgcat::mc "Description"]
entry $frm.ent_name
label $frm.lbl_agent_host -text [::msgcat::mc "Address"]
entry $frm.ent_agent_host
label $frm.lbl_agent_port -text [::msgcat::mc "Port"]
entry $frm.ent_agent_port
ttk::label $frm.lbl_name -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_agent_host -text [::msgcat::mc "Address"]
ttk::entry $frm.ent_agent_host
ttk::label $frm.lbl_agent_port -text [::msgcat::mc "Port"]
ttk::entry $frm.ent_agent_port
$frm.ent_agent_port insert end $default(port)
label $frm.lbl_port_range -text [::msgcat::mc "Ports range"]
entry $frm.ent_port_range
ttk::label $frm.lbl_port_range -text [::msgcat::mc "Ports range"]
ttk::entry $frm.ent_port_range
$frm.ent_port_range insert end $default(port_range)
label $frm.lbl_safe_working_processes_memory_limit -text [::msgcat::mc "Maximum memory in working processes"]
entry $frm.ent_safe_working_processes_memory_limit
ttk::label $frm.lbl_safe_working_processes_memory_limit -text [::msgcat::mc "Maximum memory in working processes"]
ttk::entry $frm.ent_safe_working_processes_memory_limit
$frm.ent_safe_working_processes_memory_limit insert end $default(safe_working_processes_memory_limit)
label $frm.lbl_safe_call_memory_limit -text [::msgcat::mc "Safe memory consuption per call"]
entry $frm.ent_safe_call_memory_limit
ttk::label $frm.lbl_safe_call_memory_limit -text [::msgcat::mc "Safe memory consuption per call"]
ttk::entry $frm.ent_safe_call_memory_limit
$frm.ent_safe_call_memory_limit insert end $default(safe_call_memory_limit)
label $frm.lbl_memory_limit -text [::msgcat::mc "Memory use limit per working process"]
entry $frm.ent_memory_limit
ttk::label $frm.lbl_memory_limit -text [::msgcat::mc "Memory use limit per working process"]
ttk::entry $frm.ent_memory_limit
$frm.ent_memory_limit insert end $default(ram_work)
label $frm.lbl_infobases_limit -text [::msgcat::mc "Maximum number of infobases per working process"]
entry $frm.ent_infobases_limit
ttk::label $frm.lbl_infobases_limit -text [::msgcat::mc "Maximum number of infobases per working process"]
ttk::entry $frm.ent_infobases_limit
$frm.ent_infobases_limit insert end $default(infobases_limit)
label $frm.lbl_connections_limit -text [::msgcat::mc "Maximum nuber of connections per working process"]
entry $frm.ent_connections_limit
ttk::label $frm.lbl_connections_limit -text [::msgcat::mc "Maximum nuber of connections per working process"]
ttk::entry $frm.ent_connections_limit
$frm.ent_connections_limit insert end $default(connections_limit)
label $frm.lbl_cluster_port -text [::msgcat::mc "Main cluster manager port number"]
entry $frm.ent_cluster_port
ttk::label $frm.lbl_cluster_port -text [::msgcat::mc "Main cluster manager port number"]
ttk::entry $frm.ent_cluster_port
$frm.ent_cluster_port insert end $default(port)
label $frm.lbl_dedicate_managers -text [::msgcat::mc "Service manager allocation"]
checkbutton $frm.check_dedicate_managers -variable dedicate_managers -onvalue all -offvalue none
label $frm.lbl_using -text [::msgcat::mc "Working server use variant"]
checkbutton $frm.check_using -variable using -onvalue main -offvalue normal
ttk::label $frm.lbl_dedicate_managers -text [::msgcat::mc "Service manager allocation"]
ttk::checkbutton $frm.check_dedicate_managers -variable dedicate_managers -onvalue all -offvalue none
ttk::label $frm.lbl_using -text [::msgcat::mc "Working server use variant"]
ttk::checkbutton $frm.check_using -variable using -onvalue main -offvalue normal
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_agent_host -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_agent_host -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_agent_port -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_agent_port -row 2 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.ent_agent_port -row 2 -column 1 -sticky new -padx 5 -pady 5
grid $frm.lbl_port_range -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port_range -row 3 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_safe_working_processes_memory_limit -row 4 -column 0 -sticky nw -padx 5 -pady 5
@ -974,34 +997,34 @@ proc Add::infobases {tree host values} {
set frm [AddToplevel [::msgcat::mc "Infobase"] database_grey_64]
label $frm.lbl_name -text [::msgcat::mc "Name"]
entry $frm.ent_name
label $frm.lbl_descr -text [::msgcat::mc "Description"]
entry $frm.ent_descr
label $frm.lbl_security_level -text [::msgcat::mc "Security level"]
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_security_level -text [::msgcat::mc "Security level"]
ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
label $frm.lbl_db_server -text [::msgcat::mc "Database server address"]
entry $frm.ent_db_server
label $frm.lbl_dbms -text [::msgcat::mc "DBMS"]
ttk::label $frm.lbl_db_server -text [::msgcat::mc "Database server address"]
ttk::entry $frm.ent_db_server
ttk::label $frm.lbl_dbms -text [::msgcat::mc "DBMS"]
ttk::combobox $frm.cb_dbms -textvariable dbms -values $default(dbms)
label $frm.lbl_db_name -text [::msgcat::mc "Database name"]
entry $frm.ent_db_name
label $frm.lbl_db_user -text [::msgcat::mc "Database administrator"]
entry $frm.ent_db_user
label $frm.lbl_db_pwd -text [::msgcat::mc "Password"]
entry $frm.ent_db_pwd
ttk::label $frm.lbl_db_name -text [::msgcat::mc "Database name"]
ttk::entry $frm.ent_db_name
ttk::label $frm.lbl_db_user -text [::msgcat::mc "Database administrator"]
ttk::entry $frm.ent_db_user
ttk::label $frm.lbl_db_pwd -text [::msgcat::mc "Password"]
ttk::entry $frm.ent_db_pwd
#$frm.ent_host insert end $host
label $frm.lbl_locale -text [::msgcat::mc "Locale"]
entry $frm.ent_locale
ttk::label $frm.lbl_locale -text [::msgcat::mc "Locale"]
ttk::entry $frm.ent_locale
$frm.ent_locale insert end $default(locale)
label $frm.lbl_date_offset -text [::msgcat::mc "Date offset"]
ttk::label $frm.lbl_date_offset -text [::msgcat::mc "Date offset"]
ttk::combobox $frm.cb_date_offset -textvariable date_offset -values $default(date_offset)
label $frm.lbl_license_distribution -justify left -anchor nw -text [::msgcat::mc "Management license distribution"]
checkbutton $frm.cb_license_distribution -variable license_distribution -onvalue allow -offvalue deny
label $frm.lbl_create_db -text [::msgcat::mc "Create database"]
checkbutton $frm.cb_create_db -variable create_db -onvalue true -offvalue false
label $frm.lbl_scheduled_jobs_deny -text [::msgcat::mc "Sheduled jobs deny"]
checkbutton $frm.cb_scheduled_jobs_deny -variable scheduled_jobs_deny -onvalue on -offvalue off
ttk::label $frm.lbl_license_distribution -justify left -anchor nw -text [::msgcat::mc "Management license distribution"]
ttk::checkbutton $frm.cb_license_distribution -variable license_distribution -onvalue allow -offvalue deny
ttk::label $frm.lbl_create_db -text [::msgcat::mc "Create database"]
ttk::checkbutton $frm.cb_create_db -variable create_db -onvalue true -offvalue false
ttk::label $frm.lbl_scheduled_jobs_deny -text [::msgcat::mc "Sheduled jobs deny"]
ttk::checkbutton $frm.cb_scheduled_jobs_deny -variable scheduled_jobs_deny -onvalue on -offvalue off
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky new -padx 5 -pady 5
@ -1082,34 +1105,34 @@ proc Add::cluster {tree host values} {
set frm [AddToplevel [::msgcat::mc "Cluster"] cluster_grey_64]
label $frm.lbl_host -text [::msgcat::mc "Main server address"]
entry $frm.ent_host
label $frm.lbl_port -text [::msgcat::mc "Port"]
entry $frm.ent_port
ttk::label $frm.lbl_host -text [::msgcat::mc "Main server address"]
ttk::entry $frm.ent_host
ttk::label $frm.lbl_port -text [::msgcat::mc "Port"]
ttk::entry $frm.ent_port
$frm.ent_port insert end $default(port)
label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
entry $frm.ent_name
label $frm.lbl_secure_connect -text [::msgcat::mc "Secure level"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_secure_connect -text [::msgcat::mc "Secure level"]
ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
label $frm.lbl_expiration_timeout -text [::msgcat::mc "Forced termination time"]
entry $frm.ent_expiration_timeout -textvariable expiration_timeout
label $frm.lbl_session_fault_tolerance_level -text [::msgcat::mc "Fault-tolerance level"]
entry $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
label $frm.lbl_load_balancing_mode -text [::msgcat::mc "Load balancing mode"]
ttk::label $frm.lbl_expiration_timeout -text [::msgcat::mc "Forced termination time"]
ttk::entry $frm.ent_expiration_timeout -textvariable expiration_timeout
ttk::label $frm.lbl_session_fault_tolerance_level -text [::msgcat::mc "Fault-tolerance level"]
ttk::entry $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
ttk::label $frm.lbl_load_balancing_mode -text [::msgcat::mc "Load balancing mode"]
ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode \
-values $default(load_balancing_mode)
label $frm.lbl_errors_count_threshold -text [::msgcat::mc "Server errors threshold"]
entry $frm.ent_errors_count_threshold -textvariable errors_count_threshold
label $frm.lbl_processes -text [::msgcat::mc "Working process"]
label $frm.lbl_lifetime_limit -text [::msgcat::mc "Restart time"]
entry $frm.ent_lifetime_limit -textvariable lifetime_limit
label $frm.lbl_max_memory_size -text [::msgcat::mc "Maximum virtual address space"]
entry $frm.ent_max_memory_size -textvariable max_memory_size
label $frm.lbl_max_memory_time_limit -text [::msgcat::mc "Maximum period of memori size exeeding"]
entry $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
label $frm.lbl_kill_problem_processes -justify left -anchor nw -text [::msgcat::mc "Terminate corrupted processes"]
checkbutton $frm.check_kill_problem_processes -variable kill_problem_processes -onvalue yes -offvalue no
ttk::label $frm.lbl_errors_count_threshold -text [::msgcat::mc "Server errors threshold"]
ttk::entry $frm.ent_errors_count_threshold -textvariable errors_count_threshold
ttk::label $frm.lbl_processes -text [::msgcat::mc "Working process"]
ttk::label $frm.lbl_lifetime_limit -text [::msgcat::mc "Restart time"]
ttk::entry $frm.ent_lifetime_limit -textvariable lifetime_limit
ttk::label $frm.lbl_max_memory_size -text [::msgcat::mc "Maximum virtual address space"]
ttk::entry $frm.ent_max_memory_size -textvariable max_memory_size
ttk::label $frm.lbl_max_memory_time_limit -text [::msgcat::mc "Maximum period of memori size exeeding"]
ttk::entry $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
ttk::label $frm.lbl_kill_problem_processes -justify left -anchor nw -text [::msgcat::mc "Terminate corrupted processes"]
ttk::checkbutton $frm.check_kill_problem_processes -variable kill_problem_processes -onvalue yes -offvalue no
grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
@ -1176,19 +1199,19 @@ proc Add::rule {tree host values} {
#set type [lindex $default(obtype) 0]
set infobase_name ""
label $frm.lbl_object_type -text [::msgcat::mc "Object type"]
ttk::label $frm.lbl_object_type -text [::msgcat::mc "Object type"]
ttk::combobox $frm.cb_object_type -textvariable object_type \
-values $default(object_type)
label $frm.lbl_rule_type -text [::msgcat::mc "Rule type"]
ttk::label $frm.lbl_rule_type -text [::msgcat::mc "Rule type"]
ttk::combobox $frm.cb_rule_type -textvariable rule_type \
-values $default(rule_type)
label $frm.lbl_infobase_name -text [::msgcat::mc "Infobase"]
ttk::label $frm.lbl_infobase_name -text [::msgcat::mc "Infobase"]
ttk::combobox $frm.cb_infobase_name -textvariable infobase_name \
-values [GetInfobases $active_cluster $host]
label $frm.lbl_application_ext -text [::msgcat::mc "Application with an ajustment"]
entry $frm.ent_application_ext
label $frm.lbl_priority -text [::msgcat::mc "Priority"]
entry $frm.ent_priority
ttk::label $frm.lbl_application_ext -text [::msgcat::mc "Application with an ajustment"]
ttk::entry $frm.ent_application_ext
ttk::label $frm.lbl_priority -text [::msgcat::mc "Priority"]
ttk::entry $frm.ent_priority
$frm.ent_priority insert end $default(priority)
grid $frm.lbl_object_type -row 0 -column 0 -sticky nw -padx 5 -pady 5
@ -1238,36 +1261,36 @@ proc Add::profile {tree host values} {
set frm [AddToplevel [::msgcat::mc "Security profile"] security_grey_64]
label $frm.lbl_name -text [::msgcat::mc "Name"]
entry $frm.ent_name
label $frm.lbl_descr -text [::msgcat::mc Description"]
entry $frm.ent_descr
label $frm.lbl_config -justify left -anchor nw \
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_config -justify left -anchor nw \
-text [::msgcat::mc "Using the security profile from the configuration"]
checkbutton $frm.check_config -variable config -onvalue yes -offvalue no
label $frm.lbl_priv -justify left -anchor nw \
ttk::checkbutton $frm.check_config -variable config -onvalue yes -offvalue no
ttk::label $frm.lbl_priv -justify left -anchor nw \
-text [::msgcat::mc "Priveleged mode"]
checkbutton $frm.check_priv -variable priv -onvalue yes -offvalue no
label $frm.lbl_crypto -justify left -anchor nw \
ttk::checkbutton $frm.check_priv -variable priv -onvalue yes -offvalue no
ttk::label $frm.lbl_crypto -justify left -anchor nw \
-text [::msgcat::mc "Using cryptography function"]
checkbutton $frm.check_crypto -variable crypto -onvalue yes -offvalue no
label $frm.lbl_right_extension -justify left -anchor nw \
ttk::checkbutton $frm.check_crypto -variable crypto -onvalue yes -offvalue no
ttk::label $frm.lbl_right_extension -justify left -anchor nw \
-text [::msgcat::mc "All access right extention"]
checkbutton $frm.check_right_extension \
ttk::checkbutton $frm.check_right_extension \
-variable right_extension -onvalue yes -offvalue no
label $frm.lbl_right_extension_definition_roles -justify left -anchor nw \
ttk::label $frm.lbl_right_extension_definition_roles -justify left -anchor nw \
-text [::msgcat::mc "Roles that restrict access rights"]
ttk::combobox $frm.cb_right_extension_definition_roles \
-textvariable right_extension_definition_roles
label $frm.lbl_all_modules_extension -justify left -anchor nw \
ttk::label $frm.lbl_all_modules_extension -justify left -anchor nw \
-text [::msgcat::mc "Allow extention of all modules"]
checkbutton $frm.check_all_modules_extension \
ttk::checkbutton $frm.check_all_modules_extension \
-variable all_modules_extension -onvalue yes -offvalue no
label $frm.lbl_modules_available_for_extension \
ttk::label $frm.lbl_modules_available_for_extension \
-text [::msgcat::mc "Modules available for extention"]
ttk::combobox $frm.cb_modules_available_for_extension \
-textvariable modules_available_for_extension
label $frm.lbl_modules_not_available_for_extension \
ttk::label $frm.lbl_modules_not_available_for_extension \
-text [::msgcat::mc "Modules not available for extention"]
ttk::combobox $frm.cb_modules_not_available_for_extension \
-textvariable modules_not_available_for_extension
@ -1327,16 +1350,16 @@ proc Add::directory {tree host values} {
set frm [AddToplevel [::msgcat::mc "Virtual directory"] directory_grey_64]
label $frm.lbl_alias -text [::msgcat::mc "Logical URL"]
entry $frm.ent_alias
label $frm.lbl_descr -text [::msgcat::mc "Description"]
entry $frm.ent_descr
label $frm.lbl_physicalPath -justify left -anchor nw -text [::msgcat::mc "Phisical path"]
entry $frm.ent_physicalPath
label $frm.lbl_allowedRead -justify left -anchor nw -text [::msgcat::mc "Reading is allowed"]
checkbutton $frm.check_allowedRead -variable allowedRead -onvalue yes -offvalue no
label $frm.lbl_allowedWrite -justify left -anchor nw -text [::msgcat::mc "Write is allowed"]
checkbutton $frm.check_allowedWrite -variable allowedWrite -onvalue yes -offvalue no
ttk::label $frm.lbl_alias -text [::msgcat::mc "Logical URL"]
ttk::entry $frm.ent_alias
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_physicalPath -justify left -anchor nw -text [::msgcat::mc "Phisical path"]
ttk::entry $frm.ent_physicalPath
ttk::label $frm.lbl_allowedRead -justify left -anchor nw -text [::msgcat::mc "Reading is allowed"]
ttk::checkbutton $frm.check_allowedRead -variable allowedRead -onvalue yes -offvalue no
ttk::label $frm.lbl_allowedWrite -justify left -anchor nw -text [::msgcat::mc "Write is allowed"]
ttk::checkbutton $frm.check_allowedWrite -variable allowedWrite -onvalue yes -offvalue no
grid $frm.lbl_alias -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_alias -row 0 -column 1 -sticky nsew -padx 5 -pady 5
@ -1380,12 +1403,12 @@ proc Add::addin {tree host values} {
set frm [AddToplevel [::msgcat::mc "Available add-in"] addin_grey_64]
label $frm.lbl_name -text [::msgcat::mc "Name"]
entry $frm.ent_name
label $frm.lbl_descr -text [::msgcat::mc "Description"]
entry $frm.ent_descr
label $frm.lbl_hash -justify left -anchor nw -text [::msgcat::mc "Check summ"]
entry $frm.ent_hash
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_hash -justify left -anchor nw -text [::msgcat::mc "Check summ"]
ttk::entry $frm.ent_hash
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
@ -1421,12 +1444,12 @@ proc Add::module {tree host values} {
set frm [AddToplevel [::msgcat::mc "External module"] module_grey_64]
label $frm.lbl_name -text [::msgcat::mc "Name"]
entry $frm.ent_name
label $frm.lbl_descr -text [::msgcat::mc "Description"]
entry $frm.ent_descr
label $frm.lbl_hash -justify left -anchor nw -text [::msgcat::mc "Check summ"]
entry $frm.ent_hash
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_hash -justify left -anchor nw -text [::msgcat::mc "Check summ"]
ttk::entry $frm.ent_hash
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
@ -1462,16 +1485,16 @@ proc Add::com {tree host values} {
set frm [AddToplevel [::msgcat::mc "COM class"] com_grey_64]
label $frm.lbl_name -text [::msgcat::mc "Name"]
entry $frm.ent_name
label $frm.lbl_descr -text [::msgcat::mc "Description"]
entry $frm.ent_descr
label $frm.lbl_fileName -justify left -anchor nw -text [::msgcat::mc "Moniker file name"]
entry $frm.ent_fileName
label $frm.lbl_id -justify left -anchor nw -text [::msgcat::mc "COM class ID"]
entry $frm.ent_id
label $frm.lbl_host -justify left -anchor nw -text [::msgcat::mc "COM object computer"]
entry $frm.ent_host
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_fileName -justify left -anchor nw -text [::msgcat::mc "Moniker file name"]
ttk::entry $frm.ent_fileName
ttk::label $frm.lbl_id -justify left -anchor nw -text [::msgcat::mc "COM class ID"]
ttk::entry $frm.ent_id
ttk::label $frm.lbl_host -justify left -anchor nw -text [::msgcat::mc "COM object computer"]
ttk::entry $frm.ent_host
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
@ -1513,12 +1536,12 @@ proc Add::app {tree host values} {
set frm [AddToplevel [::msgcat::mc "Application"] app_grey_64]
label $frm.lbl_name -text [::msgcat::mc "Name"]
entry $frm.ent_name
label $frm.lbl_descr -text [::msgcat::mc "Description"]
entry $frm.ent_descr
label $frm.lbl_wild -justify left -anchor nw -text [::msgcat::mc "Aplication command line sintax"]
entry $frm.ent_wild
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_wild -justify left -anchor nw -text [::msgcat::mc "Aplication command line sintax"]
ttk::entry $frm.ent_wild
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
@ -1553,16 +1576,16 @@ proc Add::inet {tree host values} {
set frm [AddToplevel [::msgcat::mc "Internet resource"] link_grey_64]
label $frm.lbl_name -text [::msgcat::mc "Name"]
entry $frm.ent_name
label $frm.lbl_descr -text [::msgcat::mc "Description"]
entry $frm.ent_descr
label $frm.lbl_protocol -justify left -anchor nw -text [::msgcat::mc "Protocol"]
entry $frm.ent_protocol
label $frm.lbl_url -justify left -anchor nw -text [::msgcat::mc "Address (URL)"]
entry $frm.ent_url
label $frm.lbl_port -justify left -anchor nw -text [::msgcat::mc "Port"]
entry $frm.ent_port
ttk::label $frm.lbl_name -text [::msgcat::mc "Name"]
ttk::entry $frm.ent_name
ttk::label $frm.lbl_descr -text [::msgcat::mc "Description"]
ttk::entry $frm.ent_descr
ttk::label $frm.lbl_protocol -justify left -anchor nw -text [::msgcat::mc "Protocol"]
ttk::entry $frm.ent_protocol
ttk::label $frm.lbl_url -justify left -anchor nw -text [::msgcat::mc "Address (URL)"]
ttk::entry $frm.ent_url
ttk::label $frm.lbl_port -justify left -anchor nw -text [::msgcat::mc "Port"]
ttk::entry $frm.ent_port
$frm.ent_port insert end 0
grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
@ -1724,31 +1747,31 @@ proc Edit::infobase {tree host values} {
$frm configure -text [::msgcat::mc "Infobase"]
#set active_cluster $values
label $frm.lbl_denied_from -text "Начало интервала времени действия\nрежима блокировки сеансов" \
ttk::label $frm.lbl_denied_from -text "Начало интервала времени действия\nрежима блокировки сеансов" \
-justify left -anchor nw
entry $frm.ent_denied_from
label $frm.lbl_denied_message -text "Cообщение, при попытке нарушения\nблокировки сеансов" \
ttk::entry $frm.ent_denied_from
ttk::label $frm.lbl_denied_message -text "Cообщение, при попытке нарушения\nблокировки сеансов" \
-justify left -anchor nw
entry $frm.ent_denied_message
label $frm.lbl_denied_parameter -text "Параметр блокировки сеансов"
entry $frm.ent_denied_parameter
label $frm.lbl_denied_to -text "Конец интервала времени действия\nрежима блокировки сеансов" \
ttk::entry $frm.ent_denied_message
ttk::label $frm.lbl_denied_parameter -text "Параметр блокировки сеансов"
ttk::entry $frm.ent_denied_parameter
ttk::label $frm.lbl_denied_to -text "Конец интервала времени действия\nрежима блокировки сеансов" \
-justify left -anchor nw
entry $frm.ent_denied_to
label $frm.lbl_permission_code -text "Код разрешения начала сеанса\nвопреки блокировке сеансов" \
ttk::entry $frm.ent_denied_to
ttk::label $frm.lbl_permission_code -text "Код разрешения начала сеанса\nвопреки блокировке сеансов" \
-justify left -anchor nw
entry $frm.ent_permission_code
label $frm.lbl_external_session_manager_connection_string \
ttk::entry $frm.ent_permission_code
ttk::label $frm.lbl_external_session_manager_connection_string \
-text "Параметры внешнего управления сеансами"
entry $frm.ent_external_session_manager_connection_string
label $frm.lbl_security_profile -text "Профиль безопасности информационной базы"
entry $frm.ent_security_profile
label $frm.lbl_safe_mode_security_profile_name -text "Профиль безопасности внешнего кода"
entry $frm.ent_safe_mode_security_profile_name
label $frm.lbl_sessions_deny -text "Режим блокировки сеансов"
checkbutton $frm.check_sessions_deny -variable sessions_deny -onvalue on -offvalue off
label $frm.lbl_external_session_manager_required -text "Внешнее управление сеансами"
checkbutton $frm.check_external_session_manager_required \
ttk::entry $frm.ent_external_session_manager_connection_string
ttk::label $frm.lbl_security_profile -text "Профиль безопасности информационной базы"
ttk::entry $frm.ent_security_profile
ttk::label $frm.lbl_safe_mode_security_profile_name -text "Профиль безопасности внешнего кода"
ttk::entry $frm.ent_safe_mode_security_profile_name
ttk::label $frm.lbl_sessions_deny -text "Режим блокировки сеансов"
ttk::checkbutton $frm.check_sessions_deny -variable sessions_deny -onvalue on -offvalue off
ttk::label $frm.lbl_external_session_manager_required -text "Внешнее управление сеансами"
ttk::checkbutton $frm.check_external_session_manager_required \
-variable external_session_manager_required -onvalue yes -offvalue no
grid $frm.lbl_denied_from -row 0 -column 2 -sticky nsw -padx 5 -pady 5
@ -2312,3 +2335,6 @@ proc Del::app {tree host profile_name} {
proc Del::inet {tree host profile_name} {
Del::acl $host inet [GetWorkTreeItems "name"] $profile_name
}

8
lib/gui.tcl
View File

@ -28,10 +28,10 @@ wm positionfrom . user
#ttk::style configure Custom.Treeview -foreground red
#ttk::style configure Custom.Treeview -rowheight 20
ttk::style theme use clam
ttk::style theme use black
# Панель инсрументов
set frm_tool [frame .frm_tool]
set frm_tool [ttk::frame .frm_tool]
pack $frm_tool -side left -fill y
ttk::panedwindow .panel -orient horizontal -style TPanedwindow
pack .panel -expand true -fill both
@ -48,7 +48,7 @@ pack $frm_tool.btn_quit -side bottom -padx 5 -pady 5
#pack $frm_tool.lbl_logo -side bottom -padx 5 -pady 5
# Дерево с полосами прокрутки
set frm_tree [frame .frm_tree]
set frm_tree [ttk::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]
@ -66,7 +66,7 @@ grid rowconfigure $frm_tree 0 -weight 1
bind $frm_tree.tree <ButtonRelease> "TreePress $frm_tree.tree"
# Список для данных (таблица)
set frm_work [frame .frm_work]
set frm_work [ttk::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 [

139
lib/ttk_theme_black.tcl 100644
View File

@ -0,0 +1,139 @@
# black.tcl -
#
# Experimental!
#
# Copyright (c) 2007-2008 Mats Bengtsson
#
# $Id: black.tcl,v 1.2 2009/10/25 19:21:30 oberdorfer Exp $
package require Tk
namespace eval ttk::theme::black {
variable version 0.0.1
variable dir [file dirname [info script]]
package provide ttk::theme::black $version
# NB: These colors must be in sync with the ones in black.rdb
variable colors
array set colors {
-disabledfg "#a9a9a9"
-frame "#424242"
-lightframe "#616161"
-dark "#222222"
-darker "#121212"
-darkest "#000000"
-lighter "#626262"
-lightest "#ffffff"
-selectbg "#4a6984"
-selectfg "#ffffff"
-foreground "#ffffff"
}
ttk::style theme create black -parent clam -settings {
# -----------------------------------------------------------------
# Theme defaults
#
ttk::style configure . \
-background $colors(-frame) \
-foreground #ffffff \
-bordercolor $colors(-darkest) \
-darkcolor $colors(-dark) \
-lightcolor $colors(-lighter) \
-troughcolor $colors(-darker) \
-selectbackground $colors(-selectbg) \
-selectforeground $colors(-selectfg) \
-selectborderwidth 0 \
-font TkDefaultFont
ttk::style map "." \
-background [list disabled $colors(-frame) \
active $colors(-lighter)] \
-foreground [list disabled $colors(-disabledfg)] \
-selectbackground [list !focus $colors(-darkest)] \
-selectforeground [list !focus #ffffff]
# ttk widgets.
ttk::style configure TButton \
-width -8 -padding {5 1} -relief raised
ttk::style configure TMenubutton \
-width -11 -padding {5 1} -relief raised
ttk::style configure TCheckbutton \
-indicatorbackground "#ffffff" -indicatormargin {1 1 4 1}
ttk::style configure TRadiobutton \
-indicatorbackground "#ffffff" -indicatormargin {1 1 4 1}
# ttk::style configure TEntry -fieldbackground #ffffff -foreground #000000 -padding {2 0}
ttk::style configure TEntry -fieldbackground $colors(-lightframe) -foreground #ffffff -padding {2 0}
ttk::style configure TCombobox \
-fieldbackground $colors(-lightframe) \
-foreground #ffffff \
-padding {2 0}
ttk::style configure TSpinbox \
-fieldbackground $colors(-lightframe) \
-foreground #ffffff
ttk::style configure TNotebook.Tab \
-padding {6 2 6 2}
#ttk::style configure TPanedwindow -fieldbackground #ffffff -foreground #000000
#ttk::style configure TPanedwindow -background red -foreground blue
# tk widgets.
ttk::style map Menu \
-background [list active $colors(-lighter)] \
-foreground [list disabled $colors(-disabledfg)]
ttk::style configure Treeview \
-background $colors(-lightframe) -itembackground {gray60 gray50} \
-itemfill #ffffff -itemaccentfill yellow \
-fieldbackground $colors(-lightframe) \
-selectbg "#4a6984"
# ttk::style configure TreeCtrl \
# -background gray30 -itembackground {gray60 gray50} \
# -itemfill #ffffff -itemaccentfill yellow
}
option add *Toplevel.Background $colors(-dark) interactive
option add *Treeview.Background red interactive
# option add *Frame.Background $colors(-frame) interactive
# option add *Label.Background $colors(-frame) interactive
# option add *Label.Foreground $colors(-foreground) interactive
# option add *Entry.Background $colors(-frame) interactive
# option add *Entry.Foreground $colors(-foreground) interactive
}
# A few tricks for Tablelist.
namespace eval ::tablelist:: {
proc blackTheme {} {
variable themeDefaults
array set colors [array get ttk::theme::black::colors]
array set themeDefaults [list \
-background "#000000" \
-foreground "#ffffff" \
-disabledforeground $colors(-disabledfg) \
-stripebackground "#191919" \
-selectbackground "#4a6984" \
-selectforeground "#8b8b00" \
-selectborderwidth 0 \
-font TkTextFont \
-labelbackground $colors(-frame) \
-labeldisabledBg "#dcdad5" \
-labelactiveBg "#eeebe7" \
-labelpressedBg "#eeebe7" \
-labelforeground #ffffff \
-labeldisabledFg "#999999" \
-labelactiveFg #ffffff \
-labelpressedFg #ffffff \
-labelfont TkDefaultFont \
-labelborderwidth 2 \
-labelpady 1 \
-arrowcolor "" \
-arrowstyle sunken10x9 ]
}
}

7
rac_gui.cfg
View File

@ -114,7 +114,8 @@ set default(auth) {
os
}
# цвета строк в таблице
set color(dark_table_bg) "#e2e2e2"
set color(light_table_bg) "#ffffff"
#set color(dark_table_bg) "#e2e2e2"
#set color(light_table_bg) "#ffffff"
set color(dark_table_bg) "#6f6f6f"
set color(light_table_bg) "#424242"

2
rac_gui.tcl
View File

@ -99,3 +99,5 @@ if [file exists [file join $dir(work) 1c_srv.cfg]] {