pkg://jultaf-0.0.4-1.src.rpm:132918/jultaf-0.0.4.tar.gz
info downloads
jultaf-0.0.4/ 40755 764 144 0 6573436405 11410 5 ustar racke users jultaf-0.0.4/apps/ 40755 764 144 0 6573436402 12350 5 ustar racke users jultaf-0.0.4/apps/Makefile.in 100644 764 144 12134 6556242132 14527 0 ustar racke users #
# Makefile for `apps' subdirectory of the `Jultaf' package
# Copyright (C) 1997 Stefan Hornburg
# This file 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, or (at your option) any
# later version.
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
# =======================
# Where To Install Things
# =======================
# The default location for installation. Everything is placed in
# subdirectories of this directory. The default values for many of
# the variables below are expressed in terms of this one, so you may
# not need to change them. This defaults to /usr/local.
prefix = @prefix@
# Like `prefix', but used for architecture-specific files.
exec_prefix = @exec_prefix@
# Where to install binaries that people will want to run directly.
bindir = @bindir@
# ======================
# Where to Lookup Things
# ======================
# This is set by the configure script's `--srcdir' option.
srcdir = @srcdir@
top_srcdir = @top_srcdir@
# Where to find master Makefile
buildroot = @buildroot@
# Tell make where to find source files; this is needed for the makefiles.
VPATH= @srcdir@
# Location of `Jumble Library of Tcl and Friends'
datadir = @datadir@
mydatadir = ${datadir}/$(PKGSPEC)
# ================
# Utility Programs
# ================
# --------------------------------------------------------------------
# Commands for actual installation, for executables and nonexecutables
# --------------------------------------------------------------------
INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
# ===========
# Interpreter
# ===========
TCLSH = @TCLSH@
# *******************************************************
# Nothing to configure left now (at least for sane minds)
# *******************************************************
VERSION = @PKG_VERSION@
PKGSPEC = @PKG_SPEC@
DISTTCLNAME = ${PKGSPEC}${VERSION}
# =======
# Targets
# =======
# --------------------------------------
# Default target: compile entire program
# --------------------------------------
all: bin
# ---------------
# Generic targets
# ---------------
.PHONY: install uninstall mkinstalldirs
install: install-bin
uninstall: uninstall-bin
mkinstalldirs: md-bin
# --------------
# Jultaf scripts
# --------------
.PHONY: bin clean-bin install-bin uninstall-bin md-bin
SCRIPTS = jufprof jufdist
bin: $(SCRIPTS)
clean-bin:
-rm $(SCRIPTS)
install-bin: md-bin
@echo "Installing Jultaf scripts in $(bindir)"
@for file in $(SCRIPTS); \
do \
echo "Installing $$file"; \
$(INSTALL_PROGRAM) $$file $(bindir); \
done
uninstall-bin:
-(cd $(bindir); rm $(SCRIPTS))
md-bin:
${top_srcdir}/mkinstalldirs ${bindir}
# --------------
# Implicit rules
# --------------
%: %.tcl
sed -e 's%@''TCLSH@%${TCLSH}%'\
-e 's%@''jultafdir@%$(mydatadir)%' $< > $@
# ===========================
# Cleaning up and miscellanea
# ===========================
.PHONY: mostlyclean clean distclean maintainer-clean
# ---------------------------------------------------------------------
# Delete all files from the current directory that are normally created
# by building the program. Don't delete the files that record the
# configuration. Also preserve files that could be made by building,
# but normally aren't because the distribution comes with them.
# ---------------------------------------------------------------------
clean mostlyclean: clean-bin
# ---------------------------------------------------------------------
# Delete all files from the current directory that are created by
# configuring or building the program. If you have unpacked the source
# and built the program without creating any other files, `make
# distclean' should leave only the files that were in the distribution.
# ---------------------------------------------------------------------
distclean: clean
rm -f config.status config.cache config.log stamp-h
rm -f Makefile
# ----------------------------------------------------------------------
# Delete everything from the current directory that can be reconstructed
# with this Makefile. This typically includes everything deleted by
# distclean, plus more: C source files produced by Bison, tags tables,
# info files, and so on.
# ----------------------------------------------------------------------
maintainer-clean: distclean
# magic to update Makefile from Makefile.in etc.
Makefile: ${srcdir}/Makefile.in ${buildroot}/config.status
cd ${buildroot} && ./config.status
$(buildroot)/config.status: $(buildroot)/configure
cd $(buildroot) && ./config.status --recheck
${buildroot}/configure: ${top_srcdir}/configure.in ${top_srcdir}/aclocal.m4
cd ${buildroot} && autoconf
jultaf-0.0.4/apps/jufdist.tcl 100644 764 144 22720 6573434541 14646 0 ustar racke users #! @TCLSH@
#
# jufdist.tcl -- script for distribution preparations
#
# Copyright (C) 1998 Stefan Hornburg
#
# Author: Stefan Hornburg <racke@gundel.han.de>
# Maintainer: Stefan Hornburg <racke@gundel.han.de>
# Version: 0.0.4
#
# This file 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, or (at your option) any
# later version.
#
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
set jufdist_version 0.0.4
set auto_path [concat @jultafdir@ $auto_path]
package require Code
package require Error
package require juf::getopts
package require Sequence
package require Libtool
# Option specifications
set optspecs {
{"dir|d=s" "Add directory to package search path."}
{"help|h" "Print this message and exit."}
{"libdir=s" "Set shared library installation directory to DIR" "DIR"}
{"libraries|l=s" "Examine Tcl shared libraries LIBS." "LIBS"}
{"output-file|o=s" "Use FILE as output file instead of pkgIndex.tcl" "FILE"}
{"strip-directories|p" "Strip directories from file names."}
{"subdirectory|s=s" "Add DIR to library script location." DIR}
}
# Errors
set errcount 0
# Array with interpreter aliases
array set als {
package package_filter proc proc_filter
class class_filter body nop configbody nop
}
array set renames {
package package_interned proc proc_interned
}
# Array with variables
array set vars [list auto_path $auto_path]
# Dummy function
proc nop {args} {}
# -------------------------
# PROC: usage
#
# Prints usage information.
# -------------------------
proc usage {} {
global optspecs
juf_getopts_listspecs $optspecs
}
# -----------------------------------------------------------------
# PROC: main
#
# Main program.
#
# Global variables:
# The elements in `commands are the classes defined by the current
# library file. Classes supplied by packages are stored in the
# array `pkgcmds.
# -----------------------------------------------------------------
proc main {args} {
global als vars errcount jufdist_version libfile packages optspecs
global interp renames auto_path
global commands pkgcmds autocmds
juf_getopts $optspecs optarr args $args
if [info exists optarr(help)] {
usage
exit 0
}
if [info exists optarr(dir)] {
set vars(auto_path) [concat $optarr(dir) $auto_path]
}
if ![info exists optarr(output_file)] {
set optarr(output_file) pkgIndex.tcl
}
#
# initialize package array with predefined and applicable packages
#
foreach package [list Tcl Itcl] {
if ![catch [list package require $package] excinfo] {
set packages($package) [package require $package]
}
}
foreach libfile $args {
set commands ""
if [catch [list juf_safe_source -exit finish_script -interp interp -renames renames\
-nosafe -aliases als -variables vars $libfile] excinfo] {
Juf::Error::error $libfile $excinfo
global errorInfo
puts $errorInfo
incr errcount
}
# determine packages provided by this library file
if [llength $commands] {
foreach package [array names packages] {
if {[llength $packages($package)] >= 2} {
if ![string compare [lindex $packages($package) 0] \
$libfile] {
set pkgcmds($package) $commands
set autoentries($package) [array get autocmds]
}
}
}
}
if [info exists autocmds] {
unset autocmds
}
}
if $errcount {exit 1}
#
# check for unresolved packages
#
foreach package [array names packages] {
if {[llength $packages($package)] < 2} {
unset packages($package)
}
}
if [info exists packages(Itcl)] {
unset packages(Itcl)
}
if $errcount {exit 1}
#
# handle shared libraries
#
if [info exists optarr(libraries)] {
foreach shlib $optarr(libraries) {
set shlibarr($shlib) [Juf::Libtool::packagelist $shlib]
}
}
#
# create pkgIndex.tcl file
#
lappend index {# Tcl package index file, version 1.0}
lappend index {#}
lappend index "# Automatically generated with jufdist v$jufdist_version"
lappend index "# [clock format [clock seconds]]"
lappend index {#}
#
# packages provided by shared libraries
#
foreach shlib [array names shlibarr] {
if [info exists optarr(libdir)] {
set libloc "$optarr(libdir)/[file tail $shlib]"
} else {
set libloc $shlib
}
foreach pkginfo $shlibarr($shlib) {
lappend index "package ifneeded [lindex $pkginfo 0] [lindex $pkginfo 1] \"load $libloc\""
}
}
#
# vanilla Tcl packages
#
foreach package [array names packages] {
Juf::Sequence::assign $packages($package) libfile version
if [info exists optarr(strip_directories)] {
set libfile [file tail $libfile]
}
if [info exists optarr(subdirectory)] {
set subdir [list $optarr(subdirectory)]
} else {
set subdir ""
}
if [info exists pkgcmds($package)] {
lappend index "package ifneeded $package $version \""
while {[llength $autoentries($package)]} {
set cmd [Juf::Sequence::shift autoentries($package)]
set code [Juf::Sequence::shift autoentries($package)]
lappend index "\tset auto_index($cmd) {$code}"
}
foreach cmd $pkgcmds($package) {
lappend index "\tset auto_index([string range $cmd 2 end]) {source \[file join \$dir $subdir $libfile\]}"
}
lappend index "\tpackage provide $package $version\""
} else {
lappend index "package ifneeded $package $version \\"
lappend index "\t\[list source \[file join \$dir $subdir $libfile\]\]"
}
}
set fd [open $optarr(output_file) w]
puts $fd [join $index "\n"]
close $fd
}
# -------------------------------------------------------------------
# PROC: package_filter ARGS
#
# Filter for calls to Tcl `package' command. Stores information about
# any call with the subcommand `provide'.
# -------------------------------------------------------------------
proc package_filter {args} {
global packages libfile errcount unresolved
global interp pkgcmds procs
set argsbuf $args
lappend argsbuf ""
Juf::Sequence::assign $argsbuf op package version
juf_branch $op provide {
if [string length $version] {
# indicate that package is loaded
if [info exists packages($package)] {
if {[llength $packages($package)] > 1} {
if {[string compare $version [lindex $packages($package) 1]] != 0} {
Juf::Error::error "conflicting versions provided for package \"$package\": [lindex $packages($package) 1], then $version"
incr errcount
} else {
return $version
}
} else {
return $version
}
} else {
set packages($package) [list $libfile $version]
return $version
}
} elseif [info exists packages($package)] {
return [lindex $packages($package) end]
}
} require {
if ![info exists packages($package)] {
if [info exists version] {
#
# store required version
#
set packages($package) [list $version]
} else {
set packages($package) ""
set version ""
}
if [catch [list $interp eval [package unknown] $package [list \
$version]] excinfo] {
Juf::Error::error $libfile $excinfo
incr errcount
} else {
#
# check for success
#
if ![string length [$interp eval package versions $package]] {
error "can't find package \"$package\""
}
}
} else {
# install commands provided by package
if [info exists pkgcmds($package)] {
foreach provcmd $pkgcmds($package) {
if [info exists procs($provcmd)] {
proc_install $interp $provcmd
}
}
}
return [lindex $packages($package) end]
}
} default {
$interp eval package_interned $args
}
}
# -----------------------------------------------
# PROC: proc_filter NAME DEF
#
# Filter for calls to [incr Tcl] `proc' command.
# -----------------------------------------------
proc proc_filter {name args} {
global interp commands procs
if {[string first :: $name] != 0} {
if [string length [$interp eval namespace parent]] {
set name [$interp eval namespace current]::$name
} else {
set name ::$name
}
}
lappend commands $name
# store proc
set procs($name) $args
# define proc
proc_install $interp $name
}
# -------------------------------------------------
# PROC: proc_install INTERP NAME
#
# Defines procedure NAME within interpreter INTERP.
# -------------------------------------------------
proc proc_install {interp name} {
global procs
# Analyse namespace and create missing ones
$interp eval namespace eval [list [namespace qualifiers $name]] [list ""]
$interp eval proc_interned $name [list [lindex $procs($name) 0]] \
[lrange $procs($name) 1 end]
}
# -----------------------------------------------
# PROC: class_filter NAME DEF
#
# Filter for calls to [incr Tcl] `class' command.
# -----------------------------------------------
proc class_filter {name def} {
global interp commands
lappend commands ::$name
$interp alias $name nop
}
# ------------------------------------------------
# PROC: finish_script INTERP
#
# Detects manually inserted entries of auto_index.
# ------------------------------------------------
proc finish_script {interp} {
global libfile autocmds package
foreach entry [$interp eval array names auto_index] {
set autocmds($entry) [$interp eval set auto_index($entry)]
regsub -all -- "\\\$" $autocmds($entry) "\\\$" autocmds($entry)
}
}
eval main $argv
jultaf-0.0.4/apps/jufprof.tcl 100644 764 144 2432 6433664071 14625 0 ustar racke users #! @TCLSH@
#
# jufprof.tcl -- profiles Tcl/[incr Tcl] script
#
# Copyright (C) 1997 Stefan Hornburg
#
# Author: Stefan Hornburg <racke@gundel.han.de>
# Maintainer: Stefan Hornburg <racke@gundel.han.de>
#
# This file 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, or (at your option) any
# later version.
#
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
set auto_path [concat @jultafdir@ $auto_path]
#
# drop-in replacement for builtin exit
#
proc juf_proc_exit {{state 0}} {
juf_prof off report
juf_prof_report report
juf_proc_old_exit $state
}
rename exit juf_proc_old_exit
rename juf_proc_exit exit
juf_prof on
if [llength $argv] {
set script [lindex $argv 0]
set argv [lrange $argv 1 end ]
if [catch "eval source $script" result] {
puts stderr $result
}
}
exit 0
jultaf-0.0.4/html/ 40755 764 144 0 6573436376 12363 5 ustar racke users jultaf-0.0.4/html/exp.gif 100644 764 144 223 6426144261 13702 0 ustar racke users GIF89a ! , d17`*)My htm(J >.k( S-hps&Gd2Y4}s.#64xٝp\ _uExizFhP ; jultaf-0.0.4/html/index.html 100644 764 144 2366 6573431447 14456 0 ustar racke users <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
<HTML>
<HEAD>
<TITLE>Jultaf</TITLE>
<META NAME="Keywords" CONTENT="Tcl, GDBM, Postgres, RPM">
</HEAD>
<BODY>
<H1>Jultaf</H1>
Jultaf is a collection of Tcl and [incr Tcl] scripts and provides procedures
resp. classes with various purposes. Additionally shared libraries for
accessing GDBM and <A HREF="http://www.postgresql.org">Postgres</A>
databases from Tcl can be build with this package.
<H2>License</H2>
Jultaf is distributed under the terms of the <A HREF="http://www.gnu.org/copyleft/gpl.html">GPL</A>
. Please contact me if this keeps you from using Jultaf.
<H2>System Requirements</H2>
<UL>
<LI>At least Tcl 8.0 or above. [incr Tcl] 3.0a1 or above if you want to use
the class library.
</UL>
<H2>Distribution</H2>
<UL>
<LI><A HREF="jultaf-0.0.4.tar.gz">Latest release (0.0.4)</A>
</UL>
<H2>Documentation</H2>
<UL>
<LI><A HREF="jultaf.html">User Manual</A><LI><A HREF="news.html">News</A>
</UL>
<HR><ADDRESS>
Written by Stefan Hornburg <A HREF="mailto:racke@gundel.han.de"><racke@gundel.han.de></A> (Last modified 03 September 1998)<BR>Translated from <A href="index.tcl">index.tcl</A> by <A HREF="http://www.han.de/~racke/InfoPrism/">Info Prism's sgml2html</A> v0.0.2</ADDRESS><HR>
</BODY>
</HTML> jultaf-0.0.4/html/jultaf.html 100644 764 144 73256 6573403073 14654 0 ustar racke users <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
<HTML>
<HEAD>
<TITLE>Jumble Library for Tcl and Friends</TITLE>
</HEAD>
<BODY>
<H1><A NAME="1">Jumble Library for Tcl and Friends</A></H1>
The <EM>Jumble Library for Tcl and Friends</EM> is a collection of Tcl and
[incr Tcl] scripts and provides procedures resp. classes with various
purposes. Additionally a shared library for accessing GDBM databases from
Tcl can be build with this package.
<P>
This document corresponds to version 0.0.4 of the library. Up-to-date
information about Jultaf can be found via <A HREF="http://www.han.de/~racke/jultaf/">http://www.han.de/~racke/jultaf/</A>
.
<P>
<UL>
<LI><A HREF="#33">Important information about this package</A>
<UL>
<LI><A HREF="#54">How to Read This Manual</A>
<LI><A HREF="#92">Build Configuration</A>
</UL>
<LI><A HREF="#255">Error</A>
<LI><A HREF="#373">Command Line Processing</A>
<UL>
<LI><A HREF="#378">Option Specifications</A>
<LI><A HREF="#419">Option Listing</A>
<LI><A HREF="#461">Option Processing</A>
<LI><A HREF="#501">Examples</A>
</UL>
<LI><A HREF="#515">New Control Structures</A>
<LI><A HREF="#569">String</A>
<LI><A HREF="#736">Lists</A>
<UL>
<LI><A HREF="#751">Sequence</A>
<LI><A HREF="#911">LOLList of Lists</A>
</UL>
<LI><A HREF="#955">Array</A>
<LI><A HREF="#1031">Files</A>
<UL>
<LI><A HREF="#1097">File Name Manipulation</A>
<LI><A HREF="#1161">Finding Files</A>
</UL>
<LI><A HREF="#1286">Code Processing</A>
<LI><A HREF="#1491">Invoking subprocesses</A>
<LI><A HREF="#1529">Accessing GDBM Databases</A>
<LI><A HREF="#1766">RPM Interface</A>
<LI><A HREF="#1815">Miscellaneous Functions</A>
<LI><A HREF="#1890">Package Index</A>
<LI><A HREF="#1901">Variable Index</A>
<LI><A HREF="#1906">Function Index</A>
<LI><A HREF="#1911">Concept Index</A>
</UL>
<H2><A NAME="33">Important information about this package</A></H2>
Jultaf is <EM>alpha</EM> software. It is not tested by anyone but me and
documentation is not as good as required for a decent package. However, it
works for me.
<P>
Jultaf is <EM>free</EM> software. This means that everyone may use it,
redistribute it and/or modify it under the terms of the GNU General Public
License, as published by the Free Software Foundation.
<H3><A NAME="54">How to Read This Manual</A></H3>
Items introduced in one of the last revisions are marked as new in this
manual as shown in the example below:
<DL>
<DT><CODE>fresh</CODE> <A NAME="NEW"><IMG ALT="*NEW*" SRC="new.gif"></A><DD>Returns a list
with new functions in this release.
</DL>
<A NAME="72"> Jultaf is a work in progress and several items will be a moving target. Their syntax may change in a not backward compatible way and are marked as </A> <DFN>unstable</DFN>:
<DL>
<DT><CODE>hacks</CODE> <A NAME="EXP"><IMG ALT="*EXPERIMENTAL*" SRC="exp.gif"></A><DD>Returns a
list with bug-prone functions in this release.
</DL>
<H3><A NAME="92">Build Configuration</A></H3>
<P>
<H4><A NAME="108">Optional Features</A></H4>
<DL>
<DT><CODE><A NAME="ENABLE-ITCL">--enable-itcl</A></CODE>= <CODE>yes</CODE>|<CODE>no</CODE>|<VAR>PATH
</VAR><DD>Indicates if the [incr Tcl] library files should be installed as
well as the vanilla Tcl library files. If set to <CODE>yes</CODE> or the
<VAR>PATH</VAR> to the [incr Tcl] interpreter, this files will be installed.
The default value depends on the fact if <CODE>configure</CODE> detects
<CODE>itclsh</CODE> in the path.<DT><CODE><A NAME="WITHGDBM">--with-gdbm</A></CODE><DD>Enables
compiling and installing of the Jufgdbm library.<DT><CODE><A NAME="WITHPROF">--with-prof</A>
</CODE><DD>Enables compiling and installing of the Jufprof library.<DT>
<CODE><A NAME="WITHPQ">--with-pq</A></CODE><DD>Enables compiling and installing of the Jufpq
library.<DT><CODE><A NAME="WITHRPM">--with-rpm</A></CODE><DD>Enables compiling and installing of
the Jufrpm library.
</DL>
<H4><A NAME="165">Installation Directories</A></H4>
This section describes where the various files of the Jultaf distribution
get installed by <CODE>make install</CODE>.
<TABLE>
<TR><TH>Symbolic Name<TH>Default value<TH><A NAME="184">Files</A>
<TR><TD><CODE>DATADIR</CODE><TD>/usr/local/share/jultaf<TD><A NAME="195">Tcl and [incr Tcl] files</A>
<TR><TD><CODE>LIBDIR</CODE><TD>/usr/local/lib<TD><A NAME="206">library files (Jufprof and Jufgdbm) </A>
<TR><TD><CODE>INFODIR</CODE><TD><A NAME="213">/usr/local/info</A><TD> documentation<A NAME="223"> (</A>GNU Info<A NAME="231"> format)</A>
<TR><TD><CODE>DOCDIR</CODE><TD><A NAME="238">/usr/local/doc/jultaf</A><TD> documentation<A NAME="248"> (</A>HTML format)
</TABLE>
<H2><A NAME="255">Error</A></H2>
The functions provided by the <CODE>Error</CODE><A NAME="271"> package can be divided into error handling functions and error evaluation functions. </A>
<P>
<DL>
<DT><CODE>fault</CODE> <VAR>TYPE</VAR> <VAR>[ARG ...]</VAR><DD><A NAME="286">Generates an Tcl error. The message is composed of an template specified by TYPE and the remaining arguments: </A>
<DL>
<DT><CODE>badoption</CODE><DD><CODE><A NAME="295">bad option "%s": must be %s</A></CODE><DT><CODE>wrongargs</CODE><DD>
<CODE>wrong # args: should be "%s"</CODE>
</DL>
</DL>
The following error handling functions concatenates the given arguments
together with the <SAMP>: </SAMP><A NAME="309"> separator string between them. The scriptname is prepended if running non-interactively. </A>
<DL>
<DT><CODE>fatal</CODE> [<VAR>ARGS</VAR>...]<DD>Prints an error message on
<CODE>stderr</CODE><A NAME="324"> and exits the current process. </A><DT><CODE>error</CODE> [<VAR>ARGS</VAR>...]<DD>Print an
error message on <CODE>stderr</CODE><A NAME="339">.</A><DT><CODE>warning</CODE> [<VAR>ARGS
</VAR>...]<DD>Print an error message on <CODE>stderr</CODE> with the text
"warning" preprended.
</DL>
<P>
<A NAME="358"> Only one error evaluation function exists by now: </A><DL>
<DT><CODE>tclmsg</CODE><DD><A NAME="365">Evaluates the Tcl variable </A><CODE>errorCode</CODE> and generates an
appropriate error message.
</DL>
This is useful for reporting errors on file operations: <PRE>package require Error
if {[catch "open [lindex $argv 0]" fileid] != 0} {
Juf::Error::fatal [lindex $argv 0] [Juf::Error::tclmsg]
}</PRE>
<H2><A NAME="373">Command Line Processing</A></H2>
<P>
<H3><A NAME="378">Option Specifications</A></H3>
The <A HREF="#GETOPTS"><CODE>juf_getopts</CODE></A> function and the <A HREF="#LISTOPTS"><CODE>juf_getopts_listspecs</CODE></A> function expect a list of <DFN><A NAME="OPTSPECS">option specifications</A>
</DFN> as one of their arguments.
<P>
Each option specification consists of an option processing description, an
option description and an argument description. Only the processing
description is mandatory. The other two elements of a option specification
are optional and evaluated only by the <CODE>juf_getopts_listspecs</CODE>
function.
<H4><A NAME="402">Option Processing Description</A></H4>
Each option can be specified through usage of different names, e.g. <CODE>
-h</CODE> and <CODE>--help</CODE><A NAME="414">. The processing description starts with these names, concatenated by the </A><CODE>|</CODE>-sign.
<H3><A NAME="419">Option Listing</A></H3>
An option listing can be produced with the <CODE>juf_getopts_listspecs
</CODE><A NAME="431"> function: </A>
<DL>
<DT><CODE><A NAME="LISTOPTS">juf_getopts_listspecs</A></CODE> <VAR>OPTSPECS</VAR> <VAR>OUTID</VAR>
<DD>Writes a option listing to the file bound to the file identifier <VAR>
OUTID</VAR>. Expects as <VAR>OPTSPECS</VAR> a list of <A HREF="#OPTSPECS">option specifications</A>.
</DL>
<H3><A NAME="461">Option Processing</A></H3>
<DL>
<DT><CODE><A NAME="GETOPTS">juf_getopts</A></CODE> <VAR>OPTSPECS</VAR> <VAR>OPTARR</VAR> <VAR>
NEWARGV</VAR> <VAR>OLDARGV</VAR><DD>Processes the command line arguments in
<VAR>OLDARGV</VAR>. Any options (preceded with <SAMP>-</SAMP> or <SAMP>--
</SAMP>) are evaluated according to the <A HREF="#OPTSPECS">option specifications</A> <VAR>OPTSPECS</VAR>. This function
stores the remaining arguments in the array <VAR>OPTARR</VAR>.
</DL>
<H3><A NAME="501">Examples</A></H3>
I recommend the following set of option specifications as base set (make
sure to replace <CODE>make</CODE> with the actual script name): <PRE>{{help|h {Print this message and exit.}}
{version|v {Print the version number of make and exit}}}</PRE>
<H2><A NAME="515">New Control Structures</A></H2>
<DFN>Control structures</DFN> are commands that direct the flow of control
like the Tcl builtins <CODE>if</CODE>, <CODE>while</CODE> and <CODE>switch
</CODE><A NAME="533">. </A>
<DL>
<DT><CODE>juf_branch</CODE> <VAR>VALUE</VAR> [<VAR>PATTERN</VAR> <VAR>
SCRIPT</VAR>] ... 2<DD><A NAME="550">Creates and evaluates </A><CODE>switch</CODE> statement. Causes error if <VAR>
VALUE</VAR> matches with none of the <VAR>PATTERN</VAR> arguments. To
override this behaviour you may add <CODE>default {}</CODE> to the
arguments.
</DL>
Example for this command: <PRE>% proc version {subcmd number} {
set parts [split $number .]
juf_branch $subcmd major {lindex $parts 0} minor {lindex $parts 1} \
minuscule {lindex $parts 2}
}
% version minor 1.2.3
2
% version patch 1.2.3
bad option "patch": must be major, minor, or minuscule</PRE>
<H2><A NAME="569">String</A></H2>
The functions provided by the <CODE>String</CODE><A NAME="583"> package perform several operations on array variables: </A>
<DL>
<DT><CODE>juf_split</CODE> [<VAR>OPTIONS</VAR>] <VAR>STRING</VAR> [<VAR>EXP
</VAR> <VAR>LIMIT</VAR>]<DD>Returns a list created by splitting <VAR>STRING
</VAR> at each match of the regular expression <VAR>EXP</VAR>. If <VAR>EXP
</VAR> is omitted or an empty string is given, it defaults to whitespace. If
<VAR>LIMIT</VAR> is given, it stops the matching process, so that the size
of the resulting list is equal or lesser than <VAR>LIMIT</VAR>.
<P>
<A NAME="619"> A regular expression matching the </A>null string will split <VAR>STRING</VAR> into separate characters at each
point it matches that way: <PRE>% juf_split "hello world" " *"
h e l l o w o r l d</PRE> If the initial arguments to <CODE>
juf_split</CODE> start with <SAMP>-</SAMP><A NAME="639">, they are treated as options. The following options are supported: </A>
<DL>
<DT><CODE>-showempty</CODE><DD>Adds an empty element to the list for each
match of the regular expression: <PRE>% juf_split -showempty {bla&r;rab&{\;}
{} {} bla {} arg {} rab {}</PRE><DT><CODE>--</CODE><DD>Marks the
end of the options. The argument following this one will be treated as
<VAR>STRING</VAR> even if it starts with a <SAMP>-</SAMP><A NAME="665">.</A>
</DL>
<DT><CODE>juf_compose</CODE> <VAR>STRING</VAR> <VAR>NUMBER</VAR><DD>
Composes a string of <VAR>NUMBER</VAR> times of <VAR>STRING</VAR><A NAME="685">.</A><DT><CODE>
juf_strcasecmp</CODE> <VAR>STRING1</VAR> <VAR><A NAME="696">STRING2</A></VAR> <DD>Performs a case
insensitive string comparison. Returns -1, 0, or 1, depending on whether
<VAR>STRING1</VAR> is considered less than, equal to, or greater than <VAR>
STRING2</VAR><A NAME="712">. </A><DT><CODE>juf_string_count</CODE> <VAR>STRING</VAR> [<VAR>
ARRNAME</VAR>]<DD>Returns the number of different characters in <VAR>STRING
</VAR>. If <VAR>ARRNAME</VAR> is given, an array <VAR>ARRNAME</VAR> will be
created with characters as keys and character counts as values. <PRE>% juf_string_count example count
6
% array get count
l 1 p 1 x 1 m 1 a 1 e 2</PRE>
</DL>
<H2><A NAME="736">Lists</A></H2>
Jultaf provides two packages working on lists, <CODE>Sequence</CODE> for all
lists and <CODE>LOL</CODE> for lists inside of lists.
<H3><A NAME="751">Sequence</A></H3>
The functions provided by the <CODE>Sequence</CODE> package perform several
operations on lists:
<DL>
<DT><CODE><A NAME="766">Juf::Sequence::</A>shift</CODE> <VAR>NAME</VAR> [<VAR>COUNT</VAR><A NAME="777">] </A> <DD>Removes <VAR>
COUNT</VAR> element from the list stored in the variable <VAR>NAME</VAR>
and returns the last element removed. <VAR>COUNT</VAR> defaults to 1.<DT>
<CODE><A NAME="802">Juf::Sequence::</A>pop</CODE> <VAR>NAME</VAR> [<VAR>COUNT</VAR><A NAME="813">] </A> <DD>Removes <VAR>COUNT
</VAR> element from the end of the list stored in the variable <VAR>NAME
</VAR> and returns the last element removed. <VAR>COUNT</VAR> defaults to 1.
<DT><CODE><A NAME="838">Juf::Sequence::</A>append</CODE> [<VAR>OPTION</VAR> ...] <VAR>NAME</VAR> [<VAR>VALUE
</VAR><A NAME="852"> ...] </A> <DD><A NAME="862">Works like the Tcl builtin </A><CODE>lappend</CODE><A NAME="870">, but considers these options: </A>
<DL>
<DT><CODE>-nonempty</CODE><DD>Append only non-empty values.<DT><CODE>--
</CODE><DD>Marks the end of the options. The argument following this one
will be treated as <VAR>NAME</VAR> even if it starts with a <SAMP>-</SAMP>.
</DL>
<DT><CODE><A NAME="890">Juf::Sequence::</A>assign</CODE> <VAR>LIST</VAR> [<VAR>NAME</VAR> ...]<DD>Sets value
of the variables specified by the <VAR>NAME</VAR> arguments to that of the
existing elements of <VAR>LIST</VAR>. Returns remaining list elements. If
the number of variables exceeds the list length, the remaining variables
will be removed.
</DL>
<H3><A NAME="911">List of Lists</A></H3>
<A NAME="923"> Each hierarchy level is a list with keys as odd elements and inferior lists as even elements. The empty string is a special key. The accompanying element is list of values instead of a inferior list. </A><DL>
<DT><CODE>insert</CODE> <IMG ALT="*NEW*" SRC="new.gif"> <IMG
ALT="*EXPERIMENTAL*" SRC="exp.gif"> <VAR>NAME</VAR> <VAR>LIST</VAR> <VAR>
VALUE</VAR><DD>Inserts <VAR>VALUE</VAR> into list of lists stored within
variable <VAR>NAME</VAR> as specified by the keys <VAR>LIST</VAR>. <PRE>% package require LOL
% set grplist ""
% Juf::LOL::insert grplist "Development Languages Tcl" Jultaf
Development {Languages {Tcl {{} Jultaf}}}
</PRE>
</DL>
<H2><A NAME="955">Array</A></H2>
The functions provided by the <CODE>Array</CODE><A NAME="969"> package perform several operations on array variables: </A>
<DL>
<DT><CODE>values</CODE> [<VAR>SWITCH</VAR> ...] [<VAR>NAME</VAR><A NAME="981"> ...]</A><DD>
Returns a list containing the values of all of the elements in the array(s)
specified by the <VAR>NAME</VAR><A NAME="990"> arguments. If invoked with the </A><CODE>-unique</CODE> switch, a specific
value appears only once in the list. <PRE><A NAME="1002">% array set test {whiskey drink beer drink fish food}
% Juf::Array::values test
drink food drink
% Juf::Array::values -unique test
drink food</A></PRE> <DT><CODE>sort</CODE>
<VAR><A NAME="1010">NAME</A></VAR><DD> Returns list of element names of array <VAR>NAME</VAR>,
sorted according to the element values. <PRE>% array set test {whiskey drink beer drink fish food}
% Juf::Array::sort test
whiskey beer fish</PRE>
</DL>
<H2><A NAME="1031">Files</A></H2>
<DL>
<DT><CODE>juf_file_slurp</CODE> <VAR>FILE</VAR> <VAR><A NAME="1042">NAME</A></VAR> <DD><A NAME="1050">Reads complete FILE into variable NAME. Returns 1 in case of success, 0 otherwise.</A><DT><CODE>
juf_file_mkdirs</CODE> [<VAR>DIR</VAR><A NAME="1058"> ...] </A><DD><A NAME="1066">Creates all directories given as arguments. Any missing parent directories are created too. Considers an existing argument directory not as an error.</A><DT><CODE>juf_file_iscwd</CODE>
<VAR>FILENAME</VAR><DD>Checks if <VAR>FILENAME</VAR><A NAME="1078"> corresponds to the </A>current working
directory. Returns 1 if successful, 0 otherwise.
</DL>
<H3><A NAME="1097">File Name Manipulation</A></H3>
<DL>
<DT> <CODE><A NAME="EXPAND">juf_file_expand</A></CODE> <VAR>NAME</VAR> [<VAR>DIR</VAR><A NAME="1119">] </A><IMG
ALT="*NEW*" SRC="new.gif"> <IMG ALT="*EXPERIMENTAL*" SRC="exp.gif"><DD> <A NAME="1129"> Converts file name NAME to the corresponding absolute filename, </A>
performs tilde substitution and returns the result. Please note that <SAMP>
..</SAMP> and <SAMP>.</SAMP> will not expanded (yet). If <VAR>NAME</VAR> is
a relative name, the function assumes that <VAR>DIR</VAR> is the directory
where the file corresponding to <VAR>NAME</VAR> resides in. In the case that
no value for <VAR>DIR</VAR> is passed, the current working directory is
used.
</DL>
<H3><A NAME="1161">Finding Files</A></H3>
<A NAME="1170"> This section describes the procedure </A><CODE>find</CODE>, which searches for files matching certain criteria.
<CODE>find</CODE> is available only if Jultaf has been configured with
<CODE><A HREF="#ENABLE-ITCL">--enable-itcl</A></CODE>.
<P>
<CODE>find</CODE><A NAME="1188"> expects as arguments any number of "directory trees" and options with or without values. The procedure searches all files in the given directory trees and returns all files that matches the criteria specified by the options. A </A><DFN>directory tree</DFN> is a directory and the files it
contains, all of its subdirectories and the files they contain, etc. It can
also be a single non-directory file.
<P>
Valid options are:
<DL>
<DT><CODE>-name</CODE> <VAR>PATTERN</VAR><DD>Qualifies files that match
<VAR>PATTERN</VAR> in a <CODE>string match</CODE>-like fashion. Only the
last component of the file name is considered for the match. <DT><CODE>
-type</CODE> <VAR>CHAR</VAR><DD>Qualifies files that are of type <VAR>CHAR
</VAR>:
<DL>
<DT><CODE>b</CODE><DD>block (buffered) special<DT><CODE>c</CODE><DD>
character (buffered) special<DT><CODE>d</CODE><DD>directory<DT><CODE>f
</CODE><DD>regular file<DT><CODE><A NAME="1246">l</A></CODE><DD> symbolic link<DT><CODE><A NAME="1258">p</A>
</CODE><DD> pipe (FIFO)<DT><CODE><A NAME="1273">s</A></CODE><DD>socket
</DL>
</DL>
<H2><A NAME="1286">Code Processing</A></H2>
<DL>
<DT><CODE>juf_safe_eval</CODE> [<VAR>OPTIONS</VAR>] <VAR><A NAME="1297">SCRIPT</A></VAR><DD>
Evaluates <VAR>SCRIPT</VAR> as Tcl script in a temporary safe interpreter
and returns the result.
<P>
<A NAME="1321"> Valid options are: </A><DL>
<DT><CODE>-aliases <VAR>NAME</VAR></CODE><DD><A NAME="1330">Creates an </A>alias for each key in array
<VAR>NAME</VAR><A NAME="1340"> within the safe interpreter. </A><DT><CODE>-exit <VAR><A NAME="1348">COMMAND</A></VAR></CODE><DD>exit handler<VAR>
COMMAND</VAR> will be called with the interpreter as argument after
processing <VAR>SCRIPT</VAR><A NAME="1360">.</A><DT><CODE>-interp <VAR>NAME</VAR></CODE><DD>
Stores interpreter into variable <VAR>NAME</VAR>. Useful with the <CODE>
-unknown</CODE><A NAME="1377"> option.</A><DT><CODE>-nosafe</CODE><DD><A NAME="1385">Use an ordinary slave interpreter.</A><DT><CODE>-renames <VAR>NAME
</VAR></CODE><DD>Renames commands stored as keys in array <VAR>NAME</VAR><A NAME="1399"> to the corresponding values within the safe interpreter. </A>
<DT><CODE>-stats <VAR>NAME</VAR></CODE><DD>Fills array <VAR>NAME</VAR><A NAME="1413"> with statistics: </A>
<DL>
<DT>cmdcount<DD><A NAME="1421">number of commands executed within the safe interpreter.</A>
</DL>
<DT><CODE>-unknown <VAR>NAME</VAR></CODE><DD>Function <VAR>NAME</VAR><A NAME="1435"> will be called if the safe interpreter stumbles over an unknown command. </A><DT>
<CODE>-variables <VAR>NAME</VAR></CODE><DD>Creates a variable for each key
in array <VAR>NAME</VAR> within the safe interpreter. The initial value of
the variable is the corresponding array element. <DT><CODE>--</CODE><DD>
Marks the end of the options. The argument following this one will be
treated as <VAR>NAME</VAR> even if it starts with a <SAMP>-</SAMP><A NAME="1460">.</A>
</DL>
<DT><CODE>juf_safe_source</CODE> [<VAR>OPTIONS</VAR>] <VAR>FILE</VAR> [
<VAR>NAME</VAR><A NAME="1475">]</A><DD> Evaluate <VAR>FILE</VAR> as Tcl script in a temporary
safe interpreter. Accepts the same options as <CODE>juf_safe_eval</CODE>.
</DL>
<H2><A NAME="1491">Invoking subprocesses</A></H2>
<A NAME="1498">The </A><CODE>shell</CODE> module<A NAME="1508"> consists only of one function: </A>
<DL>
<DT><CODE>juf_shell_run</CODE> <VAR>args</VAR><DD><A NAME="1518">Passes its arguments to </A><CODE>exec</CODE> and
returns 1 if successful, 0 otherwise.
</DL>
<H2><A NAME="1529">Accessing GDBM Databases</A></H2>
GNU dbm databases can be manipulated with the <CODE>juf_gdbm</CODE>
command. Note that this command is available only if Jultaf is configured
with the <A HREF="#WITHGDBM">--with-gdbm</A><A NAME="1550"> option. </A>
<DL>
<DT><CODE>juf_gdbm open</CODE> <VAR>NAME</VAR> <VAR>FLAGS</VAR><DD>Opens
database file <VAR>NAME</VAR> and returns database identifier. The access
mode is specified by <VAR>FLAGS</VAR>:
<DL>
<DT><SAMP>r</SAMP><DD>Database is opened for reading. Any call to <CODE>
juf_gdbm</CODE> with the options <CODE>delete</CODE> or <CODE>store</CODE>
will fail.<DT><SAMP>rw</SAMP><DD>Database is opened for reading and writing.
<DT><SAMP>rwc</SAMP><DD>Same as <CODE>rw</CODE>, if the database does not
exist, a new one will be created.<DT><SAMP>rwn</SAMP><DD>Same as <CODE>rw
</CODE><A NAME="1607">, a new database will be created in any case.</A>
</DL>
<DT><CODE>juf_gdbm close</CODE> <VAR>DBID</VAR><DD>Closes database specified
by <VAR>DBID</VAR><A NAME="1622">.</A><DT><CODE>juf_gdbm store</CODE> <VAR>DBID</VAR> <VAR>KEY
</VAR> <VAR>VALUE</VAR><DD>Stores <VAR>KEY</VAR> with the associated <VAR>
VALUE</VAR> in database specified by <VAR>DBID</VAR><A NAME="1649">.</A><DT><CODE>juf_gdbm
insert</CODE> <VAR>DBID</VAR> <VAR>KEY</VAR> <VAR>VALUE</VAR><DD>Inserts
<VAR>KEY</VAR> with the associated <VAR>VALUE</VAR> in database specified by
<VAR>DBID</VAR>. Generates an error if <VAR>KEY</VAR><A NAME="1679"> exists already. </A><DT><CODE>juf_gdbm
fetch</CODE> <VAR>DBID</VAR> <VAR>KEY</VAR><DD>Returns associated value for
<VAR>KEY</VAR> in database specified by <VAR>DBID</VAR>. If <VAR>KEY</VAR><A NAME="1703"> doesn't exist, a empty string is returned.</A>
<DT><CODE>juf_gdbm delete</CODE> <VAR>DBID</VAR> <VAR>KEY</VAR><DD>Removes
<VAR>KEY</VAR> from database specified by <VAR>DBID</VAR><A NAME="1724">.</A><DT><CODE>juf_gdbm
exists</CODE> <VAR>DBID</VAR> <VAR>KEY</VAR><DD>Returns 1, if <VAR>KEY
</VAR> exists in database specified by <VAR>DBID</VAR><A NAME="1745">, 0 otherwise.</A><DT><CODE>juf_gdbm
list</CODE> <VAR>DBID</VAR><DD>Returns a list containing all keys in
database specified by <VAR>DBID</VAR>.
</DL>
<H2><A NAME="1766">RPM Interface</A></H2>
<DL>
<DT><CODE>query</CODE> <VAR>PACKAGE</VAR> <VAR>TAG</VAR><DD>Queries <VAR>
PACKAGE</VAR> for the value of <VAR>TAG</VAR>. If a file <VAR>PACKAGE</VAR>
doesn't exist, the RPM database will be searched for <VAR>PACKAGE</VAR>.
Supported tags are:
<DL>
<DT><CODE>name</CODE><DD>name of package<DT><CODE>group</CODE><DD>slash
separated list of group names
</DL>
Queries looks like: <PRE>% package require RPM
% Juf::RPM::query rpm name
rpm
% Juf::RPM::query file group
Utilities/File</PRE>
</DL>
<H2><A NAME="1815">Miscellaneous Functions</A></H2>
<DL>
<DT><CODE>Juf::deprecate</CODE> <VAR>OLD</VAR> <VAR>NEW</VAR><DD>Deprecates
function <VAR>OLD</VAR> in favor of function <VAR>NEW</VAR>. Maps <VAR>OLD
</VAR> to <VAR>NEW</VAR> and prints error message at the first call of
<VAR>OLD</VAR>. <PRE><A NAME="1845">% package require Jufbase
% 0.0.4
Juf::deprecate juf_compose Juf::String::compose
% juf_compose foo 5
juf_compose: deprecated function
foofoofoofoofoo</A></PRE><DT><CODE>juf_misc_scriptname</CODE><DD><A NAME="1851">Returns name of the current </A>script<A NAME="1859"> with leading directories and extension(s) removed.</A>
<DT><CODE>juf_misc_shell</CODE> [<VAR>PROMPT</VAR>]<DD>Displays the prompt
given in <VAR>PROMPT</VAR> which defaults to "% " and evaluates the user
input in the current interpreter until the user types <CODE>exit</CODE> or
the demanded command invokes the <CODE>exit</CODE><A NAME="1878"> command. </A> This command is very
useful for testing libraries and/or Tcl applications. The following script
can be adapted to your needs: <PRE>#!/usr/bin/tclsh
lappend auto_path "/usr/share/jultaf"
juf_misc_shell "jultaflib% "</PRE>
</DL>
<H2><A NAME="1890">Package Index</A></H2>
<UL>
<LI><A HREF="#955">Array</A>
</LI>
<LI><A HREF="#255">Error</A>
</LI>
<LI><A HREF="#911">LOL</A>
</LI>
<LI><A HREF="#751">Sequence</A>
</LI>
<LI><A HREF="#569">String</A>
</LI>
</UL>
<H2><A NAME="1901">Variable Index</A></H2>
<UL>
<LI><A HREF="#286">badoption</A>
</LI>
<LI><A HREF="#365">errorCode</A>
</LI>
<LI><A HREF="#295">wrongargs</A>
</LI>
</UL>
<H2><A NAME="1906">Function Index</A></H2>
<UL>
<LI><A HREF="#838">append</A>
</LI>
<LI><A HREF="#890">assign</A>
</LI>
<LI><A HREF="#1815">deprecate</A>
</LI>
<LI><A HREF="#324">error</A>
</LI>
<LI><A HREF="#1518">exec</A>
</LI>
<LI><A HREF="#309">fatal</A>
</LI>
<LI><A HREF="#271">fault</A>
</LI>
<LI><A HREF="#1170">find</A>
</LI>
<LI><A HREF="#923">insert</A>
</LI>
<LI><A HREF="#533">juf_branch</A>
</LI>
<LI><A HREF="#665">juf_compose</A>
</LI>
<LI><A HREF="#EXPAND">juf_file_expand</A>
</LI>
<LI><A HREF="#1066">juf_file_iscwd</A>
</LI>
<LI><A HREF="#1050">juf_file_mkdirs</A>
</LI>
<LI><A HREF="#1031">juf_file_slurp</A>
</LI>
<LI>juf_gdbm
<UL>
<LI><A HREF="#1607">close</A>
</LI>
<LI><A HREF="#1703">delete</A>
</LI>
<LI><A HREF="#1724">exists</A>
</LI>
<LI><A HREF="#1679">fetch</A>
</LI>
<LI><A HREF="#1649">insert</A>
</LI>
<LI><A HREF="#1745">list</A>
</LI>
<LI><A HREF="#1550">open</A>
</LI>
<LI><A HREF="#1622">store</A>
</LI>
</UL>
</LI>
<LI><A HREF="#461">juf_getopts</A>
</LI>
<LI><A HREF="#431">juf_getopts_listspecs</A>
</LI>
<LI><A HREF="#1845">juf_misc_scriptname</A>
</LI>
<LI><A HREF="#1859">juf_misc_shell</A>
</LI>
<LI><A HREF="#1286">juf_safe_eval</A>
</LI>
<LI><A HREF="#1460">juf_safe_source</A>
</LI>
<LI><A HREF="#1508">juf_shell_run</A>
</LI>
<LI><A HREF="#583">juf_split</A>
</LI>
<LI><A HREF="#685">juf_strcasecmp</A>
</LI>
<LI><A HREF="#712">juf_string_count</A>
</LI>
<LI><A HREF="#862">lappend</A>
</LI>
<LI><A HREF="#802">pop</A>
</LI>
<LI><A HREF="#1766">query</A>
</LI>
<LI><A HREF="#766">shift</A>
</LI>
<LI><A HREF="#1002">sort</A>
</LI>
<LI><A HREF="#550">switch</A>
</LI>
<LI><A HREF="#358">tclmsg</A>
</LI>
<LI><A HREF="#969">values</A>
<UL>
<LI><A HREF="#990">-unique</A>
</LI>
</UL>
</LI>
<LI><A HREF="#339">warning</A>
</LI>
</UL>
<H2><A NAME="1911">Concept Index</A></H2>
<UL>
<LI><A HREF="#ENABLE-ITCL">--enable-itcl</A>
</LI>
<LI><A HREF="#WITHGDBM">--with-gdbm</A>
</LI>
<LI><A HREF="#WITHPQ">--with-pq</A>
</LI>
<LI><A HREF="#WITHPROF">--with-prof</A>
</LI>
<LI><A HREF="#WITHRPM">--with-rpm</A>
</LI>
<LI><A HREF="#1321">-aliases</A>
</LI>
<LI><A HREF="#1340">-exit</A>
</LI>
<LI><A HREF="#1360">-interp</A>
</LI>
<LI><A HREF="#870">-nonempty</A>
</LI>
<LI><A HREF="#1377">-nosafe</A>
</LI>
<LI><A HREF="#1385">-renames</A>
</LI>
<LI><A HREF="#639">-showempty</A>
</LI>
<LI><A HREF="#1399">-stats</A>
</LI>
<LI><A HREF="#1421">-unknown</A>
</LI>
<LI><A HREF="#1435">-variables</A>
</LI>
<LI>absolute
<UL>
<LI><A HREF="#1119">file names</A>
</LI>
</UL>
</LI>
<LI><A HREF="#1330">alias</A>
</LI>
<LI><A HREF="#852">appending list elements</A>
</LI>
<LI>arrays
<UL>
<LI><A HREF="#981">list of values</A>
</LI>
<LI>sorting
<UL>
<LI><A HREF="#1010">by value</A>
</LI>
</UL>
</LI>
</UL>
</LI>
<LI><A HREF="#1413">cmdcount</A>
</LI>
<LI><A HREF="#515">control structures</A>
</LI>
<LI><A HREF="#1078">current working directory</A>
</LI>
<LI>databases
<UL>
<LI><A HREF="#1529">GDBM</A>
</LI>
</UL>
</LI>
<LI><A HREF="#184">DATADIR</A>
</LI>
<LI>directories
<UL>
<LI><A HREF="#1058">creating</A>
</LI>
</UL>
</LI>
<LI><A HREF="#1188">directory tree</A>
</LI>
<LI><A HREF="#231">DOCDIR</A>
</LI>
<LI>documentation
<UL>
<LI><A HREF="#213">GNU Info files</A>
</LI>
<LI><A HREF="#238">HTML</A>
</LI>
</UL>
</LI>
<LI><A HREF="#1348">exit handler</A>
</LI>
<LI><A HREF="#1097">expanding file names</A>
</LI>
<LI>features
<UL>
<LI><A HREF="#54">new</A>
</LI>
<LI><A HREF="#108">optional</A>
</LI>
<LI><A HREF="#72">unstable</A>
</LI>
</UL>
</LI>
<LI><A HREF="#1258">FIFO</A>
</LI>
<LI><A HREF="#1090">file names</A>
<UL>
<LI><A HREF="#1119">absolute</A>
</LI>
<LI><A HREF="#1097">expanding</A>
</LI>
</UL>
</LI>
<LI>files
<UL>
<LI><A HREF="#1042">reading</A>
</LI>
<LI><A HREF="#1161">searching</A>
</LI>
</UL>
</LI>
<LI><A HREF="#1529">GDBM</A>
</LI>
<LI>GNU
<UL>
<LI><A HREF="#1529">dbm</A>
</LI>
</UL>
</LI>
<LI><A HREF="#223">GNU Info</A>
</LI>
<LI><A HREF="#248">HTML</A>
</LI>
<LI><A HREF="#238">HTML documentation</A>
</LI>
<LI><A HREF="#213">Info</A>
</LI>
<LI><A HREF="#206">INFODIR</A>
</LI>
<LI>interpreter
<UL>
<LI><A HREF="#1297">safe</A>
</LI>
<LI><A HREF="#1297">temporary</A>
</LI>
</UL>
</LI>
<LI><A HREF="#195">LIBDIR</A>
</LI>
<LI>link
<UL>
<LI><A HREF="#1246">symbolic</A>
</LI>
</UL>
</LI>
<LI><A HREF="#911">list of lists</A>
</LI>
<LI>lists
<UL>
<LI><A HREF="#852">appending elements</A>
</LI>
<LI>removing elements
<UL>
<LI><A HREF="#813">Juf::Sequence::pop</A>
</LI>
<LI><A HREF="#777">Juf::Sequence::shift</A>
</LI>
</UL>
</LI>
</UL>
</LI>
<LI><A HREF="#1258">named pipe</A>
</LI>
<LI><A HREF="#54">new items</A>
</LI>
<LI><A HREF="#619">null string</A>
</LI>
<LI>option specifications
<UL>
<LI><A HREF="#501">base set</A>
</LI>
</UL>
</LI>
<LI>pipe
<UL>
<LI><A HREF="#1258">named</A>
</LI>
</UL>
</LI>
<LI>removing list elements
<UL>
<LI><A HREF="#813">Juf::Sequence::pop</A>
</LI>
<LI><A HREF="#777">Juf::Sequence::shift</A>
</LI>
</UL>
</LI>
<LI><A HREF="#1297">safe interpreter</A>
</LI>
<LI><A HREF="#1851">script name</A>
</LI>
<LI>scripts
<UL>
<LI><A HREF="#1475">evaluating</A>
</LI>
</UL>
</LI>
<LI><A HREF="#1161">searching files</A>
</LI>
<LI><A HREF="#1498"><CODE>shell</CODE> module</A>
</LI>
<LI><A HREF="#1273">socket</A>
</LI>
<LI>source
<UL>
<LI><A HREF="#1475">Tcl scripts</A>
</LI>
</UL>
</LI>
<LI>strings
<UL>
<LI>comparing
<UL>
<LI><A HREF="#696">case insensitive</A>
</LI>
</UL>
</LI>
</UL>
</LI>
<LI>substitution
<UL>
<LI><A HREF="#1129">tilde</A>
</LI>
</UL>
</LI>
<LI><A HREF="#1246">symbolic link</A>
</LI>
<LI><A HREF="#1297">temporary interpreter</A>
</LI>
<LI>testing
<UL>
<LI><A HREF="#1878">libraries</A>
</LI>
<LI><A HREF="#1878">Tcl applications</A>
</LI>
</UL>
</LI>
<LI><A HREF="#1129">tilde substitution</A>
</LI>
<LI><A HREF="#72">unstable items</A>
</LI>
<LI><A HREF="#414">|</A>
</LI>
</UL>
<HR><ADDRESS>
Written by Stefan Hornburg <A HREF="mailto:racke@gundel.han.de"><racke@gundel.han.de></A> (Last modified 3 September 1998)<BR>Translated from <A href="jultaf.sgml">jultaf.sgml</A> by <A HREF="http://www.han.de/~racke/InfoPrism/">Info Prism's sgml2html</A> v0.0.2</ADDRESS><HR>
</BODY>
</HTML> jultaf-0.0.4/html/new.gif 100644 764 144 166 6426134605 13706 0 ustar racke users GIF89a ! , Gj\(țk&ieלZJvʮB 8[] H\@TᅖXHA
; jultaf-0.0.4/html/news.html 100644 764 144 6110 6573436133 14307 0 ustar racke users <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
<HTML>
<HEAD>
<TITLE>NEWS</TITLE>
</HEAD>
<BODY>
<H1>NEWS</H1>
<H2>Version 0.0.4 (released 2 September 1998)</H2>
<H3>Packages</H3>
<DL>
<DT>Code<DD>
<DL>
<DT><CODE>juf_safe_eval</CODE><DD>new option -exit
</DL>
<DT>Jufbase, LOL<DD>new packages<DT>Sequence<DD>namespace populated<DT>
String<DD><CODE>juf_compose</CODE> replaced by <CODE>Juf::String::compose
</CODE>
</DL>
<H3>Libraries</H3>
<UL>
<LI>Shared library for RPM access.
</UL>
<H3>Scripts</H3>
<DL>
<DT><CODE>jufdist</CODE><DD>Checks for manually inserted <CODE>auto_index
</CODE> entries.
</DL>
<H3>Makefile</H3>
Targets <CODE>tcl</CODE>, <CODE>install-tcl</CODE> and <CODE>uninstall-tcl
</CODE> depends upon <CODE>index</CODE>, <CODE>install-index</CODE> and
<CODE>uninstall-index</CODE>, respectively.
<H2>Version 0.0.3 (released 8 August 1998)</H2>
<H3>Tcl</H3>
<UL>
<LI>New package <CODE>Libtool</CODE> with functions applicable on Tcl shared
libraries.
</UL>
<H3>Libraries</H3>
<UL>
<LI>Shared library for Postgres access.
</UL>
<H3>Installation</H3>
<UL>
<LI>During installation a symlink to the directory with the library scripts
is created.<LI>The filename of the Tcl interpreter is quoted to avoid
problems with blanks in file names.<LI>Document source files are installed
too.<LI>Target <CODE>install-html</CODE> fixed. Make directories first.
</UL>
<H2>Version 0.0.2 (released 2 July 1998)</H2>
<H3>Bug fixes</H3>
<UL>
<LI>Typo fixed in <CODE>bootstrap.tcl</CODE> which makes a successful
initial run of <CODE>make</CODE> impossible.
</UL>
<H2>Version 0.0.1 (released 2 July 1998)</H2>
<H3>Tcl modules</H3>
<H4>array.tcl</H4>
<UL>
<LI>Forms package Array and namespace Juf::Array<LI>New function <CODE>sort
</CODE><LI>Function <CODE>values</CODE> (formerly <CODE>juf_array_values
</CODE>) accepts now an arbritrary number of arraysas arguments.<LI>
Function <CODE>juf_array_map</CODE> removed.
</UL>
<H4>error.tcl</H4>
<UL>
<LI>Forms package Error and namespace Juf::Error<LI>Bug fixed in function
<CODE>juf_fault</CODE> for type <CODE>badoption</CODE>.
</UL>
<H4>Code Processing</H4>
New module with functions <CODE>juf_safe_eval</CODE> and <CODE>
juf_safe_source</CODE>.
<H4>Debugging</H4>
Module removed.
<H4>Lists</H4>
<UL>
<LI>New function <CODE>juf_seqassign</CODE>.<LI>Additional parameter <VAR>
COUNT</VAR> for functions <CODE>juf_seqshift</CODE> and <CODE>juf_seqpop
</CODE>.
</UL>
<H4>Option Processing</H4>
New module <CODE>getopt</CODE>.
<H4>Miscellaneous</H4>
<UL>
<LI><CODE>juf_vd_option</CODE> removed. Use <CODE>juf_fault</CODE> instead.
<LI><CODE>juf_f2arr</CODE> removed.
</UL>
<H3>[incr Tcl] Modules</H3>
<H4>Configuration</H4>
<UL>
<LI><CODE>Conf::parsefile</CODE> accepts multi-line statements.
</UL>
<H3>Scripts</H3>
<UL>
<LI>New script <CODE>jufdist</CODE>.
</UL>
<HR><ADDRESS>
Written by Stefan Hornburg <A HREF="mailto:racke@gundel.han.de"><racke@gundel.han.de></A> (Last modified 02 September 1998)<BR>Translated from <A href="news.tcl">news.tcl</A> by <A HREF="http://www.han.de/~racke/InfoPrism/">Info Prism's sgml2html</A> v0.0.2</ADDRESS><HR>
</BODY>
</HTML> jultaf-0.0.4/itcl/ 40755 764 144 0 6573436377 12353 5 ustar racke users jultaf-0.0.4/itcl/channel.itcl 100644 764 144 6324 6556242602 14725 0 ustar racke users # This is a [incr -*- Tcl -*-] library script and belongs to the
# `Jumble Library for Tcl and Friends'.
#
# channel.itcl --- class for Tcl channels
#
# Copyright (C) 1997, 1998 Stefan Hornburg
#
# Author: Stefan Hornburg <racke@gundel.han.de>
# Maintainer: Stefan Hornburg <racke@gundel.han.de>
# Version: 0.0.3
#
# This file 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, or (at your option) any
# later version.
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
package require Flow
namespace eval Juf {}
# -------------------------------------------------------------
# CLASS: Channel
#
# Models Tcl channels (files, serial ports, command pipelines)
# and string as pseudo-channels.
#
# Attributes:
# `name' - description for subject of the channel
# `id' - Tcl channel identifier
# `buf' - string buffer
#
# Methods:
# `gets' reads line from channel data.
# -------------------------------------------------------------
class Juf::Channel {
public variable id
public variable buf
public variable name ""
constructor {args} {
eval configure $args
}
method gets {{name ""}}
private method _digest {{name ""}}
private variable _input "" ;# current line input method
}
# --------------------------------------
# OPTION: -id ID
#
# Attaches Tcl channel ID to the object.
# --------------------------------------
configbody Juf::Channel::id {
set _input id
}
# -------------------------------------------------
# OPTION: -buf STRING
#
# Attaches buffer filled with STRING to the object.
# -------------------------------------------------
configbody Juf::Channel::buf {
set _input buf
}
# ---------------------------------------
# METHOD: gets
#
# Reads line from associated Tcl channel.
# ---------------------------------------
body Juf::Channel::gets {{name ""}} {
if [string length $name] {
upvar $name v_line
juf_branch $_input id {
::gets $id v_line
} buf {
_digest v_line
}
} else {
juf_branch $_input id {
::gets $id
} buf {
_digest
}
}
}
# -----------------------
# PRIVATE METHOD: _digest
#
# Reads line from buffer.
# -----------------------
body Juf::Channel::_digest {{name ""}} {
set v_buf $buf
# read next line from buffer
set v_pos [string first "\n" $buf]
if {$v_pos == -1} {
set v_line $buf
set buf ""
} else {
set v_line [string range $buf 0 [expr $v_pos -1]]
set buf [string range $buf [incr v_pos] end]
}
# return result
if [string length $name] {
upvar $name v_var
set v_var $v_line
if [string length $v_buf] {
return [string length $v_line]
} else {
# buffer empty
return -1
}
} else {
return $v_line
}
}
package provide Channel 0.0.3
# SOME SETTINGS FOR GOOD OLD EMACS:
# Local Variables:
# tcl-default-application: "itclsh"
# End:
jultaf-0.0.4/itcl/conf.itcl 100644 764 144 43750 6556242655 14276 0 ustar racke users # This is a [incr -*- Tcl -*-] library script and belongs to the
# `Jumble Library for Tcl and Friends'.
#
# conf.itcl --- Generic Class for Configuration Tasks
#
# Copyright (C) 1997, 1998 Stefan Hornburg
#
# Author: Stefan Hornburg <racke@gundel.han.de>
# Maintainer: Stefan Hornburg <racke@gundel.han.de>
# Version: 0.0.3
#
# This file 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, or (at your option) any
# later version.
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
package require String
package require Flow
package require Sequence
namespace eval Juf {}
# ---------------------------------------------------------------------
# CLASS: ConfUnit
#
# Information:
# `name' returns unit name.
# `iskey' returns 1 if unit is a key, 0 otherwise.
# ---------------------------------------------------------------------
class Juf::ConfUnit {
constructor {name} {set _name $name}
method name {} {return $_name}
method iskey {args} {return 0}
private variable _name
}
# ----------------------------------------------------------------
# CLASS: KeyUnit
#
# Attributes:
# `options' specifies options recognized.
# `strict' prohibits dynamic generation of options if set to true.
#
# Access methods:
# `add' creates subkeys if necessary.
# `get' returns option value.
# `put' sets option value.
# `remove' deletes option or key.
# `iskey' returns 1 if unit is a key, 0 otherwise.
# ----------------------------------------------------------------
class Juf::KeyUnit {
public variable options
public variable strict 1
destructor {} ;# redefined below
method add {args}
method contents {args} {array names _hash}
method get {args}
method put {args}
method remove {name args}
method iskey {args}
protected variable _hash
}
# ------------------------------------------------
# OPTION: -options
#
# Specifies the options recognized by this object.
# ------------------------------------------------
configbody Juf::KeyUnit::options {
foreach newopt [split $options "\\\n"] {
set newopt [string trim $newopt]
if {$newopt == ""} continue
#
# skip comments
#
if {[string first "#" $newopt] == 0} continue
set optobj [eval Juf::Option [namespace current]::#auto $newopt]
if [info exists _hash([$optobj name])] {
delete object $_hash([$optobj name])
}
set _hash([$optobj name]) $optobj
}
set options ""
}
# ------------------------------------------
# DESTRUCTOR:
#
# Deletes objects created by current object.
# ------------------------------------------
body Juf::KeyUnit::destructor {} {
foreach obj [array names _hash] {
delete object $_hash($obj)
}
}
# ------------------------------------------------------
# METHOD: iskey [NAME ...]
#
# Checks whether subunit specified by the NAME arguments
# is a key or not.
# ------------------------------------------------------
body Juf::KeyUnit::iskey {args} {
if [llength $args] {
if [info exists _hash([lindex $args 0])] {
#
# pass request to subunit
#
return [eval [list $_hash([lindex $args 0])] \
iskey [lrange $args 1 end]]
} else {
#
# no subunit => no key
#
return 0
}
} else {
#
# O.K., this is a key
#
return 1
}
}
# -------------------------------
# METHOD: add NAME [NAME ...]
#
# Creates subkey(s) if necessary.
# -------------------------------
body Juf::KeyUnit::add {name args} {
if [info exists _hash($name)] {
if ![$_hash($name) iskey] {
error "Couldn't replace option $name with subkey."
}
} else {
#
# create subkey
#
set _hash($name) [Juf::Key "[namespace current]::#auto" $name]
}
if [llength $args] {
#
# pass request to subkey
#
eval [list $_hash($name)] add $args
}
return $_hash($name)
}
# ------------------------------------------------
# METHOD: get NAME [NAME ...]
#
# Returns value for option specified by arguments.
# ------------------------------------------------
body Juf::KeyUnit::get {args} {
#
# fetch and check unit name
#
set v_name [lindex $args 0]
if ![info exists _hash($v_name)] {
if $strict {error "unknown unit"} else {
return ""
}
}
#
# retrieve unit value or check next unit level
#
set v_list [lrange $args 1 end]
if {$v_list != ""} {
eval {$_hash($v_name)} get $v_list
} else {
$_hash($v_name) get
}
}
# -------------------------------------------------
# METHOD: put NAME [NAME ...] VALUE
#
# Modifies value for option specified by arguments.
# -------------------------------------------------
body Juf::KeyUnit::put {args} {
#
# fetch and check unit name
#
set v_name [lindex $args 0]
if ![info exists _hash($v_name)] {
if $strict {error "unknown unit"} else {
set _hash($v_name) [Juf::Option [namespace parent]::#auto $v_name]
}
}
#
# modify unit value or check next unit level
#
if {[llength $args] == 2} {
$_hash($v_name) put [lindex $args 1]
} else {
eval {$_hash($v_name)} put [lrange $args 1 end]
}
}
# --------------------------------------------------
# METHOD: remove NAME [NAME ...]
#
# Deletes option or key specified by NAME arguments.
# --------------------------------------------------
body Juf::KeyUnit::remove {name args} {
if [info exists _hash($name)] {
if [llength $args] {
eval $_hash($name) remove $args
} else {
delete object $_hash($name)
unset _hash($name)
}
} else {
error "unit \"$name\" not found"
}
}
# --------------------------------------------------
# Option - generic class for option handling
#
# Attributes:
# default default option value
# values list of permitted values or empty string
#
# Access methods:
# `scope' returns scoped value.
# `get' returns option value.
# `put' sets option value.
# `write' prints option name and option value.
# `preserve' stores option value.
# `restore' sets option value to preserved one.
# --------------------------------------------------
class Juf::Option {
inherit ConfUnit
public variable values
public variable default
constructor {name args} {
ConfUnit::constructor $name
} {
eval configure $args
}
destructor {} ;# redefined below
method put {value} {set _value($this) $value}
method get {}
method write {prefixlist {chl ""}}
method scope {} {::scope _value($this)}
method preserve {key}
method restore {key}
private method _chkdefault {}
private variable _keys "" ;# used preserve keys
private common _value ;# object names vs. values
private common _oldval ;# (object names,preserve key) vs. values
}
# -------------------------
# OPTION: -values
#
# Set the permitted values.
# -------------------------
configbody Juf::Option::values {
_chkdefault
}
# -----------------------
# OPTION: -default
#
# Sets the default value.
# -----------------------
configbody Juf::Option::default {
_chkdefault
if ![info exists _value($this)] {
set _value($this) $default
}
}
# ----------------------------------------------
# DESTRUCTOR
#
# Removes array elements related to this object.
# ----------------------------------------------
body Juf::Option::destructor {} {
if [info exists _value($this)] {unset _value($this)}
foreach v_key $_keys {
unset _oldval($this,$v_key)
}
}
# ---------------------------
# METHOD: get
#
# Returns value of the option
# ---------------------------
body Juf::Option::get {} {
if [info exists _value($this)] {
set _value($this)
}
}
# ------------------------------------------
# METHOD: preserve KEY
#
# Stores option value under preserve id KEY.
# ------------------------------------------
body Juf::Option::preserve {key} {
if [info exists _oldval($key)] {
error "preserve id $key already used"
}
if [info exists _value($this)] {
set _oldval($this,$key) $_value($this)
}
lappend _keys $key
}
# ----------------------------------------------------------
# METHOD: restore KEY
#
# Sets option value to the one stored under preserve id KEY.
# ----------------------------------------------------------
body Juf::Option::restore {key} {
if ![info exists _keys] {
set v_pos -1
} else {
set v_pos [lsearch $_keys $key]
}
if {$v_pos == -1} {
error "unknown preserve id $key"
}
if [info exists _oldval($this,$key)] {
set _value($this) $_oldval($this,$key)
unset _oldval($this,$key)
}
set _keys [lreplace $_keys $v_pos $v_pos]
}
# ---------------------------------------------------------
# METHOD: write PREFIXLIST [CHL]
#
# Prints option names and values in a format understandable
# by `Conf::parsefile' to CHL. If CHL is omitted, return
# the formatted text. PREFIXLIST is a list containing all
# key names leading to this option.
# ---------------------------------------------------------
body Juf::Option::write { prefixlist {chl ""} } {
set v_buf "[list [name]] [list [get]]\n"
if [llength $prefixlist] {
set v_buf "[join $prefixlist { }] $v_buf"
}
if {$chl != ""} {puts -nonewline $chl $v_buf} else {return $v_buf}
}
# ----------------------------------------
# PRIVATE METHOD: _chkdefault
#
# Checks `default' and `values' attributes
# ----------------------------------------
body Juf::Option::_chkdefault {} {
if {[info exists values($this)] && [info exists default]} {
#
# Check if default value is permitted
#
if {[lsearch -exact $values($this) $default] < 0} {
error "Value $default not permitted for option $_name"
}
}
}
# ------------------------------------------------------
# CLASS: Key - models containers for options and commands
#
# `write' prints option names and values.
# ------------------------------------------------------
class Juf::Key {
inherit KeyUnit ConfUnit
constructor {name args} {
Juf::ConfUnit::constructor $name
} {
eval configure $args
}
method write {prefixlist {chl ""}}
}
# ---------------------------------------------------------
# METHOD: write PREFIXLIST [CHL]
#
# Prints option names and values in a format understandable
# by `Conf::parsefile' to CHL. If CHL is omitted, return
# the formatted text. PREFIXLIST is a list of the names
# of all higher level keys.
# ---------------------------------------------------------
body Juf::Key::write { prefixlist {chl ""} } {
set v_buf ""
lappend prefixlist [list [name]]
foreach v_unit [array names _hash] {
set v_bufpart [$_hash($v_unit) write $prefixlist $chl]
if {$chl == "" && $v_bufpart != ""} {
append v_buf $v_bufpart
}
}
return $v_buf
}
# -------------------------------------------------------------
# CLASS Cmd - generic class for command handling
#
# Attributes:
# script script to run for command
#
# Access methods:
# `put' runs script with given arguments.
# `write' is provided as dummy counterpart for `Option::write'.
# -------------------------------------------------------------
class Juf::Cmd {
inherit ConfUnit
constructor {name args} {
ConfUnit::constructor $name
} {
eval configure $args
}
method put {args} {uplevel eval $script $args}
method write {args} {}
public variable script
}
# --------------------------------------------------------------
# CLASS: Conf [ARG ...]
#
# Conf is a generic class for configuration tasks.
#
# Attributes:
# `ignoreunknown' specifies how unknown directives are treated.
# `errorlimit' specifies maxinum number of errors while parsing.
# `logsettings' configures log output (see method `_log').
#
# Access methods:
# `scope' returns scoped value for a given option.
# `write' prints list of option names and values.
# `key' creates keys.
# `preserve' and `restore' save/load option values.
# `parsefile' reads configuration file.
# `whenset' evals script when option is set.
# --------------------------------------------------------------
class Juf::Conf {
inherit KeyUnit
public variable ignoreunknown 0 ;# issue error message
public variable commands
public variable errorlimit 10 ;# leaving `parsefile' if error count >
public variable logsettings ""
constructor {args} {
eval configure $args
}
destructor {}
method parsefile {file}
method scope {name}
method key {option name args}
method write {{chl ""}}
method preserve {key args}
method restore {key}
method whenset {args}
private method _log {token pattern args}
private method _parse {token}
private variable _cmdnames
private variable _preskeys
}
# -------------------------------
# OPTION: -commands
# -------------------------------
configbody Juf::Conf::commands {
foreach newcmd [split $commands "\\\n"] {
set newcmd [string trim $newcmd]
if {$newcmd == ""} continue
set cmdobj [eval Juf::Cmd [namespace parent]::#auto $newcmd]
if [info exists _hash([$cmdobj name])] {
delete object $_hash([$cmdobj name])
}
set _hash([$cmdobj name]) $cmdobj
set _cmdnames([$cmdobj name]) $cmdobj
}
}
# ---------------------------------------------------------
# METHOD: write PREFIXLIST [CHL]
#
# Prints option names and values in a format understandable
# by `Conf::parsefile' to CHL. If CHL is omitted, return
# the formatted text.
# ---------------------------------------------------------
body Juf::Conf::write {{chl ""} } {
set v_buf ""
foreach v_unit [array names _hash] {
set v_bufpart [$_hash($v_unit) write "" $chl]
if {$chl == "" && $v_bufpart != ""} {
append v_buf $v_bufpart
}
}
return $v_buf
}
# ----------------------------
# METHOD: key OPTION NAME ARGS
# ----------------------------
body Juf::Conf::key {option name args} {
if {$option == "add"} {
set _hash($name) [eval Juf::Key [namespace current]::#auto \
$name $args]
} elseif {$option == "configure"} {
eval $_hash($name) configure $args
} elseif {$option == "contents"} {
$_hash($name) contents
} else {
error "bad option \"$option\": should be add or configure"
}
}
# -------------------------------------------------------
# PRIVATE METHOD: _parse TOKEN
#
# Parses syntatical unit TOKEN of the configuration file.
# -------------------------------------------------------
body Juf::Conf::_parse {token} {
#
# split list in command and argument part
#
set v_parts [juf_split $token "" 2]
#
# known directive (option or command ?)
#
set v_divename [lindex $v_parts 0]
if [info exists _hash($v_divename)] {
if [info exists _cmdnames($v_divename)] {
$_hash($v_divename) put [lindex $v_parts 1]
} else {
eval {$_hash($v_divename)} put [lindex $v_parts 1]
}
} elseif !$ignoreunknown {
error "unknown directive"
}
}
# ------------------------------------------
# METHOD: parsefile FILE
#
# Reads configuration file FILE.
# ------------------------------------------
body Juf::Conf::parsefile {file} {
set _fd [open $file]
while {[gets $_fd v_line] != -1} {
append v_dive $v_line
#
# ignore blank lines and comments
#
if {$v_dive == ""} continue
if {[string index $v_dive 0] == "#"} {
set v_dive ""
continue
}
#
# check if command is complete
#
if ![info complete $v_dive] {
append v_dive "\n"
continue
}
_parse $v_dive
set v_dive ""
}
if [string length $v_dive] {
_parse $v_dive
}
close $_fd
}
# -----------------------------------------
# METHOD scope NAME
#
# Returns scoped value for the option NAME.
# -----------------------------------------
body Juf::Conf::scope {name} {
$_hash($name) scope
}
# ------------------------------------------------
# METHOD: preserve KEY [NAME ...]
#
# Saves option values given by the NAME arguments.
# ------------------------------------------------
body Juf::Conf::preserve {key args} {
if [info exists _preskeys($key)] {
error "preserve id $key already in use"
}
foreach name $args {
$_hash($name) preserve $key
}
set _preskeys($key) $args
}
# -------------------
# METHOD: restore KEY
#
# Load options values.
# --------------------
body Juf::Conf::restore {key} {
if ![info exists _preskeys($key)] {
error "unknown preserve id $key"
}
foreach name $_preskeys($key) {
$_hash($name) restore $key
}
unset _preskeys($key)
}
# ---------------------------------------------------------------
# METHOD: whenset [SWITCHES] NAME [NAME ...] SCRIPT
#
# Retrieves option value specified by the NAME arguments and runs
# script when the value isn't an empty string.
#
# Valid options are:
# -variable NAME Store option value in this variable.
# -- Marks end of options.
# ---------------------------------------------------------------
body Juf::Conf::whenset {args} {
set cont 1
while {$cont} {
juf_branch [lindex $args 0] -variable {
upvar [juf_seqshift args 2] v_var
} -- {
juf_seqshift args; set cont 0
} default {
set cont 0
}
}
set script [juf_seqpop args]
set v_var [eval get $args]
if [string length $v_var] {
uplevel 1 $script
}
}
# ---------------------------------------------------------------------
# PRIVATE METHOD: _log TOKEN PATTERN ARGS
#
# Evaluates attribute `logsettings'. If `logsettings' is a list,
# we expect pairs of token and patterns. Logging is enabled, if
# a corresponding token to TOKEN is found in the list. If `logsettings'
# is a single nonempty string, logging is unconditionally turned on.
# If the pattern derived from `logsettings' is empty, we use
# PATTERN instead.
# ---------------------------------------------------------------------
body Juf::Conf::_log {token pattern args} {
if ![string compare $logsettings ""] {return}
if {[llength $logsettings] == 1} {
#
# log unconditionally
#
puts [eval format {$pattern} $args]
return
}
if {[catch "array set v_tokarr {$logsettings}" v_ret]} {
puts stderr $v_ret
error "::Juf::Conf::logsettings: misconfigured attribute ($logsettings)"
}
if [info exists v_tokarr($token)] {
if [string compare $v_tokarr($token) ""] {
if {[catch "format {$v_tokarr($token)} $args" v_log]} {
error "::Juf::Conf::logsettings: misconfigured attribute ($v_log)"
}
puts $v_log
} else {
puts [eval format {$pattern} $args]
}
}
}
package provide juf::itcl::conf 0.0.1
# SOME SETTINGS FOR GOOD OLD EMACS:
# Local Variables:
# tcl-default-application: "itclsh"
# End:
jultaf-0.0.4/itcl/core.itcl 100644 764 144 2547 6544443117 14251 0 ustar racke users # This is a [incr -*- Tcl -*-] library script and belongs to the
# `Jumble Library for Tcl and Friends'.
#
# core.itcl --- utility functions for [incr Tcl]
#
# Copyright (C) 1997, 1998 Stefan Hornburg
#
# Author: Stefan Hornburg <racke@gundel.han.de>
# Maintainer: Stefan Hornburg <racke@gundel.han.de>
# Version: 0.0.1
#
# This file 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, or (at your option) any
# later version.
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
namespace eval Juf {namespace export create}
# ----------------------------
# PROC: create CLASS [ARG ...]
#
# Creates an object of CLASS.
# ----------------------------
proc Juf::create {class args} {
uplevel [list $class] "::#auto" $args
}
package provide juf::itcl::core 0.0.1
# SOME SETTINGS FOR GOOD OLD EMACS:
# Local Variables:
# tcl-default-application: "itclsh"
# End:
jultaf-0.0.4/itcl/find.itcl 100644 764 144 15412 6544443303 14251 0 ustar racke users # This is a [incr -*- Tcl -*-] library script and belongs to the
# `Jumble Library for Tcl and Friends'.
#
# find.itcl --- finding files matching certain criteria
#
# Copyright (C) 1997 Stefan Hornburg
#
# Author: Stefan Hornburg <racke@gundel.han.de>
# Maintainer: Stefan Hornburg <racke@gundel.han.de>
# Version: 0.0.1
#
# This file 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, or (at your option) any
# later version.
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
namespace eval Juf {}
# ------------------------------------------------------------
# PROC: find [FILE ...] [OPTION ...]
#
# Implements a subset of the GNU `find' utility.
#
# Valid options are:
# -name PATTERN True if file name matches PATTERN.
# -type b|c|d|f|l|p|s True if file is of type ... .
# -printf FMT Modifies return result.
#
# Returns matching files.
# ------------------------------------------------------------
proc Juf::find {args} {
if ![llength $args] {
#
# default directory tree
#
set args "."
}
#
# Strip files from front of argument list
#
set v_files ""
while {[llength $args] && [string index [lindex $args 0] 0] != "-"} {
lappend v_files [lindex $args 0]
set args [lrange $args 1 end]
}
#
# Convert options to methods and their arguments
#
set v_options ""
#
# - attach Tcl type strings (file,socket,...) to `-type' values
#
array set v_types {
b blockSpecial c characterSpecial d directory f file l link p fifo
s socket
}
array set v_rules {-name {match value 1} -type {type array v_types}}
for {set i 0} {$i < [llength $args]} {incr i} {
set v_name [lindex $args $i]
#
# Check for output options
#
switch -exact -- $v_name {
-printf {
incr i
set fmt [lindex $args $i]
continue
}
}
#
if ![info exists v_rules($v_name)] {
error "unknown option \"$v_name\""
}
#
# Compute option specifications
#
set v_specs $v_rules($v_name)
set v_thisopt [lindex $v_specs 0]
#
# Add next argument ?
#
switch [lindex $v_specs 1] {
value {
incr i
if {$i == [llength $args]} {
error "value for \"$v_name\""
}
lappend v_thisopt [lindex $args $i]
lappend v_options [list $v_thisopt [lindex $v_specs 2]]
}
array {
incr i
if {$i == [llength $args]} {
error "array name for \"$v_name\""
}
set v_arr [lindex $v_specs 2]
lappend v_options [list $v_thisopt [lindex [array get $v_arr \
[lindex $args $i]] 1]]
}
default {
error "wrong specification \"[lindex $v_specs 1]\""
}
}
}
#
# Create handler for recursive search
#
set v_query [::Juf::Query #auto -rules $v_options]
#
# Compute results
#
set v_matches ""
foreach v_file $v_files {
#
# Create toplevel object
#
set v_obj [FileNode ::Juf::#auto $v_file]
#
# Run query
#
if [info exists fmt] {
set v_matches [concat $v_matches \
[juf_map "\$obj pprint {$fmt}" \
[$v_query find $v_obj] obj]]
} else {
set v_matches [concat $v_matches \
[juf_map {$obj name} [$v_query find $v_obj] obj]]
}
#
# Clean up
#
delete object $v_obj
}
#
# Clean up
#
delete object $v_query
return $v_matches
}
# --------------------------------------------------------------------
# CLASS: FileNode
#
# The constructor expects the name of the corresponding file and
# optional the next FileNode object in the file system hierarchy.
#
# Attribute:
# `base' is the file responsible for creating this object.
#
# Access methods:
# `pprint' returns FMT with requested file information filled in.
# `match' checks if last component of file name matches given pattern.
# `type' returns file type.
# `relname' returns file name relative to `base' attribute.
# `name' returns absolute file name of corresponding file.
# `down' returns FileNode object if file is a non-empty directory.
# `next' returns succeeding FileNode object.
# --------------------------------------------------------------------
class Juf::FileNode {
public variable base
constructor {name {next ""}} {} ;# redefined below
destructor {} ;# ditto
method match {pattern}
method type {} {file type $_name}
method down {}
method next {} {return $_next}
method name {} {return $_name}
method relname {} {return [juf_file_strip $_name [juf_file_expand $base]]}
method pprint {fmt} {juf_reformat $fmt {%([^%])} _fspecs}
private variable _assobjs ;# objects generated on demand of this object
#
# file system structure
#
private variable _down
private variable _next
#
# file name components
#
private variable _name ;# absolute file name
private variable _tail ;# last component
#
# field specifier to method mapping
#
private common _fspecs
array set _fspecs {p name P relname H {cget -base}}
}
# -------------------------------------------
# CONSTRUCTOR: NAME
#
# NAME is the name of the corresponding file.
# -------------------------------------------
body Juf::FileNode::constructor {name {next ""}} {
set base $name
#
# Create absolute file name
#
set _name [juf_file_expand $name]
#
# Components of file name
#
set _tail [file tail $_name]
#
# Neighbour object
#
set _next $next
}
# ---------------------------
# DESTRUCTOR
#
# Destroy associated objects.
# ---------------------------
body Juf::FileNode::destructor {} {
if [info exists _assobjs] {
eval delete object $_assobjs
}
}
# --------------------------------------------------------
# METHOD: match PATTERN
#
# Returns 1 if last component of filename matches PATTERN,
# 0 otherwise.
# --------------------------------------------------------
body Juf::FileNode::match {pattern} {
return [string match $pattern $_tail]
}
# ---------------------------------------------------------
# METHOD: down
#
# Returns FileNode object if file is a non-empty directory.
# Object corresponds to a file in the directory.
# ---------------------------------------------------------
body Juf::FileNode::down {} {
if ![info exists _down] {
set _down ""
if [file isdirectory $_name] {
set v_list [glob -nocomplain [file join $_name *]]
foreach v_file $v_list {
set _down [FileNode [info namespace parent]::#auto \
$v_file $_down]
$_down configure -base $base
#
# Store created objects
#
lappend _assobjs $_down
}
}
}
return $_down
}
# SOME SETTINGS FOR GOOD OLD EMACS:
# Local Variables:
# tcl-default-application: "itclsh"
# End:
jultaf-0.0.4/itcl/optcruncher.itcl 100644 764 144 6564 6556242714 15663 0 ustar racke users # This is a -*- Tcl -*- library file and belongs to the
# `Jumble Library for Tcl and Friends'.
#
# optcruncher.itcl -- Class for command line processing
#
# Copyright (C) 1998 Stefan Hornburg
#
# Author: Stefan Hornburg <racke@gundel.han.de>
# Maintainer: Stefan Hornburg <racke@gundel.han.de>
# Version: 0.0.3
#
# This file 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, or (at your option) any
# later version.
#
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
namespace eval Juf {}
package require Error
package require Sequence
package require Flow
# -----------------------------------------------------
# CLASS: Optcruncher
#
# Attributes:
# version Version of user's package (see below !)
#
# Methods:
# parseargs parses list with command line arguments
# -----------------------------------------------------
class Juf::Optcruncher {
public variable version ""
method add {spec}
method parseargs {cmdargs newargs}
private variable shortopts
private variable longopts
private variable handlers
}
# ---------------------------------------------------------------
# OPTION: -version
#
# Version of user's package. A corresponding option handler
# is automatically installed with --version as option identifier.
# ---------------------------------------------------------------
configbody Juf::Optcruncher::version {
if [string length $version] {
set v_handler [Juf::Opthandler \#auto]
} else {
}
}
# METHOD: add SPEC
#
# Adds option handler according to SPEC.
body Juf::Optcruncher::add {spec} {
set v_opts [split $spec |]
# validate options
foreach v_opt $v_opts {
juf_branch $v_opt --* {
# long option
set v_name [string range $v_opt 2 end]
if [info exists longopts($v_name)] {
error "option \"$v_opt\" already defined"
}
} -* {
} default {
}
}
}
# ---------------------------------------------------------
# METHOD: parseargs CMDARGS NEWARGS
#
# Parses list with command line arguments CMDARGS,
# evaluates any options found and stores the
# remaining arguments into NEWARGS. If the string `--' is
# detected, following options will be ignored.
# Returns 1 in case of success, 0 otherwise.
# ---------------------------------------------------------
body Juf::Optcruncher::parseargs {cmdargs newargs} {
upvar $newargs v_trueargs
set v_trueargs ""
while {[llength $cmdargs]} {
set v_arg [juf_seqshift cmdargs]]
juf_branch $v_arg -- {
# stop processing
eval lappend v_trueargs {$v_arg} $cmdargs
set v_trueargs ""
} --* {
# long option
set v_name [string range $v_arg 2 end]
if ![info exists optmap($v_name)] {
Juf::Error::error $v_arg "unrecognized option"
return 0
}
} default {
lappend v_trueargs $v_arg
}
^ }
return 1
}
# CLASS: Opthandler
class Juf::Opthandler {
}
package provide Optcruncher 0.0.3
# SOME SETTINGS FOR GOOD OLD EMACS:
# Local Variables:
# tcl-default-application: "itclsh"
# End: jultaf-0.0.4/itcl/person.itcl 100644 764 144 3541 6556243121 14616 0 ustar racke users # This is a -*- Tcl -*- library file and belongs to the
# `Jumble Library for Tcl and Friends'.
#
# person.itcl -- Generic Class for human persons
#
# Copyright (C) 1998 Stefan Hornburg
#
# Author: Stefan Hornburg <racke@gundel.han.de>
# Maintainer: Stefan Hornburg <racke@gundel.han.de>
# Version: 0.0.3
#
# This file 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, or (at your option) any
# later version.
#
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
namespace eval Juf {}
# ------------------------------------------------
# CLASS: Person
#
# Models human persons.
#
# Attributes:
# email Electronic mail address of the person.
# homepage WWW homepage of the person.
# ------------------------------------------------
class Juf::Person {
public variable email
public variable homepage
constructor {args} {} # redefined below
}
#
# CONSTRUCTOR
#
# Takes a string ID identifying a person and the usual option
# arguments. ID is either the name of the person or a combination
# of the name and the email address, like that:
#
# Stefan Hornburg <racke@gundel.han.de>
# "Stefan Hornburg" <racke@gundel.han.de>
# racke@gundel.han.de (Stefan Hornburg)
#
body Juf::Person::constructor {id args} {
eval configure $args
}
package provide Person 0.0.3
# SOME SETTINGS FOR GOOD OLD EMACS:
# Local Variables:
# tcl-default-application: "itclsh"
# End: jultaf-0.0.4/itcl/query.itcl 100644 764 144 10051 6544443505 14474 0 ustar racke users # This is a [incr -*- Tcl -*-] library script and belongs to the
# `Jumble Library for Tcl and Friends'.
#
# query.itcl --- Generic Class for Recursive Searchs
#
# Copyright (C) 1997, 1998 Stefan Hornburg
#
# Author: Stefan Hornburg <racke@gundel.han.de>
# Maintainer: Stefan Hornburg <racke@gundel.han.de>
# Version: 0.0.1
#
# This file 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, or (at your option) any
# later version.
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
package require juf::itcl::conf
namespace eval Juf {}
# ---------------------------------------------------------------
# CLASS Query - base class for recursive searchs
#
# Attributes:
# `mindepth' indicates the level of recursion to begin searching.
# Defaults to 0.
# `maxdepth' indicates the level of recursion to stop searching.
# Defaults to -1 (recurse as much as possible).
# `stop' indicates maximum length of the result list.
# Defaults to -1 (retrieve as much objects as possible).
#
# `next' and `down' are methods to retrieve the next object resp.
# the first child object.
#
# `rules' is a list of lists, each element consists of the method
# and their arguments and the output that qualifies the
# object as result.
#
# Methods:
# `find' runs recursive search on given objects.
#
# Auxiliary methods:
# `_find_intern' is the work-horse for `find'.
# ---------------------------------------------------------------
class Juf::Query {
constructor {args} {eval configure $args}
method find {args}
private method _find_intern {obj depth found}
public variable mindepth 0
public variable maxdepth -1
public variable stop -1
public variable next next
public variable down down
public variable rules ""
}
# -----------------------------------------
# METHOD find [OBJ ...]
#
# runs recursive search on given arguments.
# returns all objects matching `rules'.
# -----------------------------------------
body Juf::Query::find {args} {
set v_found 0
set v_objs ""
foreach obj $args {
set v_objs [concat $v_objs [_find_intern $obj 0 v_found]]
}
return $v_objs
}
# ------------------------------------------------------
# PRIVATE METHOD _find_intern OBJ DEPTH FOUND
#
# runs recursive search at specified level DEPTH for OBJ
# returns all matching objects (FOUND keeps track of
# found objects)
# ------------------------------------------------------
body Juf::Query::_find_intern {obj depth found} {
upvar $found v_found
set v_result ""
#
# Check number of objects
#
if {$stop >= 0 && $v_found >= $stop} return
#
# Check depth
#
if {$maxdepth >= 0 && $depth > $maxdepth} return
if {$depth >= $mindepth} {
set v_rulecount [llength $rules]
set v_count $v_rulecount
for {set i 0} {$i < $v_rulecount} {incr i} {
set v_rule [lindex $rules $i]
if {[eval $obj [lindex $v_rule 0]] == [lindex $v_rule 1]} {
#
# rule has matched !
#
incr v_count -1
} else {
break
}
}
#
# add to result if all rules had matched
#
if !$v_count {
lappend v_result $obj
incr v_found
}
}
#
# Recurse through child objects
#
set v_down [$obj $down]
if {$v_down != ""} {
set v_result [concat $v_result \
[_find_intern $v_down [expr $depth + 1] v_found]]
}
#
# Recurse through neighbour object tree
# Makes no sense for toplevel object
#
if $depth {
set v_next [$obj next]
if {$v_next != ""} {
set v_result [concat $v_result \
[_find_intern $v_next [expr $depth] v_found]]
}
}
return $v_result
}
package provide juf::itcl::query 0.0.1
# SOME SETTINGS FOR GOOD OLD EMACS:
# Local Variables:
# tcl-default-application: "itclsh"
# End:
jultaf-0.0.4/gdbm/ 40755 764 144 0 6573436403 12317 5 ustar racke users jultaf-0.0.4/gdbm/Makefile.in 100644 764 144 14227 6441356411 14501 0 ustar racke users # Makefile for `Jumble Library for Tcl and Friends' (GDBM subdirectory)
# Copyright (C) 1997 Stefan Hornburg
# This file 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, or (at your option) any
# later version.
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
# =======================
# Where To Install Things
# =======================
# The default location for installation. Everything is placed in
# subdirectories of this directory. The default values for many of
# the variables below are expressed in terms of this one, so you may
# not need to change them. This defaults to /usr/local.
prefix = @prefix@
# Like `prefix', but used for architecture-specific files.
exec_prefix = @exec_prefix@
# Directory for object files and libraries of object code.
libdir = @libdir@
# Where to install architecture-independent data files.
datadir = @datadir@
# ----------------------------
# Program-specific directories
# ----------------------------
# These variables hold the values the program will actually use. They are
# based on the values of the standard Make variables above.
# Where to install the architecture-independent data files
# specific to this package.
mydatadir = ${datadir}/${PKGSPEC}
# ======================
# Where To Lookup Things
# ======================
# Where to find the source code.
# This is set by the configure script's `--srcdir' option.
srcdir = @srcdir@
top_srcdir = @top_srcdir@
# Tell make where to find source files; this is needed for the makefiles.
VPATH= @srcdir@
# ==============
# Compiler Flags
# ==============
CFLAGS = -Wall -O2
ALL_CFLAGS = ${CFLAGS}
SHARED_CFLAGS = ${CFLAGS}
ALL_SHARED_CFLAGS = ${SHARED_CFLAGS} -I${includedir} @SHLIB_CFLAGS@
SHLIB_SUFFIX = @SHLIB_SUFFIX@
SHARED_LDFLAGS = ${LDFLAGS}
ALL_SHARED_LDFLAGS = ${SHARED_LDFLAGS} @SHLIB_LDFLAGS@
ALL_LDFLAGS = ${LDFLAGS} @SHLIB_LDFLAGS@
SHARED_LD = @SHLIB_LD@
TCL_DEFS = @TCL_DEFS@
# ================
# Utility Programs
# ================
# --------------------------------------------------------------------
# Commands for actual installation, for executables and nonexecutables
# --------------------------------------------------------------------
INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
# -----------
# Interpreter
# -----------
TCLSH = @TCLSH@
# *******************************************************
# Nothing to configure left now (at least for sane minds)
# *******************************************************
VERSION = @PKG_VERSION@
PKGNAME = @PKG_NAME@
PKGSPEC = @PKG_SPEC@
DISTNAME = ${PKGSPEC}-${VERSION}
JUFGDBM_VERSION = @JUFGDBM_VERSION@
# ===================
# Package Directories
# ===================
buildroot = @buildroot@
includedir = $(top_srcdir)/@PKG_INCLUDEDIR@
# ===============
# What to compile
# ===============
SHCFILES = gdbm.c
SHOBJFILES = ${SHCFILES:%.c=%.o}
SHARED_LIB=@JUFGDBM_LIB@
# ==========
# Data files
# ==========
# =======
# Targets
# =======
# --------------------------------------
# Default target: compile entire program
# --------------------------------------
all: lib bin
# ==============
# Implicit Rules
# ==============
${SHOBJFILES}: %.o: %.c
$(CC) ${ALL_SHARED_CFLAGS} -c $<
# ----------------
# Make executables
# ----------------
.PHONY: bin binq bint install-bin uninstall-bin md-bin clean-bin
bin: $(PROGRAM)
# ============
# Dependencies
# ============
${SHARED_LIB}: ${SHOBJFILES}
${SHARED_LD} ${ALL_SHARED_LDFLAGS} -lgdbm -o $@ $<
echo 'set state [catch "load ./${SHARED_LIB}" res]; if {$$state == 1} {puts stderr $$errorInfo}; exit $$state' | $(TCLSH)
gdbm.c: jufgdbm.h $(includedir)/juf.h
# =======
# Library
# =======
lib: ${SHARED_LIB}
install-lib: lib md-lib
@echo Installing shared library in ${libdir}
$(INSTALL_DATA) $(SHARED_LIB) $(libdir)
md-lib:
$(top_srcdir)/mkinstalldirs $(libdir)
uninstall-lib:
-(cd $(libdir); rm $(SHARED_LIB))
clean-lib:
-(rm *.o ${SHARED_LIB})
# ===========================
# Cleaning up and miscellanea
# ===========================
.PHONY: mostlyclean clean distclean maintainer-clean
# ---------------------------------------------------------------------
# Delete all files from the current directory that are normally created
# by building the program. Don't delete the files that record the
# configuration. Also preserve files that could be made by building,
# but normally aren't because the distribution comes with them.
# ---------------------------------------------------------------------
clean mostlyclean: clean-lib
# ----------------------------------------------------------------------
# Delete all files from the current directory that are created by
# configuring or building the program. If you have unpacked the source
# and built the program without creating any other files, `make
# distclean' should leave only the files that were in the distribution.
# ---------------------------------------------------------------------
distclean: clean
rm -f Makefile
# ----------------------------------------------------------------------
# Delete everything from the current directory that can be reconstructed
# with this Makefile. This typically includes everything deleted by
# distclean, plus more: C source files produced by Bison, tags tables,
# info files, and so on.
# ----------------------------------------------------------------------
maintainer-clean: distclean maintainer-clean-info maintainer-clean-htmldoc
Makefile: ${srcdir}/Makefile.in ${buildroot}/config.status
cd ${buildroot} && ./config.status
$(buildroot)/config.status: $(buildroot)/configure
cd $(buildroot) && ./config.status --recheck
${buildroot}/configure: ${top_srcdir}/configure.in ${top_srcdir}/aclocal.m4
cd ${buildroot} && autoconf
jultaf-0.0.4/gdbm/gdbm.c 100644 764 144 27064 6441365355 13523 0 ustar racke users /*
-------------------------------------------------------
gdbm.c - Accessing GDBM databases with Tcl commands
-------------------------------------------------------
Copyright (C) 1997 Stefan Hornburg
Author: Stefan Hornburg <racke@gundel.han.de>
Maintainer: Stefan Hornburg <racke@gundel.han.de>
Version: 0.0.1
This file 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, or (at your option) any
later version.
This file 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 file; see the file COPYING. If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h> /* strdup */
#include <ctype.h> /* tolower */
#include <errno.h>
#include <tcl.h>
#include <gdbm.h>
#include "jufgdbm.h"
/* database information data type */
/* ------------------------------ */
typedef struct {
char *name ;
int mode ;
GDBM_FILE db ;
} Juf_DbInfo ;
/* command information data type */
/* ----------------------------- */
typedef struct {
const char *name;
Tcl_CmdProc *cmd;
} Juf_CmdInfo;
/* hash table with handles as keys and database information as values */
/* ------------------------------------------------------------------ */
static Tcl_HashTable juf_gdbm_databases;
/*
* counter for handles
*/
static juf_gdbm_handle ;
/*
* prototypes for internal functions
*/
static const char *juf_gdbm_error ();
static Juf_DbInfo *juf_gdbm_getdbinfo (char *handle);
static JUF_TCLDECL(juf_gdbm_close);
static JUF_TCLDECL(juf_gdbm_delete);
static JUF_TCLDECL(juf_gdbm_exists);
static JUF_TCLDECL(juf_gdbm_fetch);
static JUF_TCLDECL(juf_gdbm_insert);
static JUF_TCLDECL(juf_gdbm_list);
static JUF_TCLDECL(juf_gdbm_open);
static JUF_TCLDECL(juf_gdbm_store);
static Juf_CmdInfo juf_gdbm_commands[] = {
{ "close", juf_gdbm_close },
{ "delete", juf_gdbm_delete },
{ "exists", juf_gdbm_exists },
{ "fetch", juf_gdbm_fetch },
{ "insert", juf_gdbm_insert },
{ "list", juf_gdbm_list },
{ "open", juf_gdbm_open },
{ "store", juf_gdbm_store },
{ NULL, NULL}
};
/*
juf_gdbm_error
Returns appropriate error message for current value of
`gdbm_errno'. If `gdbm_errno' is GDBM_FILE_OPEN_ERROR,
the error string for `errno' is returned.
*/
static const char *juf_gdbm_error () {
static char *errmsg = NULL;
static const char *sysmsg;
switch (gdbm_errno)
{
case GDBM_FILE_OPEN_ERROR: {
sysmsg = strerror (errno);
break;
}
default: {
sysmsg = gdbm_strerror (errno);
}
}
if (errmsg != NULL) free (errmsg);
errmsg = strdup (sysmsg);
if (errmsg == NULL) return (strerror (ENOMEM));
*errmsg = tolower (*errmsg);
return (errmsg);
}
/*
juf_gdbm_getdbinfo DBID
Returns pointer to structure with database information or
NULL if DBID is invalid.
*/
static Juf_DbInfo *juf_gdbm_getdbinfo (char *handle) {
Tcl_HashEntry *entry;
Juf_DbInfo *dbinfo;
/* search hashtable for database information */
entry = Tcl_FindHashEntry(&juf_gdbm_databases, handle);
if (!entry) {return (NULL);}
/* retrieve pointer to database information */
dbinfo = Tcl_GetHashValue (entry);
return (dbinfo);
}
/*
juf_gdbm_close DBID
Closes database specified by handle DBID.
*/
static JUF_TCLDECL(juf_gdbm_close)
{
Tcl_HashEntry *entry;
Juf_DbInfo *dbinfo;
/* check argument number */
JUF_TCLCKARGS(1, "juf_gdbm close dbId");
/* search hashtable for database information */
entry = Tcl_FindHashEntry (&juf_gdbm_databases, JUF_TCLARGX(0));
if (!entry) {JUF_TCLBADDBHANDLE(JUF_TCLARGX(0))}
/* get database information */
dbinfo = (Juf_DbInfo *) Tcl_GetHashValue (entry);
/* close db and remove database information */
gdbm_close (dbinfo->db) ;
free (dbinfo->name);
free ((char*) dbinfo);
Tcl_DeleteHashEntry(entry);
return (TCL_OK);
}
/*
juf_gdbm_insert DBID KEY CONTENT
Inserts KEY/CONTENT pair into database specified by DBID.
If KEY exists already, an error is generated.
*/
static JUF_TCLDECL(juf_gdbm_insert)
{
datum key, content;
int ret ;
Juf_DbInfo *dbinfo;
/* check argument number */
JUF_TCLCKARGS(3, "juf_gdbm insert dbId key newValue");
/* get database information */
dbinfo = juf_gdbm_getdbinfo(JUF_TCLARGX(0));
if (dbinfo == NULL) {JUF_TCLBADDBHANDLE(JUF_TCLARGX(0))}
/* prepare data and try to store it */
key.dptr = JUF_TCLARGX(1);
key.dsize = strlen(JUF_TCLARGX(1)) + 1 ;
content.dptr = JUF_TCLARGX(2);
content.dsize = strlen(JUF_TCLARGX(2)) + 1 ;
ret = gdbm_store (dbinfo -> db, key, content, GDBM_INSERT);
if (ret != 0) {
Tcl_AppendResult (JUF_TCLIP, gdbm_strerror(gdbm_errno), JUF_TCLEND);
return TCL_ERROR ;
}
return TCL_OK;
}
/*
juf_gdbm_store DBID KEY CONTENT
Inserts KEY/CONTENT pair into database specified by DBID.
If KEY exists already, CONTENT replaces old value.
*/
static JUF_TCLDECL(juf_gdbm_store)
{
datum key, content;
int ret ;
Juf_DbInfo *dbinfo;
/* check argument number */
JUF_TCLCKARGS(3, "juf_gdbm store dbId key newValue");
/* get database information */
dbinfo = juf_gdbm_getdbinfo(JUF_TCLARGX(0));
if (dbinfo == NULL) {JUF_TCLBADDBHANDLE(JUF_TCLARGX(0))}
/* prepare data and try to store it */
key.dptr = JUF_TCLARGX(1);
key.dsize = strlen(JUF_TCLARGX(1)) + 1 ;
content.dptr = JUF_TCLARGX(2);
content.dsize = strlen(JUF_TCLARGX(2)) + 1 ;
ret = gdbm_store (dbinfo -> db, key, content, GDBM_REPLACE);
if (ret != 0) {
Tcl_AppendResult (JUF_TCLIP, gdbm_strerror(gdbm_errno), JUF_TCLEND);
return TCL_ERROR ;
}
return TCL_OK;
}
/*
juf_gdbm_fetch DBID KEY
Searches for KEY in database and returns the corresponding value or
an empty string, if KEY not found.
*/
static JUF_TCLDECL(juf_gdbm_fetch)
{
datum key, content;
Juf_DbInfo *dbinfo;
/* check argument number */
JUF_TCLCKARGS(2, "juf_gdbm fetch dbId key newValue");
/* get database information */
dbinfo = juf_gdbm_getdbinfo(JUF_TCLARGX(0));
if (dbinfo == NULL) {JUF_TCLBADDBHANDLE(JUF_TCLARGX(0))}
/* prepare data for key and try to fetch it */
key.dptr = JUF_TCLARGX(1);
key.dsize = strlen(JUF_TCLARGX(1)) + 1 ;
content = gdbm_fetch (dbinfo -> db, key) ;
if (content.dptr) {
Tcl_AppendResult (JUF_TCLIP, content.dptr, JUF_TCLEND);
}
free (content.dptr);
return TCL_OK ;
}
/*
juf_gdbm_exists DBID KEY
Searches for KEY in database and returns 1 if KEY exists,
0 otherwise.
*/
static JUF_TCLDECL(juf_gdbm_exists)
{
datum key;
int exists;
Juf_DbInfo *dbinfo;
/* check argument number */
JUF_TCLCKARGS(2, "juf_gdbm exists dbId key")
/* get database information */
dbinfo = juf_gdbm_getdbinfo (JUF_TCLARGX(0));
if (dbinfo == NULL) {JUF_TCLBADDBHANDLE(JUF_TCLARGX(0))}
/* prepare data for key and try to fetch it */
key.dptr = JUF_TCLARGX(1);
key.dsize = strlen(JUF_TCLARGX(1)) + 1 ;
exists = gdbm_exists (dbinfo -> db, key) ;
if (exists) {
Tcl_SetResult (JUF_TCLIP, "1", TCL_STATIC);
} else {
Tcl_SetResult (JUF_TCLIP, "0", TCL_STATIC);
}
return TCL_OK ;
}
/*
juf_gdbm_delete DBID KEY
Removes the data associated with KEY from the database specified by DBID.
*/
static JUF_TCLDECL(juf_gdbm_delete)
{
datum key;
int ret;
Juf_DbInfo *dbinfo;
/* check argument number */
JUF_TCLCKARGS(2, "juf_gdbm delete dbId key");
/* get database information */
dbinfo = juf_gdbm_getdbinfo(JUF_TCLARGX(0));
if (dbinfo == NULL) {JUF_TCLBADDBHANDLE(JUF_TCLARGX(0))}
/* prepare key and try to delete it */
key.dptr = JUF_TCLARGX(1);
key.dsize = strlen(JUF_TCLARGX(1)) + 1 ;
ret = gdbm_delete (dbinfo -> db, key);
if (ret != 0) {
Tcl_AppendResult (JUF_TCLIP, gdbm_strerror(gdbm_errno), JUF_TCLEND);
return TCL_ERROR ;
}
return TCL_OK;
}
/*
juf_gdbm_list DBID
Returns a list of all keys in the database specified by DBID.
*/
static JUF_TCLDECL(juf_gdbm_list)
{
datum key, nextkey;
Tcl_DString result;
Juf_DbInfo *dbinfo;
/* check argument number */
JUF_TCLCKARGS(1, "juf_gdbm list dbId");
/* get database information */
dbinfo = juf_gdbm_getdbinfo(JUF_TCLARGX(0));
if (dbinfo == NULL) {JUF_TCLBADDBHANDLE(JUF_TCLARGX(0))}
/* loop through keys in database */
Tcl_DStringInit (&result);
key = gdbm_firstkey (dbinfo->db);
if (key.dptr == NULL) {
/* database empty */
return TCL_OK ;
}
do {
/* copy key to result */
Tcl_DStringAppendElement (&result, key.dptr);
/* fetch next key */
nextkey = gdbm_nextkey (dbinfo->db, key);
/* free pointer to old key */
free (key.dptr);
key = nextkey;
} while (nextkey.dptr != NULL);
Tcl_DStringResult(interp, &result);
return TCL_OK ;
}
/*
juf_gdbm_open FILE MODE
Opens FILE as database and returns handle.
MODE is one of r,rw,rwc or rwn.
*/
static JUF_TCLDECL(juf_gdbm_open)
{
int mode, new;
char buf [100];
Tcl_HashEntry *entry ;
Juf_DbInfo *dbinfo;
/* check argument number */
if (JUF_TCLARGC < 2 || JUF_TCLARGC > 3)
JUF_TCLWRARGS("juf_gdbm open fileName ?access?");
mode = GDBM_READER ;
/* check mode string if given */
if (JUF_TCLARGC == 3) {
if (strcmp(JUF_TCLARGX(1),"r")==0)
mode = GDBM_READER ;
else if (strcmp(JUF_TCLARGX(1),"rw")==0)
mode = GDBM_WRITER ;
else if (strcmp(JUF_TCLARGX(1),"rwc")==0)
mode = GDBM_WRCREAT ;
else if (strcmp(JUF_TCLARGX(1),"rwn")==0)
mode = GDBM_NEWDB ;
else {
JUF_TCLBADMODE(JUF_TCLARGX(1));
}
}
/* open database and register it */
dbinfo = (Juf_DbInfo *) malloc (sizeof (Juf_DbInfo)) ;
if (dbinfo == NULL) {
perror (strerror (ENOMEM));
exit (1);
}
/*
* create new name and malloc space for it
* malloc extra space for name
*/
sprintf(buf, "gdbm%i", juf_gdbm_handle);
juf_gdbm_handle++ ;
dbinfo -> name = strdup (buf);
if (dbinfo -> name == NULL) {
perror (strerror (ENOMEM));
exit (1);
}
dbinfo -> mode = mode ;
dbinfo -> db = gdbm_open (JUF_TCLARGX(0), 0 ,mode, 0664, NULL);
if (!dbinfo->db) {
/*
* error occurred
* free previously allocated memory
* db_errno indicates error
*/
free (dbinfo->name);
free ((char*) dbinfo);
Tcl_AppendResult (JUF_TCLIP, "couldn't open \"", JUF_TCLARGX(0),
"\": ", juf_gdbm_error (), JUF_TCLEND);
return (TCL_ERROR);
} else {
/*
* success
* enter db to hashtab
*/
entry = Tcl_CreateHashEntry(&juf_gdbm_databases,dbinfo->name,&new);
Tcl_SetHashValue(entry,(char*)dbinfo);
Tcl_AppendResult (JUF_TCLIP, dbinfo->name, JUF_TCLEND);
return TCL_OK;
}
}
/*
juf_gdbm
command dispatcher
*/
JUF_TCLDECL(juf_gdbm)
{
int i;
/* check argument number */
if (JUF_TCLARGC < 3) JUF_TCLWRARGS("juf_gdbm option arg ?arg ...?");
/* select appropriate function */
for (i = 0 ; juf_gdbm_commands[i].name != NULL; i++) {
if (strcmp (juf_gdbm_commands[i].name, JUF_TCLARGX (0)) == 0)
{
return (juf_gdbm_commands [i].cmd
(JUF_TCLCD, JUF_TCLIP, JUF_TCLARGC - 1, &JUF_TCLARGX(0)));
}
}
/* command not found */
Tcl_AppendResult (JUF_TCLIP, "bad option \"", JUF_TCLARGX(0),
"\": should be close, delete, exists, fetch, insert, list, open, or store", JUF_TCLEND);
return(TCL_ERROR);
}
/*
Jufgdbm_Init INTERP
Initializes library.
*/
int Jufgdbm_Init (Tcl_Interp *JUF_TCLIP)
{
Tcl_CreateCommand(JUF_TCLIP, "juf_gdbm", juf_gdbm,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
/* init hash table */
/* --------------- */
Tcl_InitHashTable (&juf_gdbm_databases, TCL_STRING_KEYS);
/*
* set handle to zero
*/
juf_gdbm_handle = 0 ;
/* provide JUFGDBM as package */
return (Tcl_PkgProvide (JUF_TCLIP, JUFGDBM_PKGNAME, JUFGDBM_VERSION));
}
jultaf-0.0.4/gdbm/jufgdbm.h 100644 764 144 2351 6423655457 14212 0 ustar racke users /*
-------------------------------------------------------
jufgdbm.h - Global include file for Jultaf's GDBM stuff
-------------------------------------------------------
Copyright (C) 1997 Stefan Hornburg
Author: Stefan Hornburg <racke@gundel.han.de>
Maintainer: Stefan Hornburg <racke@gundel.han.de>
Version: 0.0.0
This file 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, or (at your option) any
later version.
This file 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 file; see the file COPYING. If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#ifndef _JUFGDBM_H
#define _JUFGDBM_H
#include "juf.h"
/* convenience macros */
/* ------------------ */
/* handling bad database handles */
#define JUF_TCLBADDBHANDLE(name) JUF_TCLBADHANDLE("database",name)
/* prototypes */
/* ---------- */
JUF_TCLDECL(juf_gdbm);
#endif
jultaf-0.0.4/include/ 40755 764 144 0 6573436405 13033 5 ustar racke users jultaf-0.0.4/include/juf.h 100644 764 144 4265 6441360121 14055 0 ustar racke users /*
juf.h - Global include file for Jultaf's Tcl extensions
Copyright (C) 1997 Stefan Hornburg
Author: Stefan Hornburg <racke@gundel.han.de>
Maintainer: Stefan Hornburg <racke@gundel.han.de>
Version: 0.0.1
This file 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, or (at your option) any
later version.
This file 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 file; see the file COPYING. If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#ifndef __JUF_H__
#define __JUF_H__
#include "pkginfo.h"
/* convenience macros */
/* ------------------ */
#define JUF_TCLCD client
#define JUF_TCLIP interp
#define JUF_TCLARGC argc
#define JUF_TCLARGV argv
#define JUF_TCLEND (char *) NULL
#define JUF_TCLARGX(no) JUF_TCLARGV[no+1]
/* declarations for Tcl commands */
#define JUF_TCLDECL(name) \
int name _ANSI_ARGS_((ClientData JUF_TCLCD, Tcl_Interp *JUF_TCLIP, \
int JUF_TCLARGC, char** JUF_TCLARGV))
/* handling calls with wrong number of arguments */
#define JUF_TCLWRARGS(msg) {\
Tcl_AppendResult (JUF_TCLIP, "wrong # args: should be \"", msg, "\"",\
JUF_TCLEND);\
return TCL_ERROR;\
}
/* invalid options */
#define JUF_TCLINVOPT(msg) {\
Tcl_AppendResult (JUF_TCLIP, "unknown option \"",\
msg, "\"", JUF_TCLEND);\
return TCL_ERROR;\
}
/* check arguments */
#define JUF_TCLCKARGS(no,msg) \
if (JUF_TCLARGC != no + 1) JUF_TCLWRARGS(msg)
#define JUF_TCLCKMINARGS(no,msg) \
if (JUF_TCLARGC < no + 1) JUF_TCLWRARGS(msg)
/* handling bad modes */
#define JUF_TCLBADMODE(mode) {\
Tcl_AppendResult (JUF_TCLIP, "illegal access mode \"", mode, "\"",\
JUF_TCLEND);\
return (TCL_ERROR);}
/* handling bad handles */
#define JUF_TCLBADHANDLE(sub,name) {\
Tcl_AppendResult (JUF_TCLIP, "can not find ", sub, " named \"", name, "\"",\
JUF_TCLEND);\
return TCL_ERROR;\
}
#endif
jultaf-0.0.4/include/pkginfo.h.in 100644 764 144 2411 6563441242 15333 0 ustar racke users /*
-------------------------------------------------------------------------
pkginfo.h - Automagically generated include file with package information
-------------------------------------------------------------------------
Copyright (C) 1997, 1998 Stefan Hornburg
Author: Stefan Hornburg <racke@gundel.han.de>
Maintainer: Stefan Hornburg <racke@gundel.han.de>
Version: 0.0.4
This file 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, or (at your option) any
later version.
This file 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 file; see the file COPYING. If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#define JUFGDBM_PKGNAME "@JUFGDBM_PKGNAME@"
#define JUFGDBM_VERSION "@JUFGDBM_VERSION@"
#define JUFPQ_PKGNAME "@JUFPQ_PKGNAME@"
#define JUFPQ_VERSION "@JUFPQ_VERSION@"
#define JUFRPM_PKGNAME "@JUFRPM_PKGNAME@"
#define JUFRPM_VERSION "@JUFRPM_VERSION@"
jultaf-0.0.4/prof/ 40755 764 144 0 6573436404 12355 5 ustar racke users jultaf-0.0.4/prof/Makefile.in 100644 764 144 14405 6423646106 14537 0 ustar racke users # Makefile for `Jumble Library for Tcl and Friends' (PROF subdirectory)
# Copyright (C) 1997 Stefan Hornburg
# This file 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, or (at your option) any
# later version.
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
# =======================
# Where To Install Things
# =======================
# The default location for installation. Everything is placed in
# subdirectories of this directory. The default values for many of
# the variables below are expressed in terms of this one, so you may
# not need to change them. This defaults to /usr/local.
prefix = @prefix@
# Like `prefix', but used for architecture-specific files.
exec_prefix = @exec_prefix@
# Directory for object files and libraries of object code.
libdir = @libdir@
# Where to install architecture-independent data files.
datadir = @datadir@
# ----------------------------
# Program-specific directories
# ----------------------------
# These variables hold the values the program will actually use. They are
# based on the values of the standard Make variables above.
# Where to install the architecture-independent data files
# specific to this package.
mydatadir = ${datadir}/${PKGSPEC}
# ======================
# Where To Lookup Things
# ======================
# Where to find the source code.
# This is set by the configure script's `--srcdir' option.
srcdir = @srcdir@
top_srcdir = @top_srcdir@
# Tell make where to find source files; this is needed for the makefiles.
VPATH= @srcdir@
# ==============
# Compiler Flags
# ==============
CFLAGS = -Wall -O2
ALL_CFLAGS = ${CFLAGS}
SHARED_CFLAGS = ${CFLAGS}
ALL_SHARED_CFLAGS = ${SHARED_CFLAGS} -I${includedir} @SHLIB_CFLAGS@
SHLIB_SUFFIX = @SHLIB_SUFFIX@
SHARED_LDFLAGS = ${LDFLAGS}
ALL_SHARED_LDFLAGS = ${SHARED_LDFLAGS} @SHLIB_LDFLAGS@
ALL_LDFLAGS = ${LDFLAGS} @SHLIB_LDFLAGS@
SHARED_LD = @SHLIB_LD@
TCL_DEFS = @TCL_DEFS@
# ================
# Utility Programs
# ================
# --------------------------------------------------------------------
# Commands for actual installation, for executables and nonexecutables
# --------------------------------------------------------------------
INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
# -----------
# Interpreter
# -----------
TCLSH = @TCLSH@
# *******************************************************
# Nothing to configure left now (at least for sane minds)
# *******************************************************
VERSION = @PKG_VERSION@
PKGNAME = @PKG_NAME@
PKGSPEC = @PKG_SPEC@
DISTNAME = ${PKGSPEC}-${VERSION}
JUFPROF_VERSION = @JUFPROF_VERSION@
# ===================
# Package Directories
# ===================
buildroot = @buildroot@
includedir = $(top_srcdir)/@PKG_INCLUDEDIR@
# ===============
# What to compile
# ===============
SHCFILES = prof.c juftime.c
SHOBJFILES = ${SHCFILES:%.c=%.o}
SHARED_LIB=@JUFPROF_LIB@
# ==========
# Data files
# ==========
# =======
# Targets
# =======
# --------------------------------------
# Default target: compile entire program
# --------------------------------------
all: lib bin
# ==============
# Implicit Rules
# ==============
${SHOBJFILES}: %.o: %.c
$(CC) $(TCL_DEFS) -DITCL_NAMESPACES ${ALL_SHARED_CFLAGS} -c $<
# Generic targets
# ---------------
.PHONY: install
install: install-lib
# ----------------
# Make executables
# ----------------
.PHONY: bin binq bint install-bin uninstall-bin md-bin clean-bin
bin: $(PROGRAM)
# ============
# Dependencies
# ============
${SHARED_LIB}: ${SHOBJFILES}
${SHARED_LD} ${ALL_SHARED_LDFLAGS} -o $@ $(SHOBJFILES)
echo 'set state [catch "load ./${SHARED_LIB}" res]; if {$$state == 1} {puts stderr $$errorInfo}; exit $$state' | $(TCLSH)
prof.c: $(includedir)/juf.h
# =======
# Library
# =======
lib: ${SHARED_LIB}
install-lib: lib md-lib
@echo Installing shared library in ${libdir}
$(INSTALL_DATA) $(SHARED_LIB) $(libdir)
md-lib:
$(top_srcdir)/mkinstalldirs $(libdir)
uninstall-lib:
-(cd $(libdir); rm $(SHARED_LIB))
clean-lib:
-(rm *.o ${SHARED_LIB})
# ===========================
# Cleaning up and miscellanea
# ===========================
.PHONY: mostlyclean clean distclean maintainer-clean
# ---------------------------------------------------------------------
# Delete all files from the current directory that are normally created
# by building the program. Don't delete the files that record the
# configuration. Also preserve files that could be made by building,
# but normally aren't because the distribution comes with them.
# ---------------------------------------------------------------------
clean mostlyclean: clean-lib
# ----------------------------------------------------------------------
# Delete all files from the current directory that are created by
# configuring or building the program. If you have unpacked the source
# and built the program without creating any other files, `make
# distclean' should leave only the files that were in the distribution.
# ---------------------------------------------------------------------
distclean: clean
rm -f Makefile
# ----------------------------------------------------------------------
# Delete everything from the current directory that can be reconstructed
# with this Makefile. This typically includes everything deleted by
# distclean, plus more: C source files produced by Bison, tags tables,
# info files, and so on.
# ----------------------------------------------------------------------
maintainer-clean: distclean maintainer-clean-info maintainer-clean-htmldoc
Makefile: ${srcdir}/Makefile.in ${buildroot}/config.status
cd ${buildroot} && ./config.status
$(buildroot)/config.status: $(buildroot)/configure
cd $(buildroot) && ./config.status --recheck
${buildroot}/configure: ${top_srcdir}/configure.in ${top_srcdir}/aclocal.m4
cd ${buildroot} && autoconf
jultaf-0.0.4/prof/juftime.c 100644 764 144 11626 6562720566 14312 0 ustar racke users /*
------------------------------------------------
juftime.c - Auxiliary functions related to times
------------------------------------------------
Copyright (C) 1997 Stefan Hornburg
Author: Stefan Hornburg <racke@gundel.han.de>
Maintainer: Stefan Hornburg <racke@gundel.han.de>
Version: 0.0.0
This file 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, or (at your option) any
later version.
This file 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 file; see the file COPYING. If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#include <sys/times.h>
#include <time.h>
#include "juftime.h"
void
TclXOSElapsedTime (clock_t *realTime, clock_t *cpuTime);
/*
* Time information
*/
void JufTimerStart (jufTimeEntry_t *pTm)
{
pTm -> real_sum = 0;
pTm -> cpu_sum = 0;
TclXOSElapsedTime (& (pTm -> real_last), & (pTm -> cpu_last));
}
void JufTimerSuspend (jufTimeEntry_t *pTm)
{
clock_t real, cpu;
TclXOSElapsedTime (&real, &cpu);
pTm -> real_sum += (real - pTm -> real_last);
pTm -> cpu_sum += (cpu - pTm -> cpu_last);
}
void JufTimerCont (jufTimeEntry_t *pTm)
{
TclXOSElapsedTime (& (pTm -> real_last), & (pTm -> cpu_last));
}
/*
* Excerpt from unixos.c (TclX distribution)
*-----------------------------------------------------------------------------
* Copyright 1996-1996 Karl Lehenbauer and Mark Diekhans.
*
* 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. Karl Lehenbauer and
* Mark Diekhans make no representations about the suitability of this
* software for any purpose. It is provided "as is" without express or
* implied warranty.
*-----------------------------------------------------------------------------
* $Id: juftime.c,v 1.5 1998/08/08 00:52:54 racke Release racke $
*-----------------------------------------------------------------------------
*/
/*-----------------------------------------------------------------------------
* TclXOSTicksToMS --
*
* Convert clock ticks to milliseconds.
*
* Parameters:
* o numTicks - Number of ticks.
* Returns:
* Milliseconds.
*-----------------------------------------------------------------------------
*/
clock_t
TclXOSTicksToMS (numTicks)
clock_t numTicks;
{
static clock_t msPerTick = 0;
/*
* Some systems (SVR4) implement CLK_TCK as a call to sysconf, so lets only
* reference it once in the life of this process.
*/
if (msPerTick == 0)
msPerTick = CLK_TCK;
if (msPerTick <= 100) {
/*
* On low resolution systems we can do this all with integer math. Note
* that the addition of half the clock hertz results in appoximate
* rounding instead of truncation.
*/
return (numTicks) * (1000 + msPerTick / 2) / msPerTick;
} else {
/*
* On systems (Cray) where the question is ticks per millisecond, not
* milliseconds per tick, we need to use floating point arithmetic.
*/
return ((numTicks) * 1000.0 / msPerTick);
}
}
/*-----------------------------------------------------------------------------
* TclXOSElapsedTime --
* System dependent interface to get the elapsed CPU and real time.
*
* Parameters:
* o realTime - Elapsed real time, in milliseconds is returned here.
* o cpuTime - Elapsed CPU time, in milliseconds is returned here.
*-----------------------------------------------------------------------------
*/
void
TclXOSElapsedTime (realTime, cpuTime)
clock_t *realTime;
clock_t *cpuTime;
{
/*
* If times returns elapsed real time, this is easy. If it returns a status,
* real time must be obtained in other ways.
*/
#ifndef TIMES_RETS_STATUS
struct tms cpuTimes;
*realTime = TclXOSTicksToMS (times (&cpuTimes));
*cpuTime = TclXOSTicksToMS (cpuTimes.tms_utime + cpuTimes.tms_stime);
#else
static struct timeval startTime = {0, 0};
struct timeval currentTime;
struct tms cpuTimes;
/*
* If this is the first call, get base time.
*/
if ((startTime.tv_sec == 0) && (startTime.tv_usec == 0))
gettimeofday (&startTime, NULL);
gettimeofday (¤tTime, NULL);
currentTime.tv_sec = currentTime.tv_sec - startTime.tv_sec;
currentTime.tv_usec = currentTime.tv_usec - startTime.tv_usec;
*realTime = (currentTime.tv_sec * 1000) + (currentTime.tv_usec / 1000);
times (&cpuTimes);
*cpuTime = TclXOSTicksToMS (cpuTimes.tms_utime + cpuTimes.tms_stime);
#endif
}
jultaf-0.0.4/prof/juftime.h 100644 764 144 2354 6423650455 14270 0 ustar racke users /*
---------------------------------------
juftime.h - Definitions for `juftime.c'
---------------------------------------
Copyright (C) 1997 Stefan Hornburg
Author: Stefan Hornburg <racke@gundel.han.de>
Maintainer: Stefan Hornburg <racke@gundel.han.de>
Version: 0.0.0
This file 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, or (at your option) any
later version.
This file 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 file; see the file COPYING. If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#ifndef __JUFTIME_H__
#define __JUFTIME_H__
#include <time.h>
typedef struct jufTimeEntry_t
{
clock_t real_sum;
clock_t cpu_sum;
clock_t real_last;
clock_t cpu_last;
} jufTimeEntry_t;
void JufTimerStart (jufTimeEntry_t *pTm);
void JufTimerSuspend (jufTimeEntry_t *pTm);
void JufTimerCont (jufTimeEntry_t *pTm);
#endif
jultaf-0.0.4/prof/prof.c 100644 764 144 47272 6423641500 13605 0 ustar racke users /*
------------------------------------------
prof.c - Profiling [incr Tcl] applications
------------------------------------------
Copyright (C) 1997 Stefan Hornburg
Author: Stefan Hornburg <racke@gundel.han.de>
Maintainer: Stefan Hornburg <racke@gundel.han.de>
Version: 0.0.0
This file 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, or (at your option) any
later version.
This file 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 file; see the file COPYING. If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#include <tcl.h>
#include <itcl.h>
#include "tclInt.h"
#include "juf.h"
#include "juftime.h"
/*
* Client data structure for profile command. This contains all global
* profiling information for the interpreter.
*/
typedef struct profInfo_t {
Tcl_Interp *interp; /* Interpreter this is for. */
Tcl_Trace traceHandle; /* Handle to current trace. */
Command *currentCmdPtr; /* Current Tcl command table entry. */
Tcl_CmdProc *savedCmdProc; /* Saved command executor function. */
ClientData savedCmdClientData;/* Save command clientData. */
Tcl_HashTable profDataTable; /* Profiling results */
jufTimeEntry_t *timeInfo; /* time information (uplevel command) */
} profInfo_t;
/*
* Profiling results for a command/method/procedure
*/
typedef struct profDataEntry_t {
long count; /* number of calls */
clock_t real;
clock_t cpu;
} profDataEntry_t;
/*
* Auxiliary structure for result sorting
*/
typedef struct profSortEntry_t
{
char *name;
profDataEntry_t data;
} profSortEntry_t;
/*
* Prototypes of internal functions.
*/
static int ProfCmpSortEntries _ANSI_ARGS_((const profSortEntry_t *a,
const profSortEntry_t *b));
static void JufDeleteTrace _ANSI_ARGS_((profInfo_t *infoPtr));
static void RecordData _ANSI_ARGS_((profInfo_t *infoPtr, char *method));
static int ProfCommandEval _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc,
char **argv));
static void
ProfTraceRoutine _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp,
int evalLevel,
char *command,
Tcl_CmdProc *cmdProc,
ClientData cmdClientData,
int argc,
char **argv));
static void
CleanDataTable _ANSI_ARGS_((profInfo_t *infoPtr));
static void
TurnOnProfiling _ANSI_ARGS_((profInfo_t *infoPtr));
static int
TurnOffProfiling _ANSI_ARGS_((Tcl_Interp *interp,
profInfo_t *infoPtr,
char *varName));
static int
Tcl_ProfileCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp,
int argc,
char **argv));
static JUF_TCLDECL(Juf_ProfReportCmd);
static void
ProfMonCleanUp _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp));
/*-----------------------------------------------------------------------------
* RecordData --
* Record an entries times in the data table.
*
* Parameters:
* o infoPtr - The global profiling info.
* o method - The entry to record.
*-----------------------------------------------------------------------------
*/
static void
RecordData (infoPtr, method)
profInfo_t *infoPtr;
char *method;
{
Tcl_HashEntry *hashEntryPtr;
profDataEntry_t *dataEntryPtr;
int newEntry;
/*
* Check the hash table for this entry, either finding an existing or
* creating a new hash entry.
*/
hashEntryPtr = Tcl_CreateHashEntry (&infoPtr->profDataTable,
method,
&newEntry);
/*
* Either get the existing entry or create a new one.
*/
if (newEntry) {
dataEntryPtr = (profDataEntry_t *) ckalloc (sizeof (profDataEntry_t));
Tcl_SetHashValue (hashEntryPtr, dataEntryPtr);
dataEntryPtr->count = 0;
dataEntryPtr->cpu = 0;
dataEntryPtr->real = 0;
} else {
dataEntryPtr = (profDataEntry_t *) Tcl_GetHashValue (hashEntryPtr);
}
/*
* Increment the cumulative data.
*/
dataEntryPtr->count++;
dataEntryPtr->cpu += infoPtr -> timeInfo -> cpu_sum;
dataEntryPtr->real += infoPtr -> timeInfo -> real_sum;
#ifdef JUF_DEBUG
printf ("E: Currently %ld entries\n",
infoPtr -> profDataTable.numEntries);
#endif
}
/*
* ProfCmpSortEntries - auxiliary function for qsorting
*/
static int ProfCmpSortEntries _ANSI_ARGS_((const profSortEntry_t *a,
const profSortEntry_t *b))
{
return (int) (b -> data.count - a -> data.count);
}
/*-----------------------------------------------------------------------------
* ProfCommandEval --
* Function to evaluate a command. The procedure trace routine substitutes
* this function for the command executor function in the Tcl command table.
* We restore the command table, record data about the start of the command
* and then actually execute the command. When the command returns, we record
* data about the time it took.
*
* FIX: This all falls apart if another trace is executed between the
* doctoring of the command entry and this function being called.
*-----------------------------------------------------------------------------
*/
static int
ProfCommandEval (clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
Interp *iPtr = (Interp *) interp;
profInfo_t *infoPtr = (profInfo_t *) clientData;
jufTimeEntry_t *timeInfo = NULL;
Command *currentCmdPtr;
int isProc, result;
Tcl_DString commandWithNs;
Tcl_Command cmd;
char *nspName;
/*
* Stop last timer, store it on the stack, and add a new one
*/
JufTimerSuspend (infoPtr -> timeInfo);
timeInfo = infoPtr -> timeInfo;
infoPtr -> timeInfo = (jufTimeEntry_t *) ckalloc
(sizeof (jufTimeEntry_t));
/*
* Restore the command table entry.
*/
currentCmdPtr = infoPtr->currentCmdPtr;
currentCmdPtr->proc = infoPtr->savedCmdProc;
currentCmdPtr->clientData = infoPtr->savedCmdClientData;
infoPtr->currentCmdPtr = NULL;
infoPtr->savedCmdProc = NULL;
infoPtr->savedCmdClientData = NULL;
/*
* handle the entry.
*/
isProc = (TclFindProc (iPtr, argv [0]) != NULL);
Tcl_DStringInit (&commandWithNs);
Itcl_FindCommand((Tcl_Interp*)iPtr, argv [0], 0, &cmd);
/*
* Begin with command's namespace
*/
nspName = Itcl_GetNamespPath (Itcl_GetCommandNamesp(cmd));
Tcl_DStringAppend (&commandWithNs, nspName, -1);
if (strcmp (nspName, "::") != 0) {
Tcl_DStringAppend (&commandWithNs, "::", -1);
}
/*
* check if command is really an object
*/
if (Itcl_IsObject (cmd)) {
Itcl_Object *objPtr;
Itcl_Namespace osp; Itcl_Class *cls; Itcl_Object *obj;
int iSkip = 0;
Itcl_FindObject (interp, argv [0], &objPtr);
if (Itcl_GetClassContext (interp, &osp, &cls, &obj) == TCL_OK) {
#ifdef JUF_DEBUG
printf ("NS: %s CLASS:%s\n", Itcl_GetNamespPath (osp), cls -> name);
#endif
/* check if class is included in the namespace path */
if (cls -> name == objPtr -> cdefn -> name)
iSkip = 1;
}
#ifdef JUF_DEBUG
printf ("0: %s", Tcl_DStringValue (&commandWithNs));
printf (" %s %s\n", objPtr -> cdefn -> name, argv[1]);
#endif
if (!iSkip) {
Tcl_DStringAppend (&commandWithNs, objPtr -> cdefn -> name, -1);
Tcl_DStringAppend (&commandWithNs, "::", -1);
}
Tcl_DStringAppend (&commandWithNs, argv [1], -1);
} else {
/*
* Append command itself
*/
nspName = strrchr (argv[0], ':');
if (nspName == NULL) {
#ifdef JUF_DEBUG
printf ("1: %s %s\n", Tcl_DStringValue(&commandWithNs), argv[0]);
#endif
Tcl_DStringAppend (&commandWithNs, argv[0], -1);
} else {
++nspName;
#ifdef JUF_DEBUG
printf ("2: %s %s\n", Tcl_DStringValue(&commandWithNs), nspName);
#endif
Tcl_DStringAppend (&commandWithNs, nspName, -1);
}
}
#ifdef JUF_DEBUG
printf ("R: %s\n", Tcl_DStringValue(&commandWithNs));
#endif
/*
* Start the new timer
*/
JufTimerStart (infoPtr -> timeInfo);
/*
* Call the command we intercepted.
*/
result = (*currentCmdPtr->proc) (currentCmdPtr->clientData, interp,
argc, argv);
/*
* If tracing is still running, suspend timer, recording the information.
*/
if (infoPtr->traceHandle != NULL) {
JufTimerSuspend (infoPtr -> timeInfo);
RecordData (infoPtr, Tcl_DStringValue (&commandWithNs));
Tcl_DStringFree (&commandWithNs);
infoPtr -> timeInfo = timeInfo;
JufTimerCont (timeInfo);
}
/*
* Leaving profiler, must get time again when we reenter.
*/
return result;
}
/*-----------------------------------------------------------------------------
* ProfTraceRoutine --
* Routine called by Tcl_Eval to do profiling. It intercepts the current
* command being executed by temporarily editing the command table.
*-----------------------------------------------------------------------------
*/
static void
ProfTraceRoutine (clientData, interp, evalLevel, command, cmdProc,
cmdClientData, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int evalLevel;
char *command;
Tcl_CmdProc *cmdProc;
ClientData cmdClientData;
int argc;
char **argv;
{
Interp *iPtr = (Interp *) interp;
profInfo_t *infoPtr = (profInfo_t *) clientData;
Command *cmdPtr;
Tcl_Command cmd;
Itcl_FindCommand ((Tcl_Interp*)iPtr, argv [0], 0, &cmd);
cmdPtr = (Command*)cmd;
infoPtr->currentCmdPtr = cmdPtr;
infoPtr->savedCmdProc = cmdPtr->proc;
infoPtr->savedCmdClientData = cmdPtr->clientData;
cmdPtr->proc = ProfCommandEval;
cmdPtr->clientData = clientData;
}
/*-----------------------------------------------------------------------------
* CleanDataTable --
* Clean up the hash data table, releasing all resources and setting it
* to the empty state.
*
* Parameters:
* o infoPtr - The global profiling info.
*-----------------------------------------------------------------------------
*/
static void
CleanDataTable (infoPtr)
profInfo_t *infoPtr;
{
Tcl_HashEntry *hashEntryPtr;
Tcl_HashSearch searchCookie;
hashEntryPtr = Tcl_FirstHashEntry (&infoPtr->profDataTable,
&searchCookie);
while (hashEntryPtr != NULL) {
ckfree ((char *) Tcl_GetHashValue (hashEntryPtr));
Tcl_DeleteHashEntry (hashEntryPtr);
hashEntryPtr = Tcl_NextHashEntry (&searchCookie);
}
}
/*-----------------------------------------------------------------------------
* TurnOnProfiling --
* Turn on profiling.
*
* Parameters:
* o infoPtr - The global profiling info.
*-----------------------------------------------------------------------------
*/
static void
TurnOnProfiling (infoPtr)
profInfo_t *infoPtr;
{
/* create storage for time information */
infoPtr -> timeInfo = (jufTimeEntry_t *) ckalloc (sizeof (jufTimeEntry_t));
JufTimerStart (infoPtr -> timeInfo);
CleanDataTable (infoPtr);
infoPtr->traceHandle =
Tcl_CreateTrace (infoPtr->interp, INT_MAX,
(Tcl_CmdTraceProc *) ProfTraceRoutine,
(ClientData) infoPtr);
}
/*-----------------------------------------------------------------------------
* TurnOffProfiling --
* Turn off profiling. Dump the table data to an array variable. Entries
* will be deleted as they are dumped to limit memory utilization.
*
* Parameters:
* o interp - Pointer to the interprer.
* o infoPtr - The global profiling info.
* o varName - The name of the variable to save the data in.
* Returns:
* TCL_OK or TCL_ERROR.
*-----------------------------------------------------------------------------
*/
static int
TurnOffProfiling (interp, infoPtr, varName)
Tcl_Interp *interp;
profInfo_t *infoPtr;
char *varName;
{
Tcl_HashEntry *hashEntryPtr;
Tcl_HashSearch searchCookie;
profDataEntry_t *dataEntryPtr;
char *dataArgv [3], *dataListPtr;
char countBuf [32], realBuf [32], cpuBuf [32];
JufDeleteTrace (infoPtr);
dataArgv [0] = countBuf;
dataArgv [1] = realBuf;
dataArgv [2] = cpuBuf;
Tcl_UnsetVar (interp, varName, 0);
hashEntryPtr = Tcl_FirstHashEntry (&infoPtr->profDataTable,
&searchCookie);
while (hashEntryPtr != NULL) {
dataEntryPtr =
(profDataEntry_t *) Tcl_GetHashValue (hashEntryPtr);
sprintf (countBuf, "%ld", dataEntryPtr->count);
sprintf (realBuf, "%ld", dataEntryPtr->real);
sprintf (cpuBuf, "%ld", dataEntryPtr->cpu);
dataListPtr = Tcl_Merge (3, dataArgv);
if (Tcl_SetVar2 (interp, varName,
Tcl_GetHashKey (&infoPtr->profDataTable,
hashEntryPtr),
dataListPtr, TCL_LEAVE_ERR_MSG) == NULL) {
ckfree (dataListPtr);
return TCL_ERROR;
}
ckfree (dataListPtr);
ckfree ((char *) dataEntryPtr);
Tcl_DeleteHashEntry (hashEntryPtr);
hashEntryPtr = Tcl_NextHashEntry (&searchCookie);
}
return TCL_OK;
}
/*
* Juf_ProfReportCmd --
* Implements juf_prof_report command:
* juf_prof_report ?options? arrayvar
* Valid options are:
* -mincalls number only procs/meths with at least number calls
* will be reported
*/
static JUF_TCLDECL(Juf_ProfReportCmd)
{
int i, mincalls = 0;
int ratio = 0;
char *arrayVar;
int keyCount;
char **keyArray;
char *countStr;
int callCount;
profSortEntry_t *sortarr;
int len; char **list;
JUF_TCLCKMINARGS(1,"?options? arrayVar");
/* process options, if any */
for (i = 1; i < JUF_TCLARGC - 1; i++) {
if (strcmp (JUF_TCLARGV[i], "-mincalls") == 0) {
if (Tcl_GetInt (JUF_TCLIP, JUF_TCLARGV[++i], &mincalls) != TCL_OK) {
return TCL_ERROR;
}
}
else if (strcmp (JUF_TCLARGV[i], "-ratio") == 0) {
if (Tcl_GetBoolean (JUF_TCLIP, JUF_TCLARGV[++i], &ratio) != TCL_OK) {
return TCL_ERROR;
}
}
else
JUF_TCLINVOPT(JUF_TCLARGV[i]);
}
arrayVar = JUF_TCLARGV[JUF_TCLARGC - 1];
/* get hash keys and size */
if (Tcl_VarEval (JUF_TCLIP, "array names ", arrayVar,
(char *) NULL) == TCL_ERROR)
return TCL_ERROR;
/* print all keys */
if (Tcl_SplitList (JUF_TCLIP, JUF_TCLIP -> result, &keyCount,
&keyArray) != TCL_OK)
return TCL_ERROR;
/* allocate appropriate array */
sortarr = (profSortEntry_t *) ckalloc (sizeof (profSortEntry_t)
* keyCount);
i = 0;
while (*keyArray != NULL) {
countStr = Tcl_GetVar2 (JUF_TCLIP, arrayVar, *keyArray,
TCL_LEAVE_ERR_MSG);
if (Tcl_SplitList (JUF_TCLIP, countStr, &len, &list) != TCL_OK) {
ckfree (sortarr);
return TCL_ERROR;
}
if (Tcl_GetInt (JUF_TCLIP, list[0], &callCount) != TCL_OK) {
ckfree (sortarr);
return TCL_ERROR;
}
if (callCount >= mincalls) {
sortarr[i].name = *keyArray;
sortarr[i].data.count = callCount;
if (Tcl_GetInt (JUF_TCLIP, list[1], (int *) &(sortarr[i].data.real)) != TCL_OK) {
ckfree (sortarr);
return (TCL_ERROR);
}
if (Tcl_GetInt (JUF_TCLIP, list[2], (int *) &(sortarr[i].data.cpu)) != TCL_OK) {
ckfree (sortarr);
return (TCL_ERROR);
}
++i;
}
++keyArray;
}
/* sort !! */
keyCount = i;
qsort (sortarr, keyCount, sizeof (profSortEntry_t),
(int (*) (const void *, const void *)) ProfCmpSortEntries);
/* output */
for (i = 0; i < keyCount; i++) {
if (ratio) {
printf ("%s %ld %f %f\n", sortarr[i].name, sortarr[i].data.count,
(double) sortarr[i].data.real / (double) sortarr[i].data.count,
(double) sortarr[i].data.cpu / (double) sortarr[i].data.count);
} else {
printf ("%s %ld %ld %ld\n", sortarr[i].name, sortarr[i].data.count,
sortarr[i].data.real, sortarr[i].data.cpu);
}
}
ckfree (sortarr);
return TCL_OK;
}
/*-----------------------------------------------------------------------------
* Tcl_ProfileCmd --
* Implements the TCL profile command:
* profile ?-commands? ?-eval? on
* profile off arrayvar
*-----------------------------------------------------------------------------
*/
static int
Tcl_ProfileCmd (clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
profInfo_t *infoPtr = (profInfo_t *) clientData;
int argIdx = 1;
/*
* Handle the on command.
*/
if (strcmp (argv [argIdx], "on") == 0) {
if (infoPtr->traceHandle != NULL) {
Tcl_AppendResult (interp, "profiling is already enabled",
(char *) NULL);
return TCL_ERROR;
}
TurnOnProfiling (infoPtr);
return TCL_OK;
}
/*
* Handle the off command. Dump the hash table to a variable.
*/
if (strcmp (argv [argIdx], "off") == 0) {
if (infoPtr->traceHandle == NULL) {
Tcl_AppendResult (interp, "profiling is not currently enabled",
(char *) NULL);
return TCL_ERROR;
}
if (TurnOffProfiling (interp, infoPtr, argv [argIdx + 1]) != TCL_OK)
return TCL_ERROR;
return TCL_OK;
}
/*
* Not a valid subcommand.
*/
Tcl_AppendResult (interp, "expected one of \"on\" or \"off\", got \"",
argv [1], "\"", (char *) NULL);
return TCL_ERROR;
}
/*
* JufDeleteTrace - delete trace and clean up
*/
static void JufDeleteTrace (profInfo_t *infoPtr)
{
if (infoPtr -> traceHandle != NULL) {
/* delete Tcl's command trace */
Tcl_DeleteTrace (infoPtr -> interp, infoPtr -> traceHandle);
infoPtr -> traceHandle = NULL;
}
if (infoPtr -> timeInfo != NULL) {
/* release storage for time information */
ckfree ((char *) infoPtr -> timeInfo);
infoPtr -> timeInfo = NULL;
}
}
/*-----------------------------------------------------------------------------
* ProfMonCleanUp --
* Release the client data area when the interpreter is deleted.
*-----------------------------------------------------------------------------
*/
static void
ProfMonCleanUp (clientData, interp)
ClientData clientData;
Tcl_Interp *interp;
{
profInfo_t *infoPtr = (profInfo_t *) clientData;
JufDeleteTrace (infoPtr);
CleanDataTable (infoPtr);
Tcl_DeleteHashTable (&infoPtr->profDataTable);
ckfree ((char *) infoPtr);
}
/*-----------------------------------------------------------------------------
* Tcl_InitProfile --
* Initialize the Tcl profiling command.
*-----------------------------------------------------------------------------
*/
int
Jufprof_Init (interp)
Tcl_Interp *interp;
{
profInfo_t *infoPtr;
infoPtr = (profInfo_t *) ckalloc (sizeof (profInfo_t));
infoPtr->interp = interp;
infoPtr->traceHandle = NULL;
infoPtr->currentCmdPtr = NULL;
infoPtr->savedCmdProc = NULL;
infoPtr->savedCmdClientData = NULL;
infoPtr->timeInfo = NULL;
Tcl_InitHashTable (&infoPtr->profDataTable, TCL_STRING_KEYS);
Tcl_CallWhenDeleted (interp, ProfMonCleanUp, (ClientData) infoPtr);
Tcl_CreateCommand (interp, "juf_prof", Tcl_ProfileCmd,
(ClientData) infoPtr, (Tcl_CmdDeleteProc*) NULL);
Tcl_CreateCommand (interp, "juf_prof_report", Juf_ProfReportCmd,
NULL, NULL);
return TCL_OK;
}
jultaf-0.0.4/prof/tclInt.h 100644 764 144 155123 6562720567 14133 0 ustar racke users /*
* tclInt.h --
*
* Declarations of things used internally by the Tcl interpreter.
*
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1994-1996 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclInt.h 1.218 96/09/30 12:26:59
*
* ========================================================================
* >>>>>>>>>>>>>>>> INCLUDES MODIFICATIONS FOR [incr Tcl] <<<<<<<<<<<<<<<<<
*
* AUTHOR: Michael J. McLennan
* Bell Labs Innovations for Lucent Technologies
* mmclennan@lucent.com
* http://www.tcltk.com/itcl
*
* RCS: $Id: tclInt.h,v 1.4 1998/08/08 00:52:54 racke Release racke $
* ========================================================================
* Copyright (c) 1993-1996 Lucent Technologies
* ------------------------------------------------------------------------
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _TCLINT
#define _TCLINT
/*
* Common include files needed by most of the Tcl source files are
* included here, so that system-dependent personalizations for the
* include files only have to be made in once place. This results
* in a few extra includes, but greater modularity. The order of
* the three groups of #includes is important. For example, stdio.h
* is needed by tcl.h, and the _ANSI_ARGS_ declaration in tcl.h is
* needed by stdlib.h in some configurations.
*/
#include <stdio.h>
#ifndef _TCL
#include "tcl.h"
#endif
#ifndef _REGEXP
#include "tclRegexp.h"
#endif
#include <ctype.h>
#ifdef NO_LIMITS_H
# include "../compat/limits.h"
#else
# include <limits.h>
#endif
#ifdef NO_STDLIB_H
# include "../compat/stdlib.h"
#else
# include <stdlib.h>
#endif
#ifdef NO_STRING_H
#include "../compat/string.h"
#else
#include <string.h>
#endif
#if defined(__STDC__) || defined(HAS_STDARG)
# include <stdarg.h>
#else
# include <varargs.h>
#endif
/*
* ------------------------------------------------------------------------
* >>>>>>>>>>>>>>>>>>> stuff for [incr Tcl] namespaces <<<<<<<<<<<<<<<<<<<
* ------------------------------------------------------------------------
* NAMESPACES
* ========================================================================
*/
typedef struct Namespace {
char *name; /* name of this namespace */
int flags; /* status for this namespace */
int activations; /* number of activations in effect */
Tcl_Interp* interp; /* interpreter containing this namespace */
struct Namespace *parent; /* parent containing this namespace */
Tcl_HashTable children; /* list of child namespaces */
Tcl_HashTable commands; /* commands in this namespace */
Tcl_HashTable commandTable; /* cache of commands recently used */
Tcl_HashTable variables; /* variables in this namespace */
Tcl_HashTable variableTable; /* cache of variables recently used */
Itcl_List importList; /* trail for unknown references */
Itcl_List importAllList; /* complete trail for unknown references */
Itcl_List importedByList; /* list of namespaces using this one */
ClientData clientData; /* extra data for this namespace */
Itcl_DeleteProc* deleteProc; /* proc to delete clientData */
Itcl_CmdEnforcerProc* cmdEnforcer; /* proc to enforce special
command name rules */
Itcl_VarEnforcerProc* varEnforcer; /* proc to enforce special
variable name rules */
} Namespace;
/*
* Flags used to represent the status of a namespace:
*
* ITCL_NS_ALIVE - namespace is alive and well
* ITCL_NS_DYING - namespace will be destroyed when deactivated
*/
#define ITCL_NS_ALIVE 0x01
#define ITCL_NS_DYING 0x02
/*
* Mask for bits representing "global" variables:
*/
#define ITCL_GLOBAL_MASK (TCL_GLOBAL_ONLY | ITCL_GLOBAL_VAR)
/*
* NAMESPACE REFERENCE ON IMPORT LIST
*/
typedef struct NamespImportRef {
Namespace* namesp; /* namespace being imported */
int protection; /* protection level for import */
} NamespImportRef;
/*
* CACHE REFERENCE TO NAMESPACE ELEMENT
*/
typedef struct NamespCacheRef {
ClientData element; /* element being cached */
int usage; /* number of caches using this element */
} NamespCacheRef;
/*
* Procedures shared among Tcl modules but not used by the outside
* world:
*/
struct Var;
struct Proc;
struct Interp;
EXTERN struct Var* TclNewVar _ANSI_ARGS_((Tcl_Interp* interp));
EXTERN int TclInterpProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int TclCreateProc _ANSI_ARGS_((Tcl_Interp* interp,
Namespace *nsPtr, char* name, char* args, char* body,
struct Proc** procPtrPtr));
EXTERN void TclCleanupProc _ANSI_ARGS_((ClientData clientData));
EXTERN void ItclNsInterpInit _ANSI_ARGS_((struct Interp* iPtr));
EXTERN void ItclNsInterpDelete _ANSI_ARGS_((struct Interp* iPtr));
EXTERN void ItclNsClear _ANSI_ARGS_((Namespace* nsPtr));
EXTERN int ItclFollowNamespPath _ANSI_ARGS_((Tcl_Interp* interp,
Namespace* nsPtr, char* path, int flags, Namespace** rnsPtr,
char** name, int* specific));
EXTERN int ItclCanAccessNamesp _ANSI_ARGS_((Namespace *ns,
Namespace *from, int pLevel));
EXTERN int Itcl_EvalArgs _ANSI_ARGS_((Tcl_Interp* interp, char* cmdstart,
char* cmdend, int argc, char** argv));
EXTERN char* ItclEncodeImportRef _ANSI_ARGS_((NamespImportRef* nsref));
EXTERN int ItclDecodeImportRef _ANSI_ARGS_((Tcl_Interp* interp, char* str,
NamespImportRef* nsref));
EXTERN int ItclInitEnsemble _ANSI_ARGS_((Tcl_Interp* interp));
EXTERN int ItclInitNamespCmds _ANSI_ARGS_((Tcl_Interp* interp));
/*
* Command procedures in the generic core:
*/
EXTERN int Itcl_EnsembleCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_EnsOptionCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_EnsEnsembleCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_NamespaceCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_NamespTclCmdEnf _ANSI_ARGS_((Tcl_Interp *interp,
char* name, Tcl_Command* cmdPtr));
EXTERN int Itcl_NamespTclVarEnf _ANSI_ARGS_((Tcl_Interp *interp,
char* name, Tcl_Var* varPtr, int flags));
EXTERN int Itcl_VariableCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_ImportListCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_ImportAllCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_ImportAddCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_ImportRemoveCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_ProtectionCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_DelNamespCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_CodeCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_ScopeCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_AtScopeCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_DecodeScopeCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoCommandsCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoProcsCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoGlobalsCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoVarsCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoExistsCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoContextCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoProtectionCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoWhichCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoNamespAllCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoNamespQualCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoNamespTailCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoNamespParentCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoNamespChildCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
EXTERN int Itcl_InfoOtherCmd _ANSI_ARGS_((ClientData cdata,
Tcl_Interp* interp, int argc, char** argv));
/*
*----------------------------------------------------------------
* Data structures related to variables. These are used primarily
* in tclVar.c
*----------------------------------------------------------------
*/
/*
* The following structure defines a variable trace, which is used to
* invoke a specific C procedure whenever certain operations are performed
* on a variable.
*/
typedef struct VarTrace {
Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given
* by flags are performed on variable. */
ClientData clientData; /* Argument to pass to proc. */
int flags; /* What events the trace procedure is
* interested in: OR-ed combination of
* TCL_TRACE_READS, TCL_TRACE_WRITES, and
* TCL_TRACE_UNSETS. */
struct VarTrace *nextPtr; /* Next in list of traces associated with
* a particular variable. */
} VarTrace;
/*
* When a variable trace is active (i.e. its associated procedure is
* executing), one of the following structures is linked into a list
* associated with the variable's interpreter. The information in
* the structure is needed in order for Tcl to behave reasonably
* if traces are deleted while traces are active.
*/
typedef struct ActiveVarTrace {
struct Var *varPtr; /* Variable that's being traced. */
struct ActiveVarTrace *nextPtr;
/* Next in list of all active variable
* traces for the interpreter, or NULL
* if no more. */
VarTrace *nextTracePtr; /* Next trace to check after current
* trace procedure returns; if this
* trace gets deleted, must update pointer
* to avoid using free'd memory. */
} ActiveVarTrace;
/*
* The following structure describes an enumerative search in progress on
* an array variable; this are invoked with options to the "array"
* command.
*/
typedef struct ArraySearch {
int id; /* Integer id used to distinguish among
* multiple concurrent searches for the
* same array. */
struct Var *varPtr; /* Pointer to array variable that's being
* searched. */
Tcl_HashSearch search; /* Info kept by the hash module about
* progress through the array. */
Tcl_HashEntry *nextEntry; /* Non-null means this is the next element
* to be enumerated (it's leftover from
* the Tcl_FirstHashEntry call or from
* an "array anymore" command). NULL
* means must call Tcl_NextHashEntry
* to get value to return. */
struct ArraySearch *nextPtr;/* Next in list of all active searches
* for this variable, or NULL if this is
* the last one. */
} ArraySearch;
/*
* The structure below defines a variable, which associates a string name
* with a string value. Pointers to these structures are kept as the
* values of hash table entries, and the name of each variable is stored
* in the hash entry.
*/
typedef struct Var {
int valueLength; /* Holds the number of non-null bytes
* actually occupied by the variable's
* current value in value.string (extra
* space is sometimes left for expansion).
* For array and global variables this is
* meaningless. */
int valueSpace; /* Total number of bytes of space allocated
* at value.string. 0 means there is no
* space allocated. */
union {
char *string; /* String value of variable, used for scalar
* variables and array elements. Malloc-ed. */
Tcl_HashTable *tablePtr;/* For array variables, this points to
* information about the hash table used
* to implement the associative array.
* Points to malloc-ed data. */
struct Var *upvarPtr; /* If this is a global variable being
* referred to in a procedure, or a variable
* created by "upvar", this field points to
* the record for the higher-level variable. */
} value;
Tcl_HashEntry *hPtr; /* Hash table entry that refers to this
* variable, or NULL if the variable has
* been detached from its hash table (e.g.
* an array is deleted, but some of its
* elements are still referred to in upvars). */
int refCount; /* Counts number of active uses of this
* variable, not including its main hash
* table entry: 1 for each additional variable
* whose upVarPtr points here, 1 for each
* nested trace active on variable. This
* record can't be deleted until refCount
* becomes 0. */
VarTrace *tracePtr; /* First in list of all traces set for this
* variable. */
ArraySearch *searchPtr; /* First in list of all searches active
* for this variable, or NULL if none. */
int flags; /* Miscellaneous bits of information about
* variable. See below for definitions. */
/* >>>>>>>>>> stuff for [incr Tcl] namespaces <<<<<<<<<< */
char* name; /* variable name (in hash table) */
int protection; /* protection level */
Namespace* namesp; /* namespace containing this variable
* or NULL if variable is local to a
* call frame */
NamespCacheRef *cacheInfo; /* info if variable has been cached */
} Var;
/*
* Flag bits for variables:
*
* VAR_ARRAY - 1 means this is an array variable rather
* than a scalar variable.
* VAR_UPVAR - 1 means this variable just contains a
* pointer to another variable that has the
* real value. Variables like this come
* about through the "upvar" and "global"
* commands.
* VAR_UNDEFINED - 1 means that the variable is currently
* undefined. Undefined variables usually
* go away completely, but if an undefined
* variable has a trace on it, or if it is
* a global variable being used by a procedure,
* then it stays around even when undefined.
* VAR_TRACE_ACTIVE - 1 means that trace processing is currently
* underway for a read or write access, so
* new read or write accesses should not cause
* trace procedures to be called and the
* variable can't be deleted.
*/
#define VAR_ARRAY 1
#define VAR_UPVAR 2
#define VAR_UNDEFINED 4
#define VAR_TRACE_ACTIVE 0x10
/*
*----------------------------------------------------------------
* Data structures related to procedures. These are used primarily
* in tclProc.c
*----------------------------------------------------------------
*/
/*
* The structure below defines an argument to a procedure, which
* consists of a name and an (optional) default value.
*/
typedef struct Arg {
struct Arg *nextPtr; /* Next argument for this procedure,
* or NULL if this is the last argument. */
char *defValue; /* Pointer to arg's default value, or NULL
* if no default value. */
char name[4]; /* Name of argument starts here. The name
* is followed by space for the default,
* if there is one. The actual size of this
* field will be as large as necessary to
* hold both name and default value. THIS
* MUST BE THE LAST FIELD IN THE STRUCTURE!! */
} Arg;
/*
* The structure below defines a command procedure, which consists of
* a collection of Tcl commands plus information about arguments and
* variables.
*/
typedef struct Proc {
struct Interp *iPtr; /* Interpreter for which this command
* is defined. */
int refCount; /* Reference count: 1 if still present
* in command table plus 1 for each call
* to the procedure that is currently
* active. This structure can be freed
* when refCount becomes zero. */
char *command; /* Command that constitutes the body of
* the procedure (dynamically allocated). */
Arg *argPtr; /* Pointer to first of procedure's formal
* arguments, or NULL if none. */
/* >>>>>>>>>> stuff for [incr Tcl] namespaces <<<<<<<<<< */
Namespace* namesp; /* namespace containing this proc */
} Proc;
/*
* The structure below defines a command trace. This is used to allow Tcl
* clients to find out whenever a command is about to be executed.
*/
typedef struct Trace {
int level; /* Only trace commands at nesting level
* less than or equal to this. */
Tcl_CmdTraceProc *proc; /* Procedure to call to trace command. */
ClientData clientData; /* Arbitrary value to pass to proc. */
struct Trace *nextPtr; /* Next in list of traces for this interp. */
} Trace;
/*
* The structure below defines an entry in the assocData hash table which
* is associated with an interpreter. The entry contains a pointer to a
* function to call when the interpreter is deleted, and a pointer to
* a user-defined piece of data.
*/
typedef struct AssocData {
Tcl_InterpDeleteProc *proc; /* Proc to call when deleting. */
ClientData clientData; /* Value to pass to proc. */
} AssocData;
/*
* The structure below defines a frame, which is a procedure invocation.
* These structures exist only while procedures are being executed, and
* provide a sort of call stack.
*/
typedef struct CallFrame {
Tcl_HashTable varTable; /* Hash table containing all of procedure's
* local variables. */
int level; /* Level of this procedure, for "uplevel"
* purposes (i.e. corresponds to nesting of
* callerVarPtr's, not callerPtr's). 1 means
* outer-most procedure, 0 means top-level. */
int argc; /* This and argv below describe name and
* arguments for this procedure invocation. */
char **argv; /* Array of arguments. */
struct CallFrame *callerPtr;
/* Value of interp->framePtr when this
* procedure was invoked (i.e. next in
* stack of all active procedures). */
struct CallFrame *callerVarPtr;
/* Value of interp->varFramePtr when this
* procedure was invoked (i.e. determines
* variable scoping within caller; same
* as callerPtr unless an "uplevel" command
* or something equivalent was active in
* the caller). */
/* >>>>>>>>>> stuff for [incr Tcl] namespaces <<<<<<<<<< */
Namespace* activeNs; /* namespace active in this call frame */
ClientData activeData; /* client data for active namespace */
int flags; /* TCL_GLOBAL_ONLY implies that variables
* should be treated in the global namespace
* context (varTable is ignored) */
} CallFrame;
/*
* The structure below defines one history event (a previously-executed
* command that can be re-executed in whole or in part).
*/
typedef struct {
char *command; /* String containing previously-executed
* command. */
int bytesAvl; /* Total # of bytes available at *event (not
* all are necessarily in use now). */
} HistoryEvent;
/*
*----------------------------------------------------------------
* Data structures related to history. These are used primarily
* in tclHistory.c
*----------------------------------------------------------------
*/
/*
* The structure below defines a pending revision to the most recent
* history event. Changes are linked together into a list and applied
* during the next call to Tcl_RecordHistory. See the comments at the
* beginning of tclHistory.c for information on revisions.
*/
typedef struct HistoryRev {
int firstIndex; /* Index of the first byte to replace in
* current history event. */
int lastIndex; /* Index of last byte to replace in
* current history event. */
int newSize; /* Number of bytes in newBytes. */
char *newBytes; /* Replacement for the range given by
* firstIndex and lastIndex (malloced). */
struct HistoryRev *nextPtr; /* Next in chain of revisions to apply, or
* NULL for end of list. */
} HistoryRev;
/*
*----------------------------------------------------------------
* Data structures related to expressions. These are used only in
* tclExpr.c.
*----------------------------------------------------------------
*/
/*
* The data structure below defines a math function (e.g. sin or hypot)
* for use in Tcl expressions.
*/
#define MAX_MATH_ARGS 5
typedef struct MathFunc {
int numArgs; /* Number of arguments for function. */
Tcl_ValueType argTypes[MAX_MATH_ARGS];
/* Acceptable types for each argument. */
Tcl_MathProc *proc; /* Procedure that implements this function. */
ClientData clientData; /* Additional argument to pass to the function
* when invoking it. */
} MathFunc;
/*
*----------------------------------------------------------------
* One of the following structures exists for each command in
* an interpreter. The Tcl_Command opaque type actually refers
* to these structures.
*----------------------------------------------------------------
*/
typedef struct Command {
Tcl_HashEntry *hPtr; /* Pointer to the hash table entry in
* interp->commandTable that refers to
* this command. Used to get a command's
* name from its Tcl_Command handle. NULL
* means that the hash table entry has
* been removed already (this can happen
* if deleteProc causes the command to be
* deleted or recreated). */
Tcl_CmdProc *proc; /* Procedure to process command. */
ClientData clientData; /* Arbitrary value to pass to proc. */
Tcl_CmdDeleteProc *deleteProc;
/* Procedure to invoke when deleting
* command. */
ClientData deleteData; /* Arbitrary value to pass to deleteProc
* (usually the same as clientData). */
int deleted; /* Means that the command is in the process
* of being deleted (its deleteProc is
* currently executing). Any other attempts
* to delete the command should be ignored. */
/* >>>>>>>>>> stuff for [incr Tcl] namespaces <<<<<<<<<< */
int protection; /* protection level */
Namespace *namesp; /* namespace containing this command */
NamespCacheRef *cacheInfo; /* info if command has been cached */
} Command;
/*
*----------------------------------------------------------------
* This structure defines an interpreter, which is a collection of
* commands plus other state information related to interpreting
* commands, such as variable storage. Primary responsibility for
* this data structure is in tclBasic.c, but almost every Tcl
* source file uses something in here.
*----------------------------------------------------------------
*/
typedef struct Interp {
/*
* Note: the first three fields must match exactly the fields in
* a Tcl_Interp struct (see tcl.h). If you change one, be sure to
* change the other.
*/
char *result; /* Points to result returned by last
* command. */
Tcl_FreeProc *freeProc; /* Zero means result is statically allocated.
* TCL_DYNAMIC means result was allocated with
* ckalloc and should be freed with ckfree.
* Other values give address of procedure
* to invoke to free the result. Must be
* freed by Tcl_Eval before executing next
* command. */
int errorLine; /* When TCL_ERROR is returned, this gives
* the line number within the command where
* the error occurred (1 means first line). */
Tcl_HashTable commandTable; /* Contains all of the commands currently
* registered in this interpreter. Indexed
* by strings; values have type (Command *). */
Tcl_HashTable mathFuncTable;/* Contains all of the math functions currently
* defined for the interpreter. Indexed by
* strings (function names); values have
* type (MathFunc *). */
/*
* Information related to procedures and variables. See tclProc.c
* and tclvar.c for usage.
*/
Tcl_HashTable globalTable; /* Contains all global variables for
* interpreter. */
int numLevels; /* Keeps track of how many nested calls to
* Tcl_Eval are in progress for this
* interpreter. It's used to delay deletion
* of the table until all Tcl_Eval invocations
* are completed. */
int maxNestingDepth; /* If numLevels exceeds this value then Tcl
* assumes that infinite recursion has
* occurred and it generates an error. */
CallFrame *framePtr; /* Points to top-most in stack of all nested
* procedure invocations. NULL means there
* are no active procedures. */
CallFrame *varFramePtr; /* Points to the call frame whose variables
* are currently in use (same as framePtr
* unless an "uplevel" command is being
* executed). NULL means no procedure is
* active or "uplevel 0" is being exec'ed. */
ActiveVarTrace *activeTracePtr;
/* First in list of active traces for interp,
* or NULL if no active traces. */
int returnCode; /* Completion code to return if current
* procedure exits with a TCL_RETURN code. */
char *errorInfo; /* Value to store in errorInfo if returnCode
* is TCL_ERROR. Malloc'ed, may be NULL */
char *errorCode; /* Value to store in errorCode if returnCode
* is TCL_ERROR. Malloc'ed, may be NULL */
/*
* Information related to history:
*/
int numEvents; /* Number of previously-executed commands
* to retain. */
HistoryEvent *events; /* Array containing numEvents entries
* (dynamically allocated). */
int curEvent; /* Index into events of place where current
* (or most recent) command is recorded. */
int curEventNum; /* Event number associated with the slot
* given by curEvent. */
HistoryRev *revPtr; /* First in list of pending revisions. */
char *historyFirst; /* First char. of current command executed
* from history module or NULL if none. */
int revDisables; /* 0 means history revision OK; > 0 gives
* a count of number of times revision has
* been disabled. */
char *evalFirst; /* If TCL_RECORD_BOUNDS flag set, Tcl_Eval
* sets this field to point to the first
* char. of text from which the current
* command came. Otherwise Tcl_Eval sets
* this to NULL. */
char *evalLast; /* Similar to evalFirst, except points to
* last character of current command. */
/*
* Information used by Tcl_AppendResult to keep track of partial
* results. See Tcl_AppendResult code for details.
*/
char *appendResult; /* Storage space for results generated
* by Tcl_AppendResult. Malloc-ed. NULL
* means not yet allocated. */
int appendAvl; /* Total amount of space available at
* partialResult. */
int appendUsed; /* Number of non-null bytes currently
* stored at partialResult. */
/*
* A cache of compiled regular expressions. See Tcl_RegExpCompile
* in tclUtil.c for details.
*/
#define NUM_REGEXPS 5
char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled
* regular expression patterns. NULL
* means that this slot isn't used.
* Malloc-ed. */
int patLengths[NUM_REGEXPS];/* Number of non-null characters in
* corresponding entry in patterns.
* -1 means entry isn't used. */
regexp *regexps[NUM_REGEXPS];
/* Compiled forms of above strings. Also
* malloc-ed, or NULL if not in use yet. */
/*
* Information about packages. Used only in tclPkg.c.
*/
Tcl_HashTable packageTable; /* Describes all of the packages loaded
* in or available to this interpreter.
* Keys are package names, values are
* (Package *) pointers. */
char *packageUnknown; /* Command to invoke during "package
* require" commands for packages that
* aren't described in packageTable.
* Malloc'ed, may be NULL. */
/*
* Information used by Tcl_PrintDouble:
*/
char pdFormat[10]; /* Format string used by Tcl_PrintDouble. */
int pdPrec; /* Current precision (used to restore the
* the tcl_precision variable after a bogus
* value has been put into it). */
/*
* Miscellaneous information:
*/
int cmdCount; /* Total number of times a command procedure
* has been called for this interpreter. */
int noEval; /* Non-zero means no commands should actually
* be executed: just parse only. Used in
* expressions when the result is already
* determined. */
int evalFlags; /* Flags to control next call to Tcl_Eval.
* Normally zero, but may be set before
* calling Tcl_Eval. See below for valid
* values. */
char *termPtr; /* Character just after the last one in
* a command. Set by Tcl_Eval before
* returning. */
char *scriptFile; /* NULL means there is no nested source
* command active; otherwise this points to
* the name of the file being sourced (it's
* not malloc-ed: it points to an argument
* to Tcl_EvalFile. */
int flags; /* Various flag bits. See below. */
Trace *tracePtr; /* List of traces for this interpreter. */
Tcl_HashTable *assocData; /* Hash table for associating data with
* this interpreter. Cleaned up when
* this interpreter is deleted. */
char resultSpace[TCL_RESULT_SIZE+1];
/* Static space for storing small results. */
/* >>>>>>>>>> stuff for [incr Tcl] namespaces <<<<<<<<<< */
Namespace *globalNs; /* global namespace for this interp */
Itcl_ActiveNamespace gNsToken; /* token for global namesp activation */
Namespace *activeNs; /* namespace that is currently active */
ClientData activeData; /* extra data for active namesp */
Itcl_Stack nsStack; /* stack of active namespaces */
Itcl_Stack nsDataStack; /* stack of clientData for namespaces */
int cmdProtection; /* protection level for new commands */
int varProtection; /* protection level for new variables */
/* >>> --------------------------------------------- <<< */
} Interp;
/*
* EvalFlag bits for Interp structures:
*
* TCL_BRACKET_TERM 1 means that the current script is terminated by
* a close bracket rather than the end of the string.
* TCL_RECORD_BOUNDS Tells Tcl_Eval to record information in the
* evalFirst and evalLast fields for each command
* executed directly from the string (top-level
* commands and those from command substitution).
* TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with
* a code other than TCL_OK or TCL_ERROR; 0 means
* codes other than these should be turned into errors.
*/
#define TCL_BRACKET_TERM 1
#define TCL_RECORD_BOUNDS 2
#define TCL_ALLOW_EXCEPTIONS 4
/*
* Flag bits for Interp structures:
*
* DELETED: Non-zero means the interpreter has been deleted:
* don't process any more commands for it, and destroy
* the structure as soon as all nested invocations of
* Tcl_Eval are done.
* ERR_IN_PROGRESS: Non-zero means an error unwind is already in progress.
* Zero means a command proc has been invoked since last
* error occured.
* ERR_ALREADY_LOGGED: Non-zero means information has already been logged
* in $errorInfo for the current Tcl_Eval instance,
* so Tcl_Eval needn't log it (used to implement the
* "error message log" command).
* ERROR_CODE_SET: Non-zero means that Tcl_SetErrorCode has been
* called to record information for the current
* error. Zero means Tcl_Eval must clear the
* errorCode variable if an error is returned.
* EXPR_INITIALIZED: 1 means initialization specific to expressions has
* been carried out.
*/
#define DELETED 1
#define ERR_IN_PROGRESS 2
#define ERR_ALREADY_LOGGED 4
#define ERROR_CODE_SET 8
#define EXPR_INITIALIZED 0x10
/*
* Default value for the pdPrec and pdFormat fields of interpreters:
*/
#define DEFAULT_PD_PREC 6
#define DEFAULT_PD_FORMAT "%g"
/*
*----------------------------------------------------------------
* Data structures related to command parsing. These are used in
* tclParse.c and its clients.
*----------------------------------------------------------------
*/
/*
* The following data structure is used by various parsing procedures
* to hold information about where to store the results of parsing
* (e.g. the substituted contents of a quoted argument, or the result
* of a nested command). At any given time, the space available
* for output is fixed, but a procedure may be called to expand the
* space available if the current space runs out.
*/
typedef struct ParseValue {
char *buffer; /* Address of first character in
* output buffer. */
char *next; /* Place to store next character in
* output buffer. */
char *end; /* Address of the last usable character
* in the buffer. */
void (*expandProc) _ANSI_ARGS_((struct ParseValue *pvPtr, int needed));
/* Procedure to call when space runs out;
* it will make more space. */
ClientData clientData; /* Arbitrary information for use of
* expandProc. */
} ParseValue;
/*
* A table used to classify input characters to assist in parsing
* Tcl commands. The table should be indexed with a signed character
* using the CHAR_TYPE macro. The character may have a negative
* value.
*/
extern char tclTypeTable[];
#define CHAR_TYPE(c) (tclTypeTable+128)[c]
/*
* Possible values returned by CHAR_TYPE:
*
* TCL_NORMAL - All characters that don't have special significance
* to the Tcl language.
* TCL_SPACE - Character is space, tab, or return.
* TCL_COMMAND_END - Character is newline or null or semicolon or
* close-bracket.
* TCL_QUOTE - Character is a double-quote.
* TCL_OPEN_BRACKET - Character is a "[".
* TCL_OPEN_BRACE - Character is a "{".
* TCL_CLOSE_BRACE - Character is a "}".
* TCL_BACKSLASH - Character is a "\".
* TCL_DOLLAR - Character is a "$".
*/
#define TCL_NORMAL 0
#define TCL_SPACE 1
#define TCL_COMMAND_END 2
#define TCL_QUOTE 3
#define TCL_OPEN_BRACKET 4
#define TCL_OPEN_BRACE 5
#define TCL_CLOSE_BRACE 6
#define TCL_BACKSLASH 7
#define TCL_DOLLAR 8
/*
* Maximum number of levels of nesting permitted in Tcl commands (used
* to catch infinite recursion).
*/
#define MAX_NESTING_DEPTH 1000
/*
* The macro below is used to modify a "char" value (e.g. by casting
* it to an unsigned character) so that it can be used safely with
* macros such as isspace.
*/
#define UCHAR(c) ((unsigned char) (c))
/*
* Given a size or address, the macro below "aligns" it to the machine's
* memory unit size (e.g. an 8-byte boundary) so that anything can be
* placed at the aligned address without fear of an alignment error.
*/
#define TCL_ALIGN(x) ((x + 7) & ~7)
/*
* For each event source (created with Tcl_CreateEventSource) there
* is a structure of the following type:
*/
typedef struct TclEventSource {
Tcl_EventSetupProc *setupProc; /* This procedure is called by
* Tcl_DoOneEvent to set up information
* for the wait operation, such as
* files to wait for or maximum
* timeout. */
Tcl_EventCheckProc *checkProc; /* This procedure is called by
* Tcl_DoOneEvent after its wait
* operation to see what events
* are ready and queue them. */
ClientData clientData; /* Arbitrary one-word argument to pass
* to setupProc and checkProc. */
struct TclEventSource *nextPtr; /* Next in list of all event sources
* defined for applicaton. */
} TclEventSource;
/*
* The following macros are used to specify the runtime platform
* setting of the tclPlatform variable.
*/
typedef enum {
TCL_PLATFORM_UNIX, /* Any Unix-like OS. */
TCL_PLATFORM_MAC, /* MacOS. */
TCL_PLATFORM_WINDOWS /* Any Microsoft Windows OS. */
} TclPlatformType;
/*
*----------------------------------------------------------------
* Variables shared among Tcl modules but not used by the outside
* world:
*----------------------------------------------------------------
*/
extern Tcl_Time tclBlockTime;
extern int tclBlockTimeSet;
extern char * tclExecutableName;
extern TclEventSource * tclFirstEventSourcePtr;
extern Tcl_ChannelType tclFileChannelType;
extern char * tclMemDumpFileName;
extern TclPlatformType tclPlatform;
/*
*----------------------------------------------------------------
* Procedures shared among Tcl modules but not used by the outside
* world:
*----------------------------------------------------------------
*/
EXTERN void panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
EXTERN int TclChdir _ANSI_ARGS_((Tcl_Interp *interp,
char *dirName));
EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp *interp,
int numPids, int *pidPtr, Tcl_Channel errorChan));
EXTERN int TclCloseFile _ANSI_ARGS_((Tcl_File file));
EXTERN char * TclConvertToNative _ANSI_ARGS_((Tcl_Interp *interp,
char *name, Tcl_DString *bufferPtr));
EXTERN char * TclConvertToNetwork _ANSI_ARGS_((Tcl_Interp *interp,
char *name, Tcl_DString *bufferPtr));
EXTERN void TclCopyAndCollapse _ANSI_ARGS_((int count, char *src,
char *dst));
EXTERN void TclClosePipeFile _ANSI_ARGS_((Tcl_File file));
EXTERN Tcl_Channel TclCreateCommandChannel _ANSI_ARGS_((
Tcl_File readFile, Tcl_File writeFile,
Tcl_File errorFile, int numPids, int *pidPtr));
EXTERN int TclCreatePipe _ANSI_ARGS_((Tcl_File *readPipe,
Tcl_File *writePipe));
EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp *interp,
int argc, char **argv, int **pidArrayPtr,
Tcl_File *inPipePtr,
Tcl_File *outPipePtr,
Tcl_File *errFilePtr));
EXTERN Tcl_File TclCreateTempFile _ANSI_ARGS_((char *contents,
Tcl_DString *namePtr));
EXTERN void TclDeleteVars _ANSI_ARGS_((Interp *iPtr,
Tcl_HashTable *tablePtr));
EXTERN int TclDoGlob _ANSI_ARGS_((Tcl_Interp *interp,
char *separators, Tcl_DString *headPtr,
char *tail));
EXTERN Var * TclNewVar _ANSI_ARGS_((Tcl_Interp* interp));
EXTERN void TclExpandParseValue _ANSI_ARGS_((ParseValue *pvPtr,
int needed));
EXTERN void TclExprFloatError _ANSI_ARGS_((Tcl_Interp *interp,
double value));
EXTERN int TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp *interp,
int argc, char **argv)) ;
EXTERN int TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
int argc, char ** argv));
EXTERN int TclFindElement _ANSI_ARGS_((Tcl_Interp *interp,
char *list, char **elementPtr, char **nextPtr,
int *sizePtr, int *bracePtr));
EXTERN Tcl_Channel TclFindFileChannel _ANSI_ARGS_((Tcl_File inFile,
Tcl_File outFile, int *fileUsedPtr));
EXTERN Proc * TclFindProc _ANSI_ARGS_((Interp *iPtr,
char *procName));
EXTERN void TclFreePackageInfo _ANSI_ARGS_((Interp *iPtr));
EXTERN char * TclGetCwd _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN char * TclGetExtension _ANSI_ARGS_((char *name));
EXTERN void TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Channel chan));
EXTERN int TclGetDate _ANSI_ARGS_((char *p,
unsigned long now, long zone,
unsigned long *timePtr));
EXTERN Tcl_Channel TclGetDefaultStdChannel _ANSI_ARGS_((int type));
EXTERN char * TclGetEnv _ANSI_ARGS_((char *name));
EXTERN int TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
char *string, CallFrame **framePtrPtr));
EXTERN int TclGetListIndex _ANSI_ARGS_((Tcl_Interp *interp,
char *string, int *indexPtr));
EXTERN int TclGetLoadedPackages _ANSI_ARGS_((Tcl_Interp *interp,
char *targetName));
EXTERN int TclGetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
char *string, int *seekFlagPtr));
EXTERN char * TclGetUserHome _ANSI_ARGS_((char *name,
Tcl_DString *bufferPtr));
EXTERN int TclGuessPackageName _ANSI_ARGS_((char *fileName,
Tcl_DString *bufPtr));
EXTERN int TclHasPipes _ANSI_ARGS_((void));
EXTERN int TclHasSockets _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int TclIdlePending _ANSI_ARGS_((void));
EXTERN int TclInterpInit _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN Proc * TclIsProc _ANSI_ARGS_((Command *cmdPtr));
EXTERN int TclLoadFile _ANSI_ARGS_((Tcl_Interp *interp,
char *fileName, char *sym1, char *sym2,
Tcl_PackageInitProc **proc1Ptr,
Tcl_PackageInitProc **proc2Ptr));
EXTERN int TclMakeFileTable _ANSI_ARGS_((Tcl_Interp *interp,
int noStdio));
EXTERN int TclMatchFiles _ANSI_ARGS_((Tcl_Interp *interp,
char *separators, Tcl_DString *dirPtr,
char *pattern, char *tail));
EXTERN int TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp *interp,
int argc, char **argv)) ;
EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp *interp,
int argc, char **argv)) ;
EXTERN int TclNeedSpace _ANSI_ARGS_((char *start, char *end));
EXTERN Tcl_File TclOpenFile _ANSI_ARGS_((char *fname, int mode));
EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size));
EXTERN int TclpCopyFile _ANSI_ARGS_((char *source, char *dest));
EXTERN int TclpCopyDirectory _ANSI_ARGS_((char *source,
char *dest, Tcl_DString *errorPtr));
EXTERN int TclpCreateDirectory _ANSI_ARGS_((char *path));
EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp,
int argc, char **argv, Tcl_File inputFile,
Tcl_File outputFile, Tcl_File errorFile,
char *inputFileName, char *outputFileName,
char *errorFileName, int *pidPtr));
EXTERN int TclpDeleteFile _ANSI_ARGS_((char *path));
EXTERN void TclpFree _ANSI_ARGS_((char *ptr));
EXTERN unsigned long TclpGetClicks _ANSI_ARGS_((void));
EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void));
EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time *time));
EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time));
EXTERN char * TclpGetTZName _ANSI_ARGS_((void));
EXTERN char * TclpRealloc _ANSI_ARGS_((char *ptr,
unsigned int size));
EXTERN int TclpRemoveDirectory _ANSI_ARGS_((char *path,
int recursive, Tcl_DString *errorPtr));
EXTERN int TclpRenameFile _ANSI_ARGS_((char *source, char *dest));
EXTERN int TclParseBraces _ANSI_ARGS_((Tcl_Interp *interp,
char *string, char **termPtr, ParseValue *pvPtr));
EXTERN int TclParseNestedCmd _ANSI_ARGS_((Tcl_Interp *interp,
char *string, int flags, char **termPtr,
ParseValue *pvPtr));
EXTERN int TclParseQuotes _ANSI_ARGS_((Tcl_Interp *interp,
char *string, int termChar, int flags,
char **termPtr, ParseValue *pvPtr));
EXTERN int TclParseWords _ANSI_ARGS_((Tcl_Interp *interp,
char *string, int flags, int maxWords,
char **termPtr, int *argcPtr, char **argv,
ParseValue *pvPtr));
EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp,
int argc, char **argv, Tcl_File inputFile,
Tcl_File outputFile, Tcl_File errorFile,
char *inputFileName, char *outputFileName,
char *errorFileName, int *pidPtr));
EXTERN void TclPlatformExit _ANSI_ARGS_((int status));
EXTERN void TclPlatformInit _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *name1, char *name2,
int flags));
EXTERN int TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Interp *cmdInterp, char *cmdName,
Tcl_CmdProc *proc, ClientData clientData));
EXTERN int TclReadFile _ANSI_ARGS_((Tcl_File file,
int shouldBlock, char *buf, int toRead));
EXTERN int TclSeekFile _ANSI_ARGS_((Tcl_File file,
int offset, int whence));
EXTERN int TclServiceIdle _ANSI_ARGS_((void));
EXTERN void TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int TclSockGetPort _ANSI_ARGS_((Tcl_Interp *interp,
char *string, char *proto, int *portPtr));
EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock,
int size));
EXTERN int TclSpawnPipeline _ANSI_ARGS_((Tcl_Interp *interp,
int *pidPtr, int *numPids, int argc, char **argv,
Tcl_File inputFile,
Tcl_File outputFile,
Tcl_File errorFile,
char *intIn, char *finalOut));
EXTERN int TclTestChannelCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int TclTestChannelEventCmd _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp,
int argc, char **argv));
EXTERN int TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr));
EXTERN int TclWaitForFile _ANSI_ARGS_((Tcl_File file,
int mask, int timeout));
EXTERN char * TclWordEnd _ANSI_ARGS_((char *start, int nested,
int *semiPtr));
EXTERN int TclWriteFile _ANSI_ARGS_((Tcl_File file,
int shouldBlock, char *buf, int toWrite));
/*
*----------------------------------------------------------------
* Command procedures in the generic core:
*----------------------------------------------------------------
*/
EXTERN int Tcl_AfterCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_AppendCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ArrayCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_BreakCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_CaseCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_CatchCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_CdCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ClockCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_CloseCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ConcatCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ContinueCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_EofCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ErrorCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_EvalCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ExecCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ExitCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ExprCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_FblockedCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_FconfigureCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_FileCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_FileEventCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_FlushCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ForCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ForeachCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_FormatCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_GetsCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_GlobalCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_GlobCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_HistoryCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_IfCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_IncrCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_InfoCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_InterpCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_JoinCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_LappendCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_LindexCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_LinsertCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_LlengthCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ListCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_LoadCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_LrangeCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_LreplaceCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_LsearchCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_LsortCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_OpenCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_PackageCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_PidCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ProcCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_PutsCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_PwdCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ReadCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_RegexpCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_RegsubCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_RenameCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ReturnCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ScanCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_SeekCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_SetCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_SplitCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_SocketCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_SourceCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_StringCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_SubstCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_SwitchCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_TellCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_TimeCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_TraceCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_UnsetCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_UpdateCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_UplevelCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_UpvarCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_VwaitCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_WhileCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int TclUnsupported0Cmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
/*
*----------------------------------------------------------------
* Command procedures found only in the Mac version of the core:
*----------------------------------------------------------------
*/
#ifdef MAC_TCL
EXTERN int Tcl_CpCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_LsCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_MacBeepCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_MacSourceCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_MkdirCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_MvCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_ResourceCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_RmCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
EXTERN int Tcl_RmdirCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
#endif
#endif /* _TCLINT */
jultaf-0.0.4/prof/tclRegexp.h 100644 764 144 2016 6423650377 14560 0 ustar racke users /*
* Definitions etc. for regexp(3) routines.
*
* Caveat: this is V8 regexp(3) [actually, a reimplementation thereof],
* not the System V one.
*
* SCCS: @(#) tclRegexp.h 1.6 96/04/02 18:43:57
*/
#ifndef _REGEXP
#define _REGEXP 1
#ifndef _TCL
#include "tcl.h"
#endif
/*
* NSUBEXP must be at least 10, and no greater than 117 or the parser
* will not work properly.
*/
#define NSUBEXP 20
typedef struct regexp {
char *startp[NSUBEXP];
char *endp[NSUBEXP];
char regstart; /* Internal use only. */
char reganch; /* Internal use only. */
char *regmust; /* Internal use only. */
int regmlen; /* Internal use only. */
char program[1]; /* Unwarranted chumminess with compiler. */
} regexp;
EXTERN regexp *TclRegComp _ANSI_ARGS_((char *exp));
EXTERN int TclRegExec _ANSI_ARGS_((regexp *prog, char *string, char *start));
EXTERN void TclRegSub _ANSI_ARGS_((regexp *prog, char *source, char *dest));
EXTERN void TclRegError _ANSI_ARGS_((char *msg));
EXTERN char *TclGetRegError _ANSI_ARGS_((void));
#endif /* REGEXP */
jultaf-0.0.4/sgml/ 40755 764 144 0 6573436401 12346 5 ustar racke users jultaf-0.0.4/sgml/index.tcl 100644 764 144 3514 6573431225 14260 0 ustar racke users # This is a -*- Tcl -*- script.
#
# index.tcl --- Jultaf Project Documentation
#
# Copyright (C) 1998 Stefan Hornburg
#
# Author: Stefan Hornburg <racke@gundel.han.de>
# Maintainer: Stefan Hornburg <racke@gundel.han.de>
# Version: 0.0.3
#
# This file 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, or (at your option) any
# later version.
#
# This file 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 file; see the file COPYING. If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
manual "Jultaf"
author "Stefan Hornburg" -email racke@gundel.han.de
stamp "Thu Sep 3 08:08:20 1998 MET DST"
keywords Tcl GDBM Postgres RPM
text "Jultaf is a collection of Tcl and \[incr Tcl] scripts and
provides procedures resp. classes with various purposes. Additionally
shared libraries for accessing GDBM and
[url http://www.postgresql.org Postgres] databases from Tcl can be
build with this package."
h2 "License"
text "Jultaf is distributed under the terms of the
[htmlurl http://www.gnu.org/copyleft/gpl.html GPL]. Please contact me if
this keeps you from using Jultaf."
h2 "System Requirements"
ul {
li "At least Tcl 8.0 or above. \[incr Tcl] 3.0a1 or above if you want to
use the class library."
}
h2 "Distribution"
ul {
li [htmlurl jultaf-0.0.4.tar.gz "Latest release (0.0.4)"]
# li [htmlurl jultaf-0.0.4pre.tar.gz "Current development snapshot"]
}
h2 "Documentation"
ul {
li [link jultaf "User Manual"]
li [link news "News"]
}
jultaf-0.0.4/sgml/jultaf.sgml 100644 764 144 76227 6573367646 14670 0 ustar racke users <!-- This is a -*- SGML -*- file.
jultaf.sgml: SGML source file for `Jumble Library for Tcl and Friends'
Copyright (C) 1996, 1997, 1998 Stefan Hornburg
Author: Stefan Hornburg <racke@gundel.han.de>
Maintainer: Stefan Hornburg <racke@gundel.han.de>
This file 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, or (at your option) any
later version.
This file 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 file; see the file COPYING. If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-->
<!DOCTYPE manual PUBLIC "-//Witware//DTD InfoPrism//EN">
<PREAMBLE>
<CATEGORY>Tcl and Friends<NAME>Jultaf
<TOPIC>The Jumble Library for Tcl and Friends
<MAKEINDEX NAME=cp>
<MAKEINDEX NAME=fn>
<MAKEINDEX NAME=vr>
<MAKEINDEX NAME=pkg>
</PREAMBLE>
<TITLE>Jumble Library for Tcl and Friends</TITLE>
<AUTHOR EMAIL="racke@gundel.han.de">Stefan Hornburg</AUTHOR>
<STAMP YEAR=1998 MO
