EventLoop
are_arrays_identical
array_to_keyed_list
calculate_ratio_of_month_left
copy_array
day_month_calculations
days_in_month
die
dollar_format
fail_exit
force_width
getargs
keyed_list_to_array
load_stanza_file
next_month_year
parse_rfc822_line
parse_rfc822_mail_address
parse_stanza_line
prompt
prompt_choices
prompt_yn
read_rfc822
read_rfc822_group
read_stanza_body
read_stanza_file
read_stanza_header
require
rfc931
save_stanza_file
spawn_child
store_stanza_field
write_rfc822
write_rfc822_group
write_stanza
xkeylget
EventLoop - an [incr tcl] class
EventLoop object -selectTimeout 10 -timeoutCallout {}
inherits
object make_select_list
object run
object stop
object add_trigger
file command
object remove_trigger
file
#@package: EventLoop EventLoop
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
###
#
#
# $Id: neolib.html,v 1.1 1996/09/28 21:17:44 kunkee Exp $
#
# Incr Tcl Event Loop class.
#
# For use with Extended Tcl, but not Wishx, which has its
# own mechanism (addinput). A functionally identical EventLoop
# class for Wishx would be really nice.
#
constructor {config} {
}
destructor {
}
# make a list containing the file handles of all the sockets,
# pipes, fifos, etc, we are waiting for data from.
method make_select_list {} {
set readSelectList [array names readSelectorCallouts]
}
#
# run an event loop, waiting for input from any of the file handles
# we've been told to look at, and calling the timeoutCallout,
# if it exists, every selectTimeout floating point seconds.
#
method run {} {
set running 1
make_select_list
while {$running} {
set selectResult [select $readSelectList "" "" $selectTimeout]
set readReadyList [lindex $selectResult 0]
if {$readReadyList == ""} {
eval $timeoutCallout
}
foreach readReady $readReadyList {
set command $readSelectorCallouts($readReady)
if {[gets $readReady line] < 0} {
close $readReady
continue
}
[lindex $command 0] [lindex $command 1] $line
}
}
}
# stop the event loop after the event that invoked this method
# finishes
method stop {} {
set running 0
}
# add a trigger whereby data on the specified filehandle causes
# command to execute
method add_trigger {file command} {
set readSelectorCallouts($file) $command
}
# remove the trigger on the specified filehandle
method remove_trigger {file} {
unset readSelectorCallouts($file)
}
# true while the event loop is running
protected running 0
# array where keys are file handles and data are commands to execute
protected readSelectorCallouts
# list of file handles to select on as a list
protected readSelectList
# timeout interval, default 10 seconds
public selectTimeout 10
# timeout callout code, default is to do nothing
public timeoutCallout ""
are_arrays_identical
are_arrays_identical array1Name array2Name
#
# Return true if two arrays are identical, else false.
#
upvar $array1Name array1 $array2Name array2
# if they don't have the same number of elements, no way are they identical
if {[array size array1] != [array size array2]} {return 0}
# For each element in the first array,
# If the element isn't in the second array, they're not identical.
# If the contents of both elements aren't the same, the arrays aren't
# identical.
# If you get to the end, the arrays are identical.
set searchId [array startsearch array1]
while {[array anymore array1 $searchId]} {
set elementName [array nextelement array1 $searchId]
if ![info exists array2($elementName)] {return 0}
if {$array1($elementName) != $array2($elementName)} {
return 0
}
}
array donesearch sourceArray $searchId
return 1
array_to_keyed_list
array_to_keyed_list arrayName
#
# Convert an array to a keyed list. Only handles "flat" keyed lists.
#
upvar $arrayName array
set list ""
foreach key [array names array] {
keylset list $key $array($key)
}
return $list
calculate_ratio_of_month_left
calculate_ratio_of_month_left month day year
#
# What is the floating point ratio of days left from the specified
# day, in the specified month, of the specified year?
#
set daysInThisMonth [days_in_month $month $year]
set daysLeftInThisMonth [expr $daysInThisMonth - $day + 1]
return [expr $daysLeftInThisMonth.0/$daysInThisMonth]
copy_array
copy_array sourceArrayName destArrayName
#@package: array_utilities copy_array array_to_keyed_list keyed_list_to_array are_arrays_identical
#
# Array Utility Functions
#
#
# $Id: neolib.html,v 1.1 1996/09/28 21:17:44 kunkee Exp $
#
# Copy the contents of one array into another.
#
upvar $sourceArrayName sourceArray $destArrayName destArray
set searchId [array startsearch sourceArray]
while {[array anymore sourceArray $searchId]} {
set elementName [array nextelement sourceArray $searchId]
set destArray($elementName) sourceArray($elementName)
}
array donesearch sourceArray $searchId
day_month_calculations
day_month_calculations clock thisMonthVar thisYearVar daysInThisMonthVar daysLeftInThisMonthVar ratioLeftVar nextMonthMonthVar nextMonthYearVar
#
# Given a integer-seconds-since-1970 and the names of some variables,
# return in those variables the month number (1-12), the year number,
# the days in the current month (28-31), the days left in this month,
# the ratio of days left in the month, the month number (1-12) of
# the month following this date's month, and the year number of the month
# following this date's month.
#
upvar $thisMonthVar thismonth
upvar $thisYearVar thisyear
upvar $daysInThisMonthVar daysInThisMonth
upvar $daysLeftInThisMonthVar daysLeftInThisMonth
upvar $ratioLeftVar ratioLeft
upvar $nextMonthMonthVar nextmonth
upvar $nextMonthYearVar nextyear
lassign [fmtclock $clock "%m %d %Y"] thismonth thisday thisyear
scan $thismonth %d thismonth
scan $thisday %d thisday
next_month_year $thismonth $thisyear nextmonth nextyear
set monthStartSeconds [convertclock $nextmonth/1/$nextyear]
set daysInThisMonth [days_in_month $thismonth $thisyear]
set daysLeftInThisMonth [expr $daysInThisMonth - $thisday + 1]
set ratioLeft [expr $daysLeftInThisMonth.0/$daysInThisMonth]
days_in_month
days_in_month month year
#
# How many days are in the specified month, in the specified year?
#
switch $month {
1 {return 31}
2 {
if {$year % 4 == 0} {
return 29
} else {
return 28
}
}
3 {return 31}
4 {return 30}
5 {return 31}
6 {return 30}
7 {return 31}
8 {return 31}
9 {return 30}
10 {return 31}
11 {return 30}
12 {return 31}
}
error "month out of range ($month)"
die
die message {exitStatus 1}
puts stderr $message
exit $exitStatus
dollar_format
dollar_format number
#
# format a number and return it as a dollar field (two digits precision
# to the right of the decimal place.)
#
return [format "%.2f" $number]
fail_exit
fail_exit command {exitStatus 1}
#@package: catchers fail_exit die
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
# $Id: neolib.html,v 1.1 1996/09/28 21:17:44 kunkee Exp $
#
# fail_exit command [exitStatus]
# execute command and, if it gets a tcl error, write the program
# name and error message to stderr and exit the program.
# If exit is taken, exit status is 1 unless specified.
#
if {[catch {uplevel $command} result] == 1} {
global argv0
puts stderr "$argv0: $result"
exit $exitStatus
}
force_width
force_width string width
#@package: neo_misc_procs force_width dollar_format
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# return a string forceed to a specified width either by padding, if it
# is too short, or by truncation, if it is too long.
#
return [crange [format "%-${width}s" $string] 0 $width-1]
getargs
getargs arrayName argList
#@package: getargs getargs
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
# $Id: neolib.html,v 1.1 1996/09/28 21:17:44 kunkee Exp $
#
# parses an arglist of key-value pairs where the key starts with a
# dash and the value must always be present.
#
# we want to use it in this manner
#
# dialog_box -bitmap @/bitmap -text "hi there" -suppress 1
#
# in dialog_box,
#
# proc dialog_box {blah blah blah args} {}
comment {# getargs $args parms}
comment {# }
#
# and have the parms array set as follows:
#
# bitmap=@/bitmap
# text="hi there"
# suppress="1"
#
#
upvar $arrayName array
set length [llength $argList]
if {$length % 2 != 0} {
error "list of key-value pairs is missing a value"
}
for {set i 0} {$i < $length} {incr i 2} {
set key [lindex $argList $i]
if {[cindex $key 0] != "-"} {
error "key '$key' of key-value pairs doesn't start with '-'"
}
set array([crange $key 1 end]) [lindex $argList [expr $i + 1]]
}
keyed_list_to_array
keyed_list_to_array list arrayName
#
# Convert a keyed list to an array. Only handles "flat" keyed lists.
#
upvar $arrayName array
foreach key [keylkeys list] {
set array($key) [keylget list $key]
}
load_stanza_file
load_stanza_file fileName arrayVarName
#
# load_stanza_file and save_stanza_file work differently from the
# above. these guys read the stanza bodies into keyed lists indexed
# by the header names through an array
#
#
#
# load_stanza_file
#
# load in a stanza file where the stanza headers becomne array names
# and the bodies become keyed lists
#
# slight optimization hack was to append up the list instead of
# keylsetting it, don't know if that really helped or not
#
upvar $arrayVarName stanzaArray
set fp [open $fileName]
while 1 {
if {[read_stanza_header $fp section] == 0} {
close $fp
return
}
set keyedList ""
while {[gets $fp line] >= 0} {
if ![parse_stanza_line $line key value] break
lappend keyedList "$key $value"
}
set stanzaArray($section) $keyedList
}
next_month_year
next_month_year currentMonth currentYear nextMonthVar nextMonthYearVar
#@package: timedate-utility next_month_year days_in_month calculate_ratio_of_month_left day_month_calculations
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# Time/Date utility functions
#
# $Id: neolib.html,v 1.1 1996/09/28 21:17:44 kunkee Exp $
#
#
#
# given the current month and year and the names of two variables,
# put in the first the numeric month following this one and in the
# second, the year of that month.
#
upvar $nextMonthVar nextMonth
upvar $nextMonthYearVar nextMonthYear
set nextMonthYear $currentYear
set nextMonth $currentMonth
if {$nextMonth < 12} {
incr nextMonth
} else {
set nextMonth 1
incr nextMonthYear
}
parse_rfc822_line
parse_rfc822_line line keyVar valueVar
#@package: rfc822 parse_rfc822_line read_rfc822_group read_rfc822 write_rfc822_group write_rfc822 parse_rfc822_mail_address
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# we really need to rewrite this in C and be truly RFC-822 compliant,
# it's a pig.
#
# RFC noncompliance issues: Line order isn't maintained, multiple
# lines with the same key aren't supported.
# There may be stuff in there about quoting, too.
#
#
# parse_rfc822_line
#
# Given a line of RFC822 header text and the names of two variables,
# parse the key into one and the value into the other.
#
# Warning, can't do multiple line messages unless line argument contains
# all necessary lines.
#
#
upvar $keyVar key
upvar $valueVar value
set key ""
set colon [string first ":" $line]
if {$colon < 2} {
return 0
}
set key [string trim [string range $line 0 [expr $colon-1]]]
set value [string trim [string range $line [expr $colon+1] end]]
return 1
parse_rfc822_mail_address
parse_rfc822_mail_address line emailAddressVar fullNameVar
#
# parse_rfc822_mail_address
#
# take the body of an address line and convert it into a name and address
#
upvar $emailAddressVar emailAddress
upvar $fullNameVar fullName
# in the form "Ellyn Jones <ellyn@NeoSoft.com>"?
if {[regexp {(.*) <(.*)>} $line dummy fullName emailAddress]} {
set emailAddress [string tolower $emailAddress]
return
}
# in the form "ellyn@NeoSoft.com (Ellyn Jones)"?
if {[regexp {(.*) \((.*)\)} $line dummy emailAddress fullName]} {
set emailAddress [string tolower $emailAddress]
return
}
# hmm, take whatever's there as the reply address
set emailAddress [string tolower $line]
set fullName $emailAddress
parse_stanza_line
parse_stanza_line line keyVarName dataVarName
# parse_stanza_line
#
# given a line and the names of key and value variables, put
# the key and value in variables and return 1, else 0 or error
#
upvar $keyVarName key
upvar $dataVarName value
if {[string trim $line] == ""} {return 0}
if {[cindex $line 0] == "\["} {
error "called parse_stanza_line with a header line '$line'"
}
set separator [string first "=" $line]
if {$separator < 2} {
error "malformed stanza line '$line'"
}
set key [string trim [string range $line 0 [expr $separator-1]]]
set value [string trim [string range $line [expr $separator+1] end]]
return 1
prompt
prompt promptText varName {default ""}
#@package: prompts prompt prompt_yn prompt_choices
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# prompt - given some prompt text, the name of a variable, and a possible
# default value, emit the text, read a line into the named variable and,
# if an empty string is entered, use the default instead, and set the
# result into the named variable.
#
upvar $varName line
set line ""
if {$default == ""} {
puts stdout "$promptText: " nonewline
} else {
puts stdout "$promptText \[$default\]: " nonewline
}
if {[gets stdin line] < 0} return
if {$line == ""} {
set line $default
}
prompt_choices
prompt_choices promptText choiceList {default ""}
#
# prompt_choices - emit some prompt text and get a selection of one
# of a number of responses.
#
while 1 {
set nChoices 0
echo $promptText
foreach element $choiceList {
echo " $nChoices $element"
incr nChoices
}
prompt "Your selection?" input $default
if {([catch {set choice [lindex $choiceList $input]} result] == 1) || ($choice == "" && $default != "")} {
echo "Please enter a number between 1 and $nChoices."
continue
}
if {$choice == ""} {return $default}
return $choice
}
prompt_yn
prompt_yn promptText {default ""}
#
# prompt_yn - emit some prompt text and get a yes or no response,
# returning 1 for yes and 0 for no.
#
while 1 {
if {$default == ""} {
puts stdout "$promptText (y/n): " nonewline
} else {
puts stdout "$promptText (y/n) \[$default\]: " nonewline
}
if {[gets stdin line] < 0} return
if {$line == ""} {set line $default}
set char [string tolower [cindex $line 0]]
if {$char == "n"} {return 0}
if {$char == "y"} {return 1}
echo "Please answer y)es or n)o"
}
read_rfc822
read_rfc822 fileName arrayVarName
#
# read_rfc822
#
# load in a file containing one rfc822 group
#
upvar $arrayVarName rfcArray
set fp [open $fileName]
read_rfc822_group $fp rfcArray
close $fp
read_rfc822_group
read_rfc822_group fp arrayVarName
#
# read_rfc822_group
#
# given a filehandle and an array name, read the file, pulling key-value
# pairs and putting them into the named array, returning when an empty
# line or EOF is found
#
#
upvar $arrayVarName rfcArray
set success 0
while {[gets $fp line] >= 0} {
if {$line == ""} break
set firstchar [cindex $line 0]
if {$firstchar == " " || $firstchar == "\t"} {
if {$key != ""} {
append rfcArray($key) "\n$line"
} else {
puts stderr "rfc-822 line starts with whitespace with no prior key '$line'"
}
continue
}
set key ""
set colon [string first ":" $line]
if {$colon < 2} {
puts stderr "malformed rfc-822 line '$line'"
}
set success 1
set key [string trim [string range $line 0 [expr $colon-1]]]
set value [string trim [string range $line [expr $colon+1] end]]
set rfcArray($key) $value
}
return $success
read_stanza_body
read_stanza_body fp arrayVarName
# read_stanza_body
#
# given a filehandle and an array name, read the file, pulling key-value
# pairs and putting them into the named array, returning when an empty
# line or EOF is found
#
#
upvar $arrayVarName stanzaArray
set success 0
while {[gets $fp line] >= 0} {
if ![parse_stanza_line $line key value] break
set success 1
set stanzaArray($key) $value
}
return $success
read_stanza_file
read_stanza_file fileName arrayVarPrefix {global ""}
set upLevel "2"
if {$global != ""} {set upLevel "#0"}
set fp [open $fileName]
while 1 {
if {[read_stanza_header $fp section] == 0} {
close $fp
return
}
store_stanza_field $arrayVarPrefix$section $upLevel ID $section
while {[gets $fp line] >= 0} {
if ![parse_stanza_line $line key value] break
store_stanza_field $arrayVarPrefix$section $upLevel $key $value
}
}
read_stanza_header
read_stanza_header fp headerVarName
#@package: stanza read_stanza_header read_stanza_body read_stanza_file load_stanza_file write_stanza save_stanza_file
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
# $Id: neolib.html,v 1.1 1996/09/28 21:17:44 kunkee Exp $
#
# we really need to rewrite this in C and be truly stanza compliant,
# it's kind of a pig.
#
# stanza noncompliance issues: lots
#
# seems to work, though.
#
# read_stanza_header
#
# given a filehandle and an array name, read the file, pulling key-value
# pairs and putting them into the named array, returning when an empty
# line or EOF is found
#
#
upvar $headerVarName headerVar
if {[gets $fp line] <= 0} {return 0}
if {[string index $line 0] != "\["} {
error "malformed stanza file - no '[' in header"
}
if {[cindex $line [clength $line]-1] != "]"} {
error "malformed stanza file - no ']' in header"
}
set headerVar [crange $line 1 [clength $line]-2]
return 1
require
require commandName
#@package: libmanager require
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# This little thing will force the autoloading of the specified command,
# without actually executing it.
#
# already loaded?
if {[info commands $commandName] != ""} return
# get it
if ![auto_load $commandName] {
error "couldn't auto_load $commandName"
}
rfc931
rfc931 fp resultVar
#@package: rfc931 rfc931
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# Perform an rfc931 authentication request on the socket bound to the
# specified filehandle. Returns username and hostname if found,
# username and ip if no hostname is found, or an empty string if
# the remote site isn't running an rfc931 authentication server.
#
# $Id: neolib.html,v 1.1 1996/09/28 21:17:44 kunkee Exp $
#
upvar $resultVar result
lassign [fstat $fp localhost] localAddr localPort
lassign [fstat $fp remotehost] remoteAddr remotePort
if {[catch {lassign [server_open -myip $localAddr $remoteAddr ident] readIdent writeIdent} result] == 1} {
global errorCode errorInfo
if {[lindex $errorCode 1] == "ECONNREFUSED"} {return 0}
error $result $errorInfo $errorCode
}
set remoteName [server_info address_name $remoteAddr]
puts $writeIdent "$remotePort,$localPort\r"
close $writeIdent
if {[gets $readIdent authLine] < 0} {
close $readIdent
set result "read failed"
return 0
}
set result $authLine
if {[scan $authLine {%u , %u : USERID :%*[^:]:%s} remote local user] != 3} {
close $readIdent
return 0
}
if {$remote != $remotePort || $local != $localPort} {
close $readIdent
set result "ports didn't match"
return 0
}
if {[cindex $user end] == "\r"} {
set user [crange $user 0 end-1]
}
set result $user@$remoteName
close $readIdent
return 1
save_stanza_file
save_stanza_file fileName arrayVarPrefix {global ""}
#
# save_stanza_file
#
# save a stanza file where the stanza headers come from an array's keys
# and the bodies are from keyed lists indexed by the keys
#
set upVar "1"
if {$global != ""} {set upVar "#0"}
set varPrefixLength [string length $arrayVarPrefix]
set fp [open $fileName w]
foreach arrayVarName [uplevel $upVar "info vars $arrayVarPrefix*"] {
upvar $upVar $arrayVarName stanzaArray
set setName [string range $arrayVarName $varPrefixLength end]
puts $fp "\[$setName\]"
foreach key [array names stanzaArray] {
if {[cindex $key 0] != "_"} {
puts $fp "$key=$stanzaArray($key)"
}
}
puts $fp ""
}
close $fp
spawn_child
spawn_child command stdinPipeVarName stdoutPipeVarName stderrPipeVarName
#@package: spawn_child spawn_child
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# spawn_child - fork a tcl subprocess, redirecting standard input,
# output and error to pipes.
#
# Three variable names are specified.
# Within those variables spawn_child writes the filehandles of pipes that
# correspond to standard input, standard output and standard error of
# the subprocess.
#
upvar $stdinPipeVarName stdinPipe $stdoutPipeVarName stdoutPipe $stderrPipeVarName stderrPipe
pipe childStdinPipe stdinPipe
pipe stdoutPipe childStdoutPipe
pipe stderrPipe childStderrPipe
if {[set childPid [fork]] == 0} {
dup $childStdinPipe stdin
close $childStdinPipe
dup $childStdoutPipe stdout
close $childStdoutPipe
dup $childStderrPipe stderr
close $childStderrPipe
eval "execl $command"
}
return $childPid
store_stanza_field
store_stanza_field varName upLevel key value
upvar $upLevel $varName myArray
set myArray($key) $value
write_rfc822
write_rfc822 fileName arrayVarName
#
# write_rfc822
#
# write out a file containing one rfc822 group
#
upvar $arrayVarName rfcArray
set fp [open $fileName w]
write_rfc822_group $fp rfcArray
close $fp
write_rfc822_group
write_rfc822_group fp arrayVarName
#
# write_rfc822_group
#
# given a filehandle and an array name, write the file, pulling key-value
# pairs from the named array, returning when finished.
#
#
upvar $arrayVarName rfcArray
foreach name [array names rfcArray] {
set data [split $rfcArray($name) "\n"]
puts $fp "$name: [lindex $data 0]"
foreach additionalLine [lrange $data 1 end] {
puts $fp "\t$additionalLine"
}
}
puts $fp ""
write_stanza
write_stanza fp headerName arrayVarName
#
# write_stanza
#
# given a filehandle, an array name containing stanza elements
# and a stanza header name, write it out
#
#
upvar $arrayVarName stanzaArray
puts $fp "\[$headerName\]"
foreach name [array names stanzaArray] {
puts $fp "$name=$rfcArray($name)"
}
puts $fp ""
xkeylget
xkeylget keylistName args
#
#
# Copyright (C) 1992-1996 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. NeoSoft makes no
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# $Id: neolib.html,v 1.1 1996/09/28 21:17:44 kunkee Exp $
#
#@package: xkeylget xkeylget
upvar $keylistName keylist
if {[llength $args] % 2 != 0} {error "odd number of key-varname pairs"}
while {$args != ""} {
set elementName [lindex $args 0]
set varName [lindex $args 1]
set args [lrange $args 2 end]
keylget keylist $elementName value
uplevel set $varName [list $value]
}