Filewatcher File Search
FTP Search
  
Directory (beta)
  
Content Search (beta)
   
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 5ustar  rackeusersjultaf-0.0.4/apps/ 40755    764    144           0  6573436402  12350 5ustar  rackeusersjultaf-0.0.4/apps/Makefile.in100644    764    144       12134  6556242132  14527 0ustar  rackeusers#
# 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.tcl100644    764    144       22720  6573434541  14646 0ustar  rackeusers#! @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.tcl100644    764    144        2432  6433664071  14625 0ustar  rackeusers#! @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 5ustar  rackeusersjultaf-0.0.4/html/exp.gif100644    764    144         223  6426144261  13702 0ustar  rackeusersGIF89a!,d17`*)Myhtm(J>.k(S-hps&Gd2Y4}s.#64xٝp\	_uExizFhP;jultaf-0.0.4/html/index.html100644    764    144        2366  6573431447  14456 0ustar  rackeusers<!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">&lt;racke@gundel.han.de&gt;</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.html100644    764    144       73256  6573403073  14654 0ustar  rackeusers<!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&amp;r;rab&amp;{\;} 
{} {} 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">&lt;racke@gundel.han.de&gt;</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.gif100644    764    144         166  6426134605  13706 0ustar  rackeusersGIF89a !,Gj\(țk&ieלZJvʮB8[]H\@TᅖXHA
;jultaf-0.0.4/html/news.html100644    764    144        6110  6573436133  14307 0ustar  rackeusers<!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">&lt;racke@gundel.han.de&gt;</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 5ustar  rackeusersjultaf-0.0.4/itcl/channel.itcl100644    764    144        6324  6556242602  14725 0ustar  rackeusers# 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.itcl100644    764    144       43750  6556242655  14276 0ustar  rackeusers# 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.itcl100644    764    144        2547  6544443117  14251 0ustar  rackeusers# 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.itcl100644    764    144       15412  6544443303  14251 0ustar  rackeusers# 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.itcl100644    764    144        6564  6556242714  15663 0ustar  rackeusers# 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.itcl100644    764    144        3541  6556243121  14616 0ustar  rackeusers# 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.itcl100644    764    144       10051  6544443505  14474 0ustar  rackeusers# 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 5ustar  rackeusersjultaf-0.0.4/gdbm/Makefile.in100644    764    144       14227  6441356411  14501 0ustar  rackeusers# 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
# ---------