home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 2000 February
/
PCWorld_2000-02_cd.bin
/
live
/
usr
/
X11R6
/
lib
/
X11
/
cbb
/
prefs.tcl
< prev
next >
Wrap
Text File
|
1998-10-07
|
8KB
|
303 lines
#!/usr/bin/wish -f
#
# 'CBB' -- Check Book Balancer
#
# prefs.tcl -- additional preferences (startdate, cryptography)
#
# Written by Martin Schenk <schenkm@ping.at>
#
# Copyright (C) 1997 Martin Schenk <schenkm@ping.at>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# $Id: prefs.tcl,v 2.3 1997/06/12 21:57:22 curt Exp $
# (Log is kept at end of this file)
# use cryptography
proc useCrypt {} {
global cbb eng
if { "$cbb(use_crypt)" == 0 } { # disable cryptography
set cbb(pref_chg) 1
puts $eng "encrypt"; flush $eng;
gets $eng result;
puts $eng "decrypt"; flush $eng;
gets $eng result;
puts $eng "logging 1"; flush $eng;
gets $eng result;
return;
}
# test whether program is already defined
if { (("$cbb(decrypt)" == "") || ( "$cbb(encrypt)" == "")) } {
setCryptProgram
# return, because setCryptProgram called us again
return
}
# test whether code is already defined
if { "$cbb(crypt_code)" == "" } {
setCryptCode
# return, because setCryptCode called us again
return
}
set cbb(pref_chg) 1
# both program and code are defined, send new methods to backend
puts $eng "encrypt $cbb(encrypt) \"$cbb(crypt_code)\""; flush $eng;
gets $eng result;
puts $eng "decrypt $cbb(decrypt) \"$cbb(crypt_code)\""; flush $eng;
gets $eng result;
puts $eng "logging 0"; flush $eng;
gets $eng result;
}
proc setCryptProgram {} {
global cbb
set oen $cbb(encrypt)
set ode $cbb(decrypt)
if { [cbbWindows.opt "Set Cryptprograms" "Enter New Cryptprograms" \
{{"encoding" cbb(encrypt)} {"decoding" cbb(decrypt)}}] } {
set cbb(pref_chg) 1
} else {
set cbb(encrypt) $oen
set cbb(decrypt) $ode
}
if { $cbb(use_crypt) } {
if { (( "$cbb(decrypt)" != "") && ( "$cbb(encrypt)" != "")) } {
# change the settings in the backend
useCrypt
} else {
cbbWindow.ok "no valid cryptprogram, cannot use cryptography"
tkwait window .ok
set cbb(use_crypt) 0
}
}
}
proc setCryptCode {} {
global cbb
set oc $cbb(crypt_code)
cbbWindows.prefCryptCode
tkwait window .prefCryptCode
if { ($cbb(use_crypt) && ( "$cbb(crypt_code)" != -1)) } {
# change the settings in the backend
useCrypt
}
if { ($cbb(crypt_code) == -1) } {
set cbb(crypt_code) $oc
} else {
set cbb(pref_chg) 1
}
if { ($cbb(use_crypt) && ("$cbb(crypt_code)" == "")) } {
cbbWindow.ok "no valid cryptcode, cannot use cryptography"
tkwait window .ok
set cbb(use_crypt) 0
}
}
# set new StartDate
proc setStartDate {} {
global cbb eng
set oldsdate $cbb(sdate)
if { [cbbWindows.opt "Set Startdate" "enter startdate" \
{{"new startdate" cbb(sdate)}}] } {
set cbb(pref_chg) 1
puts $eng "start_date $cbb(sdate)"; flush $eng
gets $eng cbb(int_sdate)
} else {
set cbb(sdate) $oldsdate
}
}
# set dimensions (of list boxes)
proc setDimensions {} {
global cbb dim
set dim(list_width) $cbb(list_width)
set dim(list_height) $cbb(list_height)
set dim(acctlist_height) $cbb(acctlist_height)
if { [cbbWindows.opt "Dimensions" "Enter width in columns, height in rows" \
{{"listbox width" dim(list_width)} {"listbox height" dim(list_height)}
{"accountbox height" dim(acctlist_height)}}] } {
set cbb(pref_chg) 1
set cbb(list_width) $dim(list_width)
set cbb(list_height) $dim(list_height)
set cbb(acctlist_height) $dim(acctlist_height)
}
}
# specify CryptCodes
proc cbbWindows.prefCryptCode {} {
global cbb
if {[winfo exists .prefCryptCode] == 1} {
wm withdraw .prefCryptCode
wm deiconify .prefCryptCode
return
}
set cryptcode2 $cbb(crypt_code)
toplevel .prefCryptCode
option add *font $cbb(dialog_font)
wm title .prefCryptCode "Set Cryptcode"
wm iconname .prefCryptCode "Set Cryptcode"
frame .prefCryptCode.frame -borderwidth 2
frame .prefCryptCode.frame.n
frame .prefCryptCode.frame.d
frame .prefCryptCode.frame.b
label .prefCryptCode.frame.label -text \
"Enter New Cryptcode"
label .prefCryptCode.frame.n.label -text "code"
entry .prefCryptCode.frame.n.entry -textvariable cbb(crypt_code) -relief sunken \
-font $cbb(default_font) -show "*"
.prefCryptCode.frame.n.entry icursor 0
.prefCryptCode.frame.n.entry icursor end
label .prefCryptCode.frame.d.label -text "reenter"
entry .prefCryptCode.frame.d.entry -textvariable cryptcode2 -relief sunken \
-font $cbb(default_font) -show "*"
button .prefCryptCode.frame.b.create -text "Set Code" \
-font $cbb(button_font) -command {
if { "$cryptcode2" == "$cbb(crypt_code)" } {
destroy .prefCryptCode
} else {
cbbWindow.ok "you did not type the same code twice, please try again"
tkwait window .ok
}
}
button .prefCryptCode.frame.b.cancel -text "Cancel" -font $cbb(button_font) \
-command {
set cbb(crypt_code) -1
destroy .prefCryptCode
}
pack .prefCryptCode.frame -fill both -expand 1 -padx 4 -pady 4
pack .prefCryptCode.frame.label -padx 4 -pady 2
pack .prefCryptCode.frame.b -side bottom -fill x -padx 4 -pady 2
pack .prefCryptCode.frame.n .prefCryptCode.frame.d \
-fill both -expand 1 -padx 4 -pady 2
pack .prefCryptCode.frame.n.label -side left
pack .prefCryptCode.frame.d.label -side left
pack .prefCryptCode.frame.d.entry -side left -fill x -expand 1
pack .prefCryptCode.frame.n.entry -side left -fill x -expand 1
pack .prefCryptCode.frame.b.create .prefCryptCode.frame.b.cancel -side left \
-fill x -expand 1 -padx 4 -pady 4
focus .prefCryptCode.frame.n.entry
}
# cbbWindows.opt automatically constructs a window to enter options
#
# title is the window title
# desc is a description text shown in the first line
# entries is a list of entry descriptions
# each entry description consists of a label and a (global) variable name
#
# sample :
# cbbWindows.opt "title" "this is a test" {{"test 1" a} {"test 2" b}}
#
# return 1 if ok, 0 if canceled
#
proc cbbWindows.opt { title desc entries } {
global optcancel cbb
set optcancel 0
toplevel .opt
option add *font $cbb(dialog_font)
wm title .opt $title
wm iconname .opt $title
frame .opt.frame -borderwidth 2
frame .opt.frame.b
label .opt.frame.label -text $desc
set ll [llength $entries]
set l {}
for { set i 0 } { $i < $ll } { incr i } {
set l [concat $l .opt.frame.$i]
frame .opt.frame.$i
set e [lindex $entries $i]
label .opt.frame.$i.label -text [lindex $e 0]
entry .opt.frame.$i.entry -textvariable [lindex $e 1] -relief sunken \
-font $cbb(default_font)
}
.opt.frame.0.entry icursor 0
.opt.frame.0.entry icursor end
button .opt.frame.b.ok -text "Ok" -font $cbb(button_font) -command { destroy .opt }
button .opt.frame.b.cancel -text "Cancel" -font $cbb(button_font) -command {
set optcancel 1
destroy .opt
}
pack .opt.frame -fill both -expand 1 -padx 4 -pady 4
pack .opt.frame.label -padx 4 -pady 2
pack .opt.frame.b -side bottom -fill x -padx 4 -pady 2
# expand $l before executing pack
eval "pack $l -fill both -expand 1 -padx 4 -pady 2"
for { set i 0 } { $i < $ll } { incr i } {
pack .opt.frame.$i.label -side left
pack .opt.frame.$i.entry -side left -fill x -expand 1
}
pack .opt.frame.b.ok .opt.frame.b.cancel -side left -fill x -expand 1 \
-padx 4 -pady 4
focus .opt.frame.0.entry
tkwait window .opt
if { $optcancel == 1 } { return 0 }
return 1
}
# ----------------------------------------------------------------------------
# $Log: prefs.tcl,v $
# Revision 2.3 1997/06/12 21:57:22 curt
# Added cvs headers/log.
#