Index: trunk/base/Makefile
===================================================================
--- trunk/base/Makefile	(revision 214)
+++ trunk/base/Makefile	(revision 214)
@@ -0,0 +1,2 @@
+SUBDIR= src
+.include <bsd.subdir.mk>
Index: trunk/base/src/Makefile
===================================================================
--- trunk/base/src/Makefile	(revision 214)
+++ trunk/base/src/Makefile	(revision 214)
@@ -0,0 +1,4 @@
+TCLPKG=		darwinports1.0 port1.0 pextlib1.0
+SUBDIR=		${TCLPKG} portbuild
+
+.include <bsd.subdir.mk>
Index: trunk/base/src/darwinports1.0/Makefile
===================================================================
--- trunk/base/src/darwinports1.0/Makefile	(revision 214)
+++ trunk/base/src/darwinports1.0/Makefile	(revision 214)
@@ -0,0 +1,10 @@
+all:
+
+clean:
+	rm -f pkgIndex.tcl
+
+install:
+	mkdir -p /System/Library/Tcl/8.3/darwinports1.0
+	${.CURDIR}/../pkg_mkindex.tcl ${.CURDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} darwinports.tcl /System/Library/Tcl/8.3/darwinports1.0
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} pkgIndex.tcl /System/Library/Tcl/8.3/darwinports1.0
Index: trunk/base/src/darwinports1.0/darwinports.tcl
===================================================================
--- trunk/base/src/darwinports1.0/darwinports.tcl	(revision 214)
+++ trunk/base/src/darwinports1.0/darwinports.tcl	(revision 214)
@@ -0,0 +1,76 @@
+#!/usr/bin/tclsh
+# /etc/ports.conf options
+package provide darwinports 1.0
+
+global ports_opts
+global bootstrap_options
+set bootstrap_options "sysportpath libpath auto_path"
+set portinterp_options "sysportpath portpath auto_path portconf"
+set uniqid 0
+
+proc init {args} {
+    global auto_path env bootstrap_options sysportpath portconf
+
+    if [file isfile /etc/ports.conf] {
+	set portconf /etc/ports.conf
+	set fd [open /etc/ports.conf r]
+	while {[gets $fd line] >= 0} {
+	    foreach option $bootstrap_options {
+		if {[regexp "^$option\[ \t\]+(\[A-Za-z0-9/\]+$)" $line match val] == 1} {
+		    set $option $val
+		}
+	    }
+	}
+    }
+
+    # Prefer the PORTPATH environment variable
+    if {[llength [array names env PORTPATH]] > 0} {
+	set sysportpath [lindex [array get env PORTPATH] 1]
+    }
+
+    if ![info exists sysportpath] {
+	return -code error "sysportpath must be set in /etc/ports.conf or in the PORTPATH env variable"
+    }
+	
+    if ![info exists libpath] {
+	set libpath /usr/local/share/darwinports/Tcl
+    }
+
+    if [file isdirectory $libpath] {
+	lappend auto_path $libpath
+    } else {
+	return -code error "Library directory '$libpath' must exist"
+    }
+}
+
+proc build {portdir chain target {options ""}} {
+    global targets portpath portinterp_options uniqid
+
+    if [file isdirectory $portdir] {
+	cd $portdir
+	set portpath [pwd]
+	set workername workername[incr uniqid]
+	interp create $workername
+	$workername alias build build
+
+	foreach opt $portinterp_options {
+		upvar #0 $opt upopt
+		if [info exists upopt] {
+			$workername eval set system_options($opt) \"$upopt\"
+			$workername eval set $opt \"$upopt\"
+		}
+	}
+
+	foreach opt $options {
+		if {[regexp {([A-Za-z0-9_\.]+)=(.+)} $opt match key val] == 1} {
+			$workername eval set user_options($key) \"$val\"
+			$workername eval set $key \"$val\"
+		}
+	}
+	$workername eval source Portfile
+	$workername eval {flock [open Portfile r] -exclusive}
+	$workername eval eval_targets targets $chain $target
+    } else {
+	return -code error "Portdir $portpath does not exist"
+    }
+}
Index: trunk/base/src/pextlib1.0/Makefile
===================================================================
--- trunk/base/src/pextlib1.0/Makefile	(revision 214)
+++ trunk/base/src/pextlib1.0/Makefile	(revision 214)
@@ -0,0 +1,17 @@
+SRCS=		Pextlib.c strsed.c
+LIB=		Pextlib
+SHLIB_NAME=	Pextlib.dylib
+NOPROFILE=	TRUE
+LDADD+=		-ltcl
+INSTALLDIR= /usr/local/share/darwinports/Tcl/pextlib1.0
+
+install:
+	mkdir -p ${INSTALLDIR}
+	${.CURDIR}/../pkg_mkindex.tcl ${.CURDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} ${SHLIB_NAME} ${INSTALLDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} pkgIndex.tcl  ${INSTALLDIR}
+
+afterclean:
+	rm -f pkgIndex.tcl
+
+.include <bsd.lib.mk>
Index: trunk/base/src/pextlib1.0/Pextlib.c
===================================================================
--- trunk/base/src/pextlib1.0/Pextlib.c	(revision 214)
+++ trunk/base/src/pextlib1.0/Pextlib.c	(revision 214)
@@ -0,0 +1,259 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <string.h>
+#include <dirent.h>
+#include <sys/file.h>
+#include <sys/types.h>
+#include <sys/wait.h>
+#include <tcl.h>
+#include <unistd.h>
+
+#define BUFSIZ 1024
+
+static int ui_info(Tcl_Interp *interp, char *mesg) {
+	const char ui_proc[] = "ui_info {";
+	char *script, *p;
+	int scriptlen, ret;
+
+	scriptlen = sizeof(ui_proc) + strlen(mesg);
+	script = malloc(scriptlen);
+	if (script == NULL)
+		return TCL_ERROR;
+	else
+		p = script;
+
+	memcpy(script, ui_proc, sizeof(ui_proc));
+	strcat(script, mesg);
+	p += scriptlen - 2;
+	*p = '}';
+	return (Tcl_EvalEx(interp, script, scriptlen - 1, 0));
+}
+
+int SystemCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	char buf[BUFSIZ];
+	char *args[4];
+	char *cmdstring, *p;
+	FILE *pdes;
+	int fdset[2];
+	int i, cmdlen, cmdlenavail, ret;
+	pid_t pid;
+	cmdlen = cmdlenavail = BUFSIZ;
+	p = cmdstring = NULL;
+
+	if(Tcl_PkgRequire(interp, "portui", "1.0", 0) == NULL) {
+		return TCL_ERROR;
+	}
+
+	if (objc < 2) {
+		Tcl_WrongNumArgs(interp, 1, objv, "command");
+		return TCL_ERROR;
+	} else if (objc == 2) {
+		cmdstring = Tcl_GetString(objv[1]);
+	} else if (objc > 2) {
+		cmdstring = malloc(cmdlen);
+		if (cmdstring == NULL)
+			return TCL_ERROR;
+		p = cmdstring;
+		/*
+		 * Rather than realloc for every iteration
+		 * through the argument vector, malloc a
+		 * sizable chunk of memory first.
+		 * If we extend beyond what is available,
+		 * then realloc
+		 */
+		for (i = 1; i < objc; i++) {
+			char *arg;
+			int len;
+
+			arg = Tcl_GetString(objv[i]);
+			/* Add 1 for trailing \0 or ' ' */
+			len = strlen(arg) + 1;
+
+			if (len > cmdlenavail) {
+				char *sptr;
+				cmdlen += cmdlenavail + len;
+				/*
+				 * puma does not have reallocf.
+				 * Change when we rev past puma
+				 */
+				sptr = cmdstring;
+				cmdstring = realloc(cmdstring, cmdlen);
+				if (cmdstring == NULL) {
+					free(sptr);
+					return TCL_ERROR;
+				}
+			}
+			/* Subtract 1 to not copy trailing \0 */
+			memcpy(p, arg, len - 1);
+			p += len;
+
+			if (i == objc - 1) {
+				*(p - 1) = '\0';
+			} else {
+				*(p - 1) = ' ';
+			}
+			cmdlenavail -= len;
+			cmdlen += len;
+		}
+	}
+
+	if (pipe(fdset) == -1)
+		return TCL_ERROR;
+
+	/*
+	 * Fork a child to run the command, in a popen() like fashion -
+	 * popen() itself is not used because stderr is also desired.
+	 */
+	pid = fork();
+	if (pid == -1)
+		return TCL_ERROR;
+	if (pid == 0) {
+		close(fdset[0]);
+		dup2(fdset[1], STDOUT_FILENO);
+		dup2(fdset[1], STDERR_FILENO);
+		/* XXX ugly string constants */
+		args[0] = "sh";
+		args[1] = "-c";
+		args[2] = cmdstring;
+		args[3] = NULL;
+		execve("/bin/sh", args, NULL);
+	}
+	close(fdset[1]);
+	pdes = fdopen(fdset[0], "r");
+	if (p != NULL)
+		free(cmdstring);
+
+	/* read from simulated popen() pipe */
+	while (fgets(buf, BUFSIZ, pdes) != NULL) {
+		int ret = ui_info(interp, buf);
+		if (ret != TCL_OK)
+			return ret;
+		Tcl_AppendResult(interp, buf, NULL);
+	}
+	fclose(pdes);
+	wait(&ret);
+	if (ret == 0)
+		return TCL_OK;
+	else
+		return TCL_ERROR;
+}
+
+int FlockCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	static const char errorstr[] = "use one of \"-shared\", \"-exclusive\", or \"-unlock\"";
+	int operation = 0, fd, i;
+	Tcl_Channel channel;
+	ClientData handle;
+
+	if (objc < 3 || objc > 4) {
+		Tcl_WrongNumArgs(interp, 1, objv, "channelId switches");
+		return TCL_ERROR;
+	}
+
+    	if ((channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL)) == NULL)
+		return TCL_ERROR;
+
+	if (Tcl_GetChannelHandle(channel, TCL_READABLE|TCL_WRITABLE, &handle) != TCL_OK) {
+		Tcl_SetResult(interp, "error getting channel handle", TCL_STATIC);
+		return TCL_ERROR;
+	}
+	fd = (int) handle;
+
+	for (i = 2; i < objc; i++) {
+		char *arg = Tcl_GetString(objv[i]);
+		if (!strcmp(arg, "-shared")) {
+			if (operation & LOCK_EX || operation & LOCK_UN) {
+				Tcl_SetResult(interp, (void *) &errorstr, TCL_STATIC);
+				return TCL_ERROR;
+			}
+			operation |= LOCK_SH;
+		} else if (!strcmp(arg, "-exclusive")) {
+			if (operation & LOCK_SH || operation & LOCK_UN) {
+				Tcl_SetResult(interp, (void *) &errorstr, TCL_STATIC);
+				return TCL_ERROR;
+			}
+			operation |= LOCK_EX;
+		} else if (!strcmp(arg, "-unlock")) {
+			if (operation & LOCK_SH || operation & LOCK_EX) {
+				Tcl_SetResult(interp, (void *) &errorstr, TCL_STATIC);
+				return TCL_ERROR;
+			}
+			operation |= LOCK_UN;
+		} else if (!strcmp(arg, "-noblock")) {
+			if (operation & LOCK_UN) {
+				Tcl_SetResult(interp, "-noblock can not be used with -unlock", TCL_STATIC);
+				return TCL_ERROR;
+			}
+			operation |= LOCK_NB;
+		}
+	}
+	if (flock(fd, operation) != 0)
+	{
+		Tcl_SetResult(interp, (void *) strerror(errno), TCL_STATIC);
+		return TCL_ERROR;
+	}
+	return TCL_OK;
+}
+
+int ReaddirCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	DIR *dirp;
+	struct dirent *dp;
+	Tcl_Obj *tcl_result;
+	char *path;
+
+	if (objc != 2) {
+		Tcl_WrongNumArgs(interp, 1, objv, "directory");
+		return TCL_ERROR;
+	}
+
+	path = Tcl_GetString(objv[1]);
+	dirp = opendir(path);
+	if (!dirp) {
+		Tcl_SetResult(interp, "Directory not found", TCL_STATIC);
+		return TCL_ERROR;
+	}
+	tcl_result = Tcl_NewListObj(0, NULL);
+	while (dp = readdir(dirp)) {
+		Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewStringObj(dp->d_name, -1));
+	}
+	closedir(dirp);
+	Tcl_SetObjResult(interp, tcl_result);
+	
+	return TCL_OK;
+}
+
+int StrsedCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+	char *pattern, *string, *res;
+	Tcl_Obj *tcl_result;
+	extern char *strsed(char *str, char *pat, int range);
+
+	if (objc != 3) {
+		Tcl_WrongNumArgs(interp, 1, objv, "pattern string");
+		return TCL_ERROR;
+	}
+
+	pattern = Tcl_GetString(objv[1]);
+	string = Tcl_GetString(objv[2]);
+	res = strsed(string, pattern, 0);
+	if (!res) {
+		Tcl_SetResult(interp, "strsed failed", TCL_STATIC);
+		return TCL_ERROR;
+	}
+	Tcl_SetResult(interp, res, (Tcl_FreeProc *)free);
+	return TCL_OK;
+}
+
+int Pextlib_Init(Tcl_Interp *interp)
+{
+	Tcl_CreateObjCommand(interp, "system", SystemCmd, NULL, NULL);
+	Tcl_CreateObjCommand(interp, "flock", FlockCmd, NULL, NULL);
+	Tcl_CreateObjCommand(interp, "readdir", ReaddirCmd, NULL, NULL);
+	Tcl_CreateObjCommand(interp, "strsed", StrsedCmd, NULL, NULL);
+	if(Tcl_PkgProvide(interp, "Pextlib", "1.0") != TCL_OK)
+		return TCL_ERROR;
+	return TCL_OK;
+}
Index: trunk/base/src/pextlib1.0/strsed.c
===================================================================
--- trunk/base/src/pextlib1.0/strsed.c	(revision 214)
+++ trunk/base/src/pextlib1.0/strsed.c	(revision 214)
@@ -0,0 +1,1562 @@
+/*
+ * Strsed.c
+ *
+ *     ed(1)/tr(1)-like search, replace, transliterate. See the
+ *     manpage for details. See the README for copyright information.
+ *
+ * Usage:
+ *
+ *        strsed(string, pattern, 0);
+ *        char *string;
+ *        char *pattern;
+ * or
+ *        strsed(string, pattern, range);
+ *        char *string;
+ *        char *pattern;
+ *        int  range[2];
+ *
+ *
+ * Terry Jones    
+ * terry@distel.pcs.com
+ * ...!{pyramid,unido}!pcsbst!distel!terry
+ *
+ * PCS Computer Systeme GmbH
+ * Pfaelzer-Wald-Str 36
+ * 8000 Muenchen 90
+ * West Germany       49-89-68004288
+ *
+ * January 8th, 1990.
+ *
+ */
+
+/*
+ * $Log: strsed.c,v $
+ * Revision 1.2  2002/08/21 05:22:12  landonf
+ * Merge in "bigmove" reorg branch. System now requires bsdmake && bsdmake install
+ * and installs itself and its TCL libraries in /usr/local/share , /System/Library/Tcl/8.3, and /usr/local/bin
+ *
+ * Revision 1.1.2.1  2002/08/20 21:50:51  landonf
+ * Move and seperate Tcl/port1.0
+ *
+ * Revision 1.1  2002/08/20 10:06:08  jkh
+ * Add in-place string sed function, strsed
+ *
+ * Revision 2.4  90/04/19  20:08:03  jkh
+ * Alpha checkin.
+ * 
+ * Revision 2.4  90/04/19  15:40:38  terry
+ * Made it possible to use any delimiter. E.g. s/ex/on/ is the same as
+ * s.ex.on.
+ * Fixed trailing backslash bugger. Made range always contain something
+ * after search and replace to indicate if a substitute actually occurred.
+ * 
+ * Revision 2.3  90/04/17  19:36:12  terry
+ * Made realloc ok too....
+ * 
+ * Revision 2.2  90/04/17  19:27:02  terry
+ * Did things to make malloc() and free() calls more portable.
+ * 
+ * Revision 2.1  90/04/15  18:06:09  terry
+ * Added changes suggested by John B. Thiel. Added empty regs and empty
+ * regexp structs.
+ * 
+ * Revision 2.0  90/04/09  16:06:19  terry
+ * Added dollops of #ifdef's to deal with Henry Spencer or
+ * GNU regex packages. Also added optimisation that saves the
+ * last compiled pattern. All seems to work fine except the
+ * register reference inside a regex with the HS stuff.
+ * 
+ * Revision 1.19  90/04/09  11:57:01  terry
+ * little things.
+ * 
+ * Revision 1.17  90/03/08  20:44:32  terry
+ * Final cleanup.
+ * 
+ * Revision 1.16  90/03/07  15:46:35  terry
+ * Changed backslash_eliminate to only malloc on 
+ * REPLACEMENT type. Added ".*" optimisation so that
+ * the regex functions are never called.
+ * 
+ * Revision 1.15  90/03/06  22:27:49  terry
+ * Removed varargs stuff since the 3rd argument is now 
+ * compulsory. Cleaned up. A few comments even.
+ * 
+ * Revision 1.14  90/03/06  21:50:28  terry
+ * Touched up memory stuff. Added mem_find(). Changed
+ * buf_sz and buf_inc to be a reasonable refelection
+ * of the length of the input.
+ * 
+ * Revision 1.13  90/03/06  20:22:48  terry
+ * Major rearrangements. Added mem(), mem_init(), mem_save(),
+ * mem_free() to handle memory in a vastly improved fashion.
+ * Calls to malloc are minimised as far as possible.
+ * 
+ * Revision 1.12  90/03/06  13:23:33  terry
+ * Made map static.
+ * 
+ * Revision 1.11  90/01/10  15:51:12  terry
+ * checked in with -k by terry at 90.01.18.20.03.08.
+ * 
+ * Revision 1.11  90/01/10  15:51:12  terry
+ * *** empty log message ***
+ * 
+ * Revision 1.10  90/01/10  12:48:40  terry
+ * Fixed handling of perverted character ranges in nextch().
+ * a-f-c now means a-c.
+ * 
+ * Revision 1.9  90/01/10  12:03:48  terry
+ * Pounded on space allocation, added more_space,
+ * remove free() in build_map, tested tiny buffer sizes etc.
+ * 
+ * Revision 1.8  90/01/09  18:15:12  terry
+ * added backslash elimination to str.
+ * altered backslash_elimantion to take one of three types
+ * REGEX, NORMAL or REPLACEMENT depending on the
+ * elimination desired. Changed interpretation of \ 
+ * followed by a single digit to be that character if the
+ * type of elimination is NORMAL. i.e. \4 = ^D.
+ * 
+ * Revision 1.7  90/01/09  17:05:05  terry
+ * Frozen version for release to comp.sources.unix
+ * 
+ * Revision 1.6  90/01/09  16:47:54  terry
+ * Altered pure searching return values to be -1
+ * 
+ * Revision 1.5  90/01/09  14:54:34  terry
+ * *** empty log message ***
+ * 
+ * Revision 1.4  90/01/09  14:51:04  terry
+ * removed #include <stdio> silliness.
+ * 
+ * Revision 1.2  90/01/09  10:48:22  terry
+ * Fixed handling of } and - metacharacters inside
+ * transliteration request strings in backslash_eliminate().
+ * 
+ * Revision 1.1  90/01/08  17:41:35  terry
+ * Initial revision
+ * 
+ *
+ */
+
+#define HS_REGEX	1
+
+#include <ctype.h>
+#include <string.h>
+
+#ifdef GNU_REGEX
+#include "regex.h"
+#endif
+
+#ifdef HS_REGEX
+#include <regexp.h>
+#endif
+
+#define BYTEWIDTH     8
+#define REGEX         0
+#define REPLACEMENT   1
+#define NORMAL        2
+
+/*
+ * And this is supposed to make freeing easier. It's a little hard to
+ * keep track of what can and cannot be freed in what follows, so I
+ * ignore it and every time a malloc is done for one of the things
+ * below (and these are the only ones possible) we free if need be and
+ * then alloc some more if it can't be avoided. No-one (who is going 
+ * to free) needs to call malloc then. And no-one need call free. 
+ * Wonderful in theory...
+ */
+
+#define MEM_STR       0
+#define MEM_PAT       1
+#define MEM_FROM      2
+#define MEM_TO        3
+#define MEM_NEWSTR    4
+#define MEM_MAP       5
+#define MEM_MAP_SAVE  6
+
+#define MEM_SLOTS     7
+
+/*
+ * This calls mem_free(), which free()s all the allocated storage EXCEPT
+ * for the piece whose address is 'n'. If something goes wrong below
+ * we call RETURN(0) and if we want to return some address we call RETURN
+ * with the address to be returned.
+ */
+
+#define RETURN(n)     \
+    mem_free(n);      \
+    return (char *)n
+
+static struct {
+    char *s;
+    int size;
+    int used;
+} mem_slots[MEM_SLOTS];
+
+
+#define more_space(need)                                                   \
+    if (need > 0 && space != -1){                                          \
+        if (space - (need) < 0){                                           \
+            buf_sz += buf_inc + (need) - space;                            \
+            if (!(new_str = (char *)realloc(new_str, (unsigned)buf_sz))){  \
+                RETURN(0);                                                 \
+            }                                                              \
+	    mem_slots[MEM_NEWSTR].s = new_str;                             \
+	    mem_slots[MEM_NEWSTR].size = buf_sz;                           \
+            space = buf_inc;                                               \
+        }                                                                  \
+        else{                                                              \
+            space -= need;                                                 \
+        }                                                                  \
+    }
+
+#ifdef GNU_REGEX
+#define NO_MATCH -1
+#define EMPTY_REGISTER -1
+#endif
+#ifdef HS_REGEX
+#define NO_MATCH 0
+#define EMPTY_REGISTER ((char *)0)
+#endif
+
+char *
+strsed(string, pattern, range)
+register char *string;
+register char *pattern;
+int *range;
+{
+    extern char *realloc();
+    extern char *strdup();
+    extern void free();
+
+#ifdef GNU_REGEX
+    extern char *re_compile_pattern();
+    extern int re_search();
+    static struct re_pattern_buffer re_comp_buf;
+    struct re_registers regs;
+    static struct re_registers empty_regs;
+#endif
+
+#ifdef HS_REGEX
+    static regexp empty_exp;
+    static regexp *exp;
+#endif
+
+    char *backslash_eliminate();
+    static char *mem();
+    static void mem_init();
+    static void mem_free();
+    
+    char *from;
+    char *new_str;
+    char *pat;
+    char *str;
+    char *tmp;
+    char *to;
+    static char map[1 << BYTEWIDTH];
+    int buf_sz;
+    int buf_inc;
+    int global = 0;
+    int match;
+    int new_pos = 0;
+    int search_only = 0;
+    int seenbs = 0;
+    int space;
+    int match_all = 0;
+    register int str_len;
+    static int first_time = 1;
+    static char *last_exp = (char *)0;
+    int repeat;
+    char delimiter;
+
+    if (!string || !pattern){
+        RETURN(0);
+    }
+    
+    /*
+     * If this is the first time we've been called, clear the memory slots.
+     */
+    if (first_time){
+	register int i;
+	mem_init();
+#ifdef GNU_REGEX
+	/* Zero the fake regs that we use if the regex is ".*" */
+	for (i = 0; i < RE_NREGS; i++){
+	    empty_regs.start[i] = empty_regs.end[i] = EMPTY_REGISTER;
+	} 
+#endif
+
+#ifdef HS_REGEX
+	/* We use first_time again if we are GNU_REGEX, and reset it later. */
+	first_time = 0;
+	
+	/* Zero the fake regexp that we use if the regex is ".*" */
+	for (i = 0; i < NSUBEXP; i++){
+	    empty_exp.startp[i] = empty_exp.endp[i] = EMPTY_REGISTER;
+	} 
+#endif
+    }
+
+    /*
+     * Take our own copies of the string and pattern since we promised
+     * in the man page not to hurt the originals.
+     */
+    str = mem(MEM_STR, strlen(string) + 1);
+    str[0] = '\0';
+    strcat(str, string);
+    pat = mem(MEM_PAT, strlen(pattern) + 1);
+    pat[0] = '\0';
+    strcat(pat, pattern);
+
+    /*
+     * If escape sequences are not already removed elsewhere, remove
+     * them from the string. If you don't know what you're doing here
+     * or are in any doubt, don't define ESCAPED_STRING.
+     */
+#ifndef ESCAPED_STRING
+    if (!(str = backslash_eliminate(str, NORMAL, MEM_STR))){
+        RETURN(0);
+    }
+#endif
+
+    str_len = strlen(str);
+    
+    /*
+     * Set up the size of our buffer (in which we build the
+     * newstring, and the size by which we increment it when
+     * (and if) the need arises. There shouldn't be too much
+     * growth in the average case. Of course some people will
+     * go and do things like 
+     *
+     * strsed(string, "s/.*$/\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0")
+     *
+     * and they will be somewhat penalised. Oh well.
+     *
+     */
+
+    buf_sz = str_len < 8 ? 16 : str_len << 1;
+    buf_inc = buf_sz;
+
+    /*
+     * Get the action. 
+     * s = substitue and g = global.
+     * anything else is invalid.
+     *
+     * If one of these is present, the next char is the delimiter.
+     * Otherwise the character is taken as the delimiter itself.
+     * This is more flexible, for example the following are all
+     * legal:
+     *
+     *           s/pinto/bean/
+     *           /pinto/bean
+     *           /pinto/
+     *           g/pinto/bean/
+     *
+     */
+    switch (*pat){
+	case 'g':{
+	    global = 1;
+	    pat++;
+	    break;
+	}
+	case 's':{
+	    pat++;
+	    break;
+	}
+	default:{
+	    break;
+	}
+    }
+
+    if (!*pat){
+        RETURN(0);
+    }
+    
+    delimiter = *pat++;
+
+    /*
+     * Now split 'pat' into its two components. These are delimited (or
+     * should be) by (unquoted) 'delimiter'. The first we point to with 'from' 
+     * and the second with 'to'. 
+     *
+     * Someone should write a function to make this sort of thing trivial...
+     *
+     */
+    
+    from = to = pat;
+
+    while (*to){
+        if (seenbs){
+            seenbs = 0;
+        }
+        else{
+            if (*to == '\\'){
+                seenbs = 1;
+            }
+            else if (*to == delimiter){
+                break;
+            }
+        }
+        to++;
+    }
+
+    if (!*to){
+        RETURN(0);
+    }
+
+    *to++ = '\0';
+
+    if (*to){
+        tmp = to + strlen(to) - 1;
+
+        /*
+         * Make sure that the last character is the delimiter,
+         * and wasn't preceded by \.
+         *
+	 */
+
+        if (*tmp != delimiter || *(tmp - 1) == '\\'){
+            RETURN(0);
+        }
+
+        *tmp = '\0';
+    }
+    else{
+        /*
+	 * Search only.
+         * It doesn't make sense to say
+         *
+         * strsed(string, "g/abc/", range)
+         *
+         * because we are only searching and returning the 
+         * matched indexes. So turn off global (in case it's on)
+	 * so that we will return just the first instance.
+	 *
+	 * If no range has been given either, then there's no
+	 * point in going on.
+         *
+         */
+	
+	if (!range){
+	    RETURN(0);
+	}
+	
+        global = 0;
+        search_only = 1;
+    }
+
+    /*
+     * Eliminate backslashes and character ranges etc.
+     * Check that 'to' is a non-empty string before bothering
+     * to try and eliminate things.
+     *
+     */
+
+    if (!(from = backslash_eliminate(from, REGEX, MEM_FROM))){
+        RETURN(0);
+    }
+    if (to && !(to = backslash_eliminate(to, REPLACEMENT, MEM_TO))){
+        RETURN(0);
+    }
+    
+    /*
+     * If the first char of 'to' is '\0' then we are deleting or 
+     * searching only. We don't have to worry about space since 
+     * the transformed string will be less than or equal in length
+     * to the original. We just overwrite.
+     * We set space = -1 so that later on we can avoid worrying
+     * about overflow etc.
+     *
+     * Otherwise, we are doing a substitution. Here we have to
+     * worry about space because the replacement may be larger
+     * than the original. malloc some room and if we overflow it 
+     * later we will realloc. Slows things down if the new string
+     * turns out to be too much bigger. Oh well.
+     *
+     */
+    
+    if (*to){
+        if (!(new_str = mem(MEM_NEWSTR, buf_sz + 1))){
+            RETURN(0);
+        }
+        space = buf_sz;
+    }
+    else{
+        new_str = str;
+        space = -1;
+    }
+
+    
+    /*
+     * Check to see if the regexp is the same as last time.
+     * If so, we can save ourselves a call to regexec (or whatever
+     * function your regex package uses).
+     *
+     */
+    
+    if (last_exp){
+	if (!strcmp(from, last_exp)){
+	    repeat = 1;
+	}
+	else{
+	    free(last_exp);
+	    last_exp = strdup(from);
+	    repeat = 0;
+	}
+    }
+    else {
+	last_exp = strdup(from);
+	repeat = 0;
+    }
+    
+    /*
+     * Initialise the range integers to -1, since they may be checked after we
+     * return, even if we are not just searching.
+     */
+    if (range){
+	range[0] = range[1] = -1;
+    }
+    
+    /*
+     * Check for the special case where the regex is ".*" since
+     * then we can save a call to compile and to match, since we
+     * know what will happen. We can just fake it.
+     *
+     */
+
+    if (from[0] == '.' && from[1] == '*' && from[2] == '\0'){
+	register int i; 
+	
+	match_all = 1;
+	
+	/*
+	 * For safety's sake, clear out the register values.
+	 * There might be a register reference in the replacement. 
+	 * There will be nothing in the registers (since the search
+	 * pattern was ".*"). Since we aren't calling the regex 
+	 * stuff we can't rely on it to set these to -1 (or 0 - as the
+	 * case may be).
+	 */
+#ifdef GNU_REGEX
+	regs = empty_regs;
+#endif
+#ifdef HS_REGEX
+	exp = &empty_exp;
+#endif
+    }
+
+
+#ifdef GNU_REGEX
+    /*
+     * Do the first_time check for GNU. Notice the "else" here. We don't
+     * want to do this if the regex is ".*", even if it is our first time.
+     */
+    else{
+	if (first_time){
+	    extern char *malloc();
+	    if (!(re_comp_buf.buffer = (char *)malloc((unsigned)200))){
+		RETURN(0);
+	    }
+	    
+	    re_comp_buf.allocated = 200;
+	    
+	    if (!(re_comp_buf.fastmap = (char *)malloc((unsigned)1 << BYTEWIDTH))){
+		RETURN(0);
+	    }
+	    first_time = 0;
+	}
+	
+	if (!repeat){
+	    re_comp_buf.translate = 0;
+	    re_comp_buf.used = 0;
+	}
+    }
+#endif
+
+    /*
+     * If we are not optimising a ".*" or repeating the regex we had last time,
+     * compile the regular expression.
+     */
+
+    if (!match_all && !repeat){
+#ifdef GNU_REGEX
+	if (re_compile_pattern(from, strlen(from), &re_comp_buf)){
+	    RETURN(0);
+	}
+#endif
+
+#ifdef HS_REGEX
+	if ((exp = regcomp(from)) == (regexp *)0){
+	    RETURN(0);
+	}
+#endif
+    }
+
+    /*
+     * Now get on with the matching/replacing etc.
+     */
+
+    do {
+	if (match_all){
+	    /* Fake a match instead of calling re_search() or regexec(). */
+	    match = 1;
+#ifdef GNU_REGEX
+	    regs.start[0] = 0;
+	    regs.end[0] = str_len;
+#endif
+#ifdef HS_REGEX
+	    exp->startp[0] = str;
+	    exp->endp[0] = str + str_len;
+#endif
+	}
+	else{
+#ifdef GNU_REGEX
+	    match = re_search(&re_comp_buf, str, str_len, 0, str_len, &regs);
+#endif
+#ifdef HS_REGEX
+	    match = regexec(exp, str);
+#endif
+	}
+
+        if (search_only){
+            /*
+             * Show what happened and return.
+             */
+	    
+#ifdef GNU_REGEX
+	    range[0] = match == NO_MATCH ? -1 : regs.start[0];
+	    range[1] = match == NO_MATCH ? -1 : regs.end[0];
+#endif
+#ifdef HS_REGEX
+	    range[0] = match == NO_MATCH ? -1 : (int)(exp->startp[0] - str);
+	    range[1] = match == NO_MATCH ? -1 : (int)(exp->endp[0] - str);
+#endif
+            RETURN(str);
+        }
+
+	
+        if (match != NO_MATCH){
+	    register int need;
+
+	    /* Set up the range so it can be used later if the caller wants it. */
+	    if (range){
+#ifdef GNU_REGEX
+	    range[0] = regs.start[0];
+	    range[1] = regs.end[0];
+#endif
+#ifdef HS_REGEX
+	    range[0] = (int)(exp->startp[0] - str);
+	    range[1] = (int)(exp->endp[0] - str);
+#endif
+	    }
+	    
+            /*
+             * Copy that portion that was not matched. It will
+             * be unchanged in the output string.
+             *
+             */
+	    
+#ifdef GNU_REGEX
+	    need = regs.start[0];
+#endif
+#ifdef HS_REGEX
+	    need = (int)(exp->startp[0] - str);
+#endif
+
+	    if (need > 0){
+		more_space(need);
+		strncpy(new_str + new_pos, str, need);
+		new_pos += need;
+	    }
+
+            /*
+             * Put in the replacement text (if any).
+             * We substitute the contents of 'to', watching for register
+             * references.
+             */
+
+            tmp = to;
+            while (*tmp){
+                if (*tmp == '\\' && isdigit(*(tmp + 1))){
+
+                    /* A register reference. */
+
+                    register int reg = *(tmp + 1) - '0';
+                    int translit = 0;
+#ifdef GNU_REGEX
+                    need = regs.end[reg] - regs.start[reg];
+#endif
+#ifdef HS_REGEX
+                    need = (int)(exp->endp[reg] - exp->startp[reg]);
+#endif
+
+                    /*
+                     * Check for a transliteration request.
+                     *
+                     */
+		    if (*(tmp + 2) == '{'){
+			/* A transliteration table. Build the map. */
+			static char *build_map();
+			if (!(tmp = build_map(tmp + 2, map))){
+			    RETURN(0);
+			}
+			translit = 1;
+		    }
+		    else{
+			tmp += 2;
+			translit = 0;
+		    }
+
+		    more_space(need);
+		    
+		    /*
+		     * Copy in the register contents (if it matched), transliterating if need be.
+		     *
+		     */
+#ifdef GNU_REGEX
+                    if (regs.start[reg] != EMPTY_REGISTER){
+			register int i;
+                        for (i = regs.start[reg]; i < regs.end[reg]; i++){
+                            new_str[new_pos++] = translit ? map[str[i]] : str[i];
+                        }
+                    }
+#endif
+
+#ifdef HS_REGEX
+                    if (exp->startp[reg] != EMPTY_REGISTER){
+			register char *s;
+                        for (s = exp->startp[reg]; s < exp->endp[reg]; s++){
+                            new_str[new_pos++] = translit ? map[*s] : *s;
+                        }
+		    }
+#endif
+                }
+                else{
+                    /* A plain character, put it in. */
+                    more_space(1);
+                    new_str[new_pos++] = *tmp++;
+                }
+            }
+
+            /*
+             * Move forward over the matched text.
+             *
+             */
+#ifdef GNU_REGEX
+            str += regs.end[0];
+            str_len -= regs.end[0];
+#endif
+#ifdef HS_REGEX
+            str = exp->endp[0];
+            str_len -= (int)(exp->endp[0] - exp->startp[0]);
+#endif
+        }
+    } while (global && match != NO_MATCH && *str);
+
+    /*
+     * Copy the final portion of the string. This is the section that
+     * was not matched (and hence which remains unchanged) by the last
+     * match. Then we head off home.
+     *
+     */
+    more_space(str_len);
+    (void) strcpy(new_str + new_pos, str);
+    RETURN(new_str);
+}
+
+#define DIGIT(x) (isdigit(x) ? (x) - '0' : islower(x) ? (x) + 10 - 'a' : (x) + 10 - 'A')
+
+char *
+backslash_eliminate(str, type, who)
+char *str;
+int type;
+int who;
+{
+    /*
+     * Remove backslashes from the strings. Turn \040 etc. into a single
+     * character (we allow eight bit values). Currently NUL is not
+     * allowed.
+     *
+     * Turn "\n" and "\t" into '\n' and '\t' characters. Etc.
+     *
+     * The string may grow slightly here. Under normal circumstances
+     * it will stay the same length or get shorter. It is only in the 
+     * case where we have to turn {a-z}{A-Z} into \0{a-z}{A-Z} that
+     * we add two chars. This only happens when we are doing a REPLACEMENT.
+     * So we can't overwrite str, and we have to 
+     * malloc. Sad, but the only ways I could find around it (at this
+     * late stage) were really gross. I allowed an extra 
+     * 100 bytes which should cover most idiotic behaviour.
+     * I count the extra space and exit nicely if they do do something
+     * extremely silly.
+     *
+     * 'i' is an index into new_str.
+     *
+     * 'type' tells us how to interpret escaped characters.
+     *
+     * type = REGEX 
+     *        if the pattern is a regular expression. If it is then
+     *        we leave escaped things alone (except for \n and \t and 
+     *        friends).
+     *
+     * type = REPLACEMENT
+     *        if this is a replacement pattern. In this case we change
+     *        \( and \) to ( and ), but leave \1 etc alone as they are
+     *        register references. - becomes a metacharacter between
+     *        { and }.
+     *
+     * type = NORMAL
+     *        We do \n and \t elimination, as well as \040 etc, plus
+     *        all other characters that we find quoted we unquote.
+     *        type = NORMAL when we do a backslash elimination on the
+     *        string argument to strsed.
+     *
+     * who tells us where to tell mem where to stick the new string.
+     *
+     * \{m,n\} syntax (see ed(1)) is not supported.
+     *
+     */
+
+    static char *mem();
+    char *new_str;
+    int extra = 100;
+    int seenlb = 0;
+    register int i = 0;
+    register int seenbs = 0;
+    int first_half = 0;
+
+    if (type == REPLACEMENT){
+	if (!(new_str = mem(who, strlen(str) + 1 + extra))){
+	    return 0;
+	}
+    }
+    else{
+	new_str = str;
+    }
+
+    while (*str){
+        if (seenbs){
+            seenbs = 0;
+            switch (*str){
+                case '\\':{
+                    new_str[i++] = '\\';
+                    str++;
+                    break;
+                }
+
+                case '-':{
+                    if (seenlb){
+                        /* Keep it quoted. */
+                        new_str[i++] = '\\';
+                    }
+                    new_str[i++] = '-';
+                    str++;
+                    break;
+                }
+
+                case '}':{
+                    if (seenlb){
+                        /* Keep it quoted. */
+                        new_str[i++] = '\\';
+                    }
+                    new_str[i++] = '}';
+                    str++;
+                    break;
+                }
+
+                case 'n':{
+                    new_str[i++] = '\n';
+                    str++;
+                    break;
+                }
+
+                case 't':{
+                    new_str[i++] = '\t';
+                    str++;
+                    break;
+                }
+
+                case 's':{
+                    new_str[i++] = ' ';
+                    str++;
+                    break;
+                }
+
+                case 'r':{
+                    new_str[i++] = '\r';
+                    str++;
+                    break;
+                }
+
+                case 'f':{
+                    new_str[i++] = '\f';
+                    str++;
+                    break;
+                }
+
+                case 'b':{
+                    new_str[i++] = '\b';
+                    str++;
+                    break;
+                }
+
+                case 'v':{
+                    new_str[i++] = '\13';
+                    str++;
+                    break;
+                }
+
+                case 'z':{
+                    str++;
+                    break;
+                }
+
+                case '0': case '1': case '2': case '3': case '4':
+                case '5': case '6': case '7': case '8': case '9':{
+
+                    char val;
+
+                    /*
+                     * Three digit octal constant.
+                     *
+                     */
+                    if (*str >= '0' && *str <= '3' && 
+                        *(str + 1) >= '0' && *(str + 1) <= '7' &&
+                        *(str + 2) >= '0' && *(str + 2) <= '7'){
+
+                        val = (DIGIT(*str) << 6) + 
+                              (DIGIT(*(str + 1)) << 3) + 
+                               DIGIT(*(str + 2));
+
+                        if (!val){
+                            /*
+                             * NUL is not allowed.
+                             */
+                            return 0;
+                        }
+
+                        new_str[i++] = val;
+                        str += 3;
+                        break;
+                    }
+
+                    /*
+                     * One or two digit hex constant.
+                     * If two are there they will both be taken.
+                     * Use \z to split them up if this is not wanted.
+                     *
+                     */
+                    if (*str == '0' && (*(str + 1) == 'x' || *(str + 1) == 'X') && isxdigit(*(str + 2))){
+                        val = DIGIT(*(str + 2));
+                        if (isxdigit(*(str + 3))){
+                            val = (val << 4) + DIGIT(*(str + 3));
+                            str += 4;
+                        }
+                        else{
+                            str += 3;
+                        }
+
+                        if (!val){
+                            return 0;
+                        }
+
+                        new_str[i++] = val;
+                        break;
+                    }
+
+                    /*
+                     * Two or three decimal digits.
+                     * (One decimal digit is taken as either a register reference
+                     * or as a decimal digit if NORMAL is true below.)
+                     *
+                     */
+                    if (isdigit(*(str + 1))){
+                        val = DIGIT(*str) * 10 + DIGIT(*(str + 1));
+                        if (isdigit(*(str + 2))){
+                            val = 10 * val + DIGIT(*(str + 2));
+                            str += 3;
+                        }
+                        else{
+                            str += 2;
+                        }
+
+                        if (!val){
+                            return 0;
+                        }
+
+                        new_str[i++] = val;
+                        break;
+                    }
+
+                    /*
+                     * A register reference or else a single decimal digit if this
+                     * is a normal string..
+                     *
+                     * Emit \4 (etc) if we are not NORMAL (unless the digit is a 0 
+                     * and we are processing an r.e. This is because \0 makes no 
+                     * sense in an r.e., only in a replacement. If we do have \0 
+                     * and it is an r.e. we return.)
+                     *
+                     */
+                    if (*str == '0' && type == REGEX){
+                        return 0;
+                    }
+
+                    if (type == NORMAL){
+                        if (!(val = DIGIT(*str))){
+                            return 0;
+                        }
+                        new_str[i++] = val;
+                        str++;
+                    }
+                    else{
+                        new_str[i++] = '\\';
+                        new_str[i++] = *str++;
+                    }
+                    break;
+                }
+
+                default:{
+                    if (type == REGEX){
+                        new_str[i++] = '\\';
+                    }
+                    new_str[i++] = *str++;
+                    break;
+                }
+            }
+        }
+        else{
+            if (*str == '\\'){
+                seenbs = 1;
+                str++;
+            }
+            else if (type == REPLACEMENT && *str == '}'){
+                if (*(str + 1) == '{' && first_half){
+                    new_str[i++] = *str++;
+                    new_str[i++] = *str++;
+		    first_half = 0;
+                }
+                else{
+                    seenlb = 0;
+                    new_str[i++] = *str++;
+                }
+            }
+            else if (type == REPLACEMENT && !seenlb && *str == '{'){
+                /*
+                 * Within { and }, \- should be left as such. So we can differentiate
+                 * between s/fred/\-/ and s/fred/{\-a-z}{+A-Z}
+                 *
+                 * We stick in a "\0" here in the case that \X has not just been
+                 * seen. (X = 0..9) Which is to say, {a-z}{A-Z} defaults to 
+                 * \0{a-z}{A-Z}
+                 *
+                 */
+
+                seenlb = 1;
+		first_half = 1;
+
+                if (i < 2 || new_str[i - 2] != '\\' || !(new_str[i - 1] >= '0' && new_str[i - 1] <= '9')){
+                    if ((extra -= 2) < 0){
+                        /* ran out of extra room. */
+                        return 0;
+                    }
+                    new_str[i++] = '\\';
+                    new_str[i++] = '0';
+                }
+                new_str[i++] = *str++;
+            }
+            else{
+                /* 
+                 * A normal char.
+                 *
+                 */
+                new_str[i++] = *str++;
+            }
+        }
+    }
+
+    if (seenbs){
+        /*
+         * The final character was a '\'. Put it in as a single backslash.
+         *
+         */
+	new_str[i++] = '\\';
+    }
+
+    new_str[i] = '\0';
+    return new_str;
+}
+
+static char *
+build_map(s, map)
+char *s;
+char *map;
+{
+    /*
+     * Produce a mapping table for the given transliteration.
+     * We are passed something that looks like "{a-z}{A-Z}"
+     * Look out for \ chars, these are used to quote } and -.
+     *
+     * Return a pointer to the char after the closing }.
+     * We cannot clobber s.
+     *
+     * The building of maps is somewhat optimised.
+     * If the string is the same as the last one we were 
+     * called with then we don't do anything. It would be better
+     * to remember all the transliterations we have seen, in
+     * order (because in a global substitution we will
+     * apply them in the same order repeatedly) and then we
+     * could do the minimum amount of building. This is a 
+     * compromise because it is a fairly safe bet that there will 
+     * not be more than one transliteration done.
+     *
+     */
+
+    char *in;
+    char *out;
+    char *str;
+    char *tmp;
+    char c;
+    static char *mem();
+    static char nextch();
+    int i = 0;
+    int range_count = 0;
+    int seenbs = 0;
+    static char *last = 0;
+    static int last_len;
+
+    if (!s){
+        return 0;
+    }
+
+    if (last && !strncmp(s, last, last_len)){
+        /* Re-use the map. */
+        return s + last_len;
+    }
+    else{
+	/*
+	 * Make a copy of s in both 'last' and 'str'
+	 */
+	int len = strlen(s) + 1;
+        if (!(str = mem(MEM_MAP, len)) || !(last = mem(MEM_MAP_SAVE, len))){
+            return 0;
+        }
+	str[0] = last[0] = '\0';
+	strcat(str, s);
+	strcat(last, s);
+    }
+
+    tmp = str + 1;
+    in = str;
+
+    while (*tmp){
+        if (seenbs){
+            if (*tmp == '-'){
+                /* 
+                 * Keep the \ before a - since this is the range
+                 * separating metacharacter. We don't keep } quoted,
+                 * we just put it in. Then it is passed as a normal
+                 * char (no longer a metachar) to nextch().
+                 *
+                 */
+                str[i++] = '\\';
+            }
+            str[i++] = *tmp++;
+            seenbs = 0;
+        }
+        else{
+            if (*tmp == '\\'){
+                seenbs = 1;
+                tmp++;
+            }
+            else if (*tmp == '}'){
+                if (!range_count){
+                    /* seen first range. */
+                    range_count = 1;
+                    str[i++] = '\0';
+                    tmp++;
+                    while (*tmp == ' ' || *tmp == '\t'){
+                        tmp++;
+                    }
+                    if (*tmp != '{'){
+                        return 0;
+                    }
+                    out = str + i;
+                    tmp++;
+                }
+                else{
+                    /* seen both ranges. */
+                    str[i++] = '\0';
+                    tmp++;
+                    range_count = 2; 
+                    break;
+                }
+            }
+            else{
+                /* A plain defenceless character. */
+                str[i++] = *tmp++;
+            }
+        }
+    }
+
+    if (range_count != 2){
+        return 0;
+    }
+
+    last_len = tmp - str;
+
+    /*
+     * Now 'out' and 'in' both point to character ranges.
+     * These will look something like "A-Z" but may be 
+     * more complicated and have {} and - in them elsewhere.
+     *
+     */
+    
+    for (i = 0; i < 1 << BYTEWIDTH; i++){
+        map[i] = i;
+    }
+
+    /*
+     * Ready the range expanding function.
+     *
+     */
+    (void) nextch(in, 0);
+    (void) nextch(out, 1);
+
+    /*
+     * For each char in 'in', assign it a value in
+     * 'map' corresponding to the next char in 'out'.
+     *
+     */
+
+    while ((c = nextch((char *)0, 0))){
+        map[c] = nextch((char *)0, 1);
+    }
+
+    return tmp;
+}
+
+static char
+nextch(str, who)
+char *str;
+int who;
+{
+    /*
+     * Given a range like {a-z0237-9}
+     * return successive characters from the range on
+     * successive calls. The first call (when str != 0)
+     * sets things up.
+     *
+     * We must handle strange things like
+     * {a-b-c-z}            = {a-z}
+     * and {z-l-a}          = {z-a}
+     * and {f-f-f-f-h}      = {f-h}
+     * and {a-z-f-h-y-d-b}  = {a-b}
+     *
+     * and so on.
+     *
+     * This function will remember two strings and will return
+     * the next charcter in the range specified by 'who'. This
+     * makes the building of the transliteration table above
+     * a trivial loop.
+     *
+     * I can't be bothered to comment this as much as it
+     * deserves right now... 8-)
+     *
+     */
+
+    static char *what[2] = {0, 0};
+    static char last[2] = {0, 0};
+    static int increment[2];
+    static int pos[2];
+
+    if (who < 0 || who > 1){
+        return 0;
+    }
+
+    if (str){
+        /* Set up for this string. */
+        what[who] = str;
+        pos[who] = 0;
+        return 1;
+    }
+    else if (!what[who]){
+        return 0;
+    }
+
+    if (!pos[who] && what[who][0] == '-'){
+        return 0;
+    }
+
+    switch (what[who][pos[who]]){
+        
+        case '-':{
+            /* we're in mid-range. */
+            last[who] += increment[who];
+            if (what[who][pos[who] + 1] == last[who]){
+                pos[who] += 2;
+            }
+            return last[who];
+        }
+
+        case '\0':{
+            /* 
+             * We've finished. Keep on returning the
+             * last thing you saw if who = 1.
+             */
+            if (who){
+                return last[1];
+            }
+            return 0;
+        }
+
+        /* FALLTHROUGH */
+        case '\\':{
+            pos[who]++;
+        }
+
+        default:{
+            last[who] = what[who][pos[who]++];
+            /*
+             * If we have reached a '-' then this is the start of a
+             * range. Keep on moving forward until we see a sensible 
+             * end of range character. Then set up increment so that
+             * we do the right thing next time round. We leave pos
+             * pointing at the '-' sign.
+             *
+             */
+
+            while (what[who][pos[who]] == '-'){
+                int inc = 1;
+                if (what[who][pos[who] + inc] == '\\'){
+                    inc++;
+                }
+                if (!what[who][pos[who] + inc]){
+                    return 0;
+                }
+                if (what[who][pos[who] + inc + 1] == '-'){
+                    pos[who] += inc + 1;
+                    continue;
+                }
+                increment[who] = what[who][pos[who] + inc] - last[who];
+                if (!increment[who]){
+                    pos[who] += 2;
+                    continue;
+                }
+                if (increment[who] > 0){
+                    increment[who] = 1;
+                    break;
+                }
+                else if (increment[who] < 0){
+                    increment[who] = -1;
+                    break;
+                }
+            }
+            return last[who];
+        }
+    }
+}
+
+static char *
+mem(who, size)
+int who;
+int size;
+{
+    /*
+     * Get 'size' bytes of memeory one way or another.
+     *
+     * The 'mem_slots' array holds currently allocated hunks.
+     * If we can use one that's already in use then do so, otherwise
+     * try and find a hunk not in use somewhere else in the table.
+     * As a last resort call malloc. All a bit specialised and
+     * not too clear. Seems to works fine though.
+     */
+    
+    static void mem_save();
+    extern char *malloc();
+
+    if (who < 0 || who >= MEM_SLOTS){
+	return 0;
+    }
+    
+    if (mem_slots[who].used){
+	/*
+	 * There is already something here. Either move/free it or
+	 * return it if it is already big enough to hold this request.
+	 */
+	if (mem_slots[who].size >= size){
+	    /* It is already big enough. */
+	    return mem_slots[who].s;
+	}
+	else{
+	    mem_save(who);
+	}
+    }
+    else{
+	/*
+	 * The slot was not in use. Check to see if there is space
+	 * allocated here already that we can use. If there is and
+	 * we can, use it, if there is and it's not big enough try to
+	 * save it. if there isn't then try to find it in another free slot,
+	 * otherwise don't worry, the malloc below will get us some.
+	 */
+	if (mem_slots[who].s && mem_slots[who].size >= size){
+	    /* We'll take it. */
+	    mem_slots[who].used = 1;
+	    return mem_slots[who].s;
+	}
+	
+	if (mem_slots[who].s){
+	    mem_save(who);
+	}
+	else{
+	    static int mem_find();
+	    int x = mem_find(size);
+	    if (x != -1){
+		mem_slots[who].s = mem_slots[x].s;
+		mem_slots[who].size = mem_slots[x].size;
+		mem_slots[who].used = 1;
+		mem_slots[x].s = (char *)0;
+		return mem_slots[who].s;
+	    }
+	}
+    }
+    
+    /*
+     * Have to use malloc 8-(
+     */
+
+    if (!(mem_slots[who].s = (char *)malloc((unsigned)size))){
+	return 0;
+    }
+    mem_slots[who].size = size;
+    mem_slots[who].used = 1;
+    
+    return mem_slots[who].s;
+}
+
+static int
+mem_find(size)
+int size;
+{
+    /*
+     * See if we can find an unused but allocated slot with 'size' 
+     * (or more) space available. Return the index, or -1 if not.
+     */
+     
+    register int i;
+    
+    for (i = 0; i < MEM_SLOTS; i++){
+	if (!mem_slots[i].used && mem_slots[i].s && mem_slots[i].size >= size){
+	    return i;
+	}
+    }
+    return -1;
+}
+
+static void
+mem_save(x)
+int x;
+{
+    /*
+     * There is some memory in mem_slots[x] and we try to save it rather
+     * than free it. In order we try to
+     *
+     * 1) put it in an unused slot that has no allocation.
+     * 2) put it in an unused slot that has an allocation smaller than x's
+     * 3) free it since there are no free slots and all the full ones are bigger.
+     *
+     */
+
+    extern void free();
+    register int i;
+    register int saved = 0;
+    
+    /*
+     * First we try to find somewhere unused and with no present allocation.
+     */
+    for (i = 0; i < MEM_SLOTS; i++){
+	if (!mem_slots[i].used && !mem_slots[i].s){
+	    saved = 1;
+	    mem_slots[i].s = mem_slots[x].s;
+	    mem_slots[i].size = mem_slots[x].size;
+	    mem_slots[i].used = 0;
+	    break;
+	}
+    }
+    
+    /*
+     * No luck yet. Try for a place that is not being used but which has
+     * space allocated, and which is smaller than us (and all other such spots). 
+     * Pick on the smallest, yeah.
+     */
+    if (!saved){
+	register int small = -1;
+	register int small_val = 32767; /* Be nice to 16 bit'ers. Non-crucial if it's too low. */
+	for (i = 0; i < MEM_SLOTS; i++){
+	    if (!mem_slots[i].used && mem_slots[i].size < mem_slots[x].size && mem_slots[i].size < small_val){
+		small_val = mem_slots[i].size;
+		small = i;
+	    }
+	}
+	
+	if (small != -1){
+	    saved = 1;
+	    /* We got one, now clobber it... */
+	    free(mem_slots[small].s);
+	    /* and move on in. */
+	    mem_slots[small].s = mem_slots[x].s;
+	    mem_slots[small].size = mem_slots[x].size;
+	    mem_slots[small].used = 0;
+	}
+    }
+    
+    if (!saved){
+	/* Have to toss it away. */
+	free(mem_slots[x].s);
+    }
+}
+
+static void
+mem_init()
+{
+    /*
+     * Clear all the memory slots.
+     */
+
+    register int i;
+    
+    for (i = 0; i < MEM_SLOTS; i++){
+	mem_slots[i].s = (char *)0;
+	mem_slots[i].used = 0;
+    }
+}
+
+static void
+mem_free(except)
+char *except;
+{
+    /*
+     * "Clear out" all the memory slots. Actually we do no freeing since
+     * we may well be called again. We just mark the slots as unused. Next
+     * time round they might be useful - the addresses and sizes are still there.
+     *
+     * For the slot (if any) whose address is 'except', we actually set the
+     * address to 0. This is done because we are called ONLY from the macro
+     * RETURN() in strsed() and we intend to return the value in 'except'.
+     * Once this is done, strsed should (in theory) have no knowledge at all
+     * of the address it passed back last time. That way we won't clobber it
+     * and cause all sorts of nasty problems.
+     */
+
+    register int i;
+    
+    for (i = 0; i < MEM_SLOTS; i++){
+	mem_slots[i].used = 0;
+	if (mem_slots[i].s == except){
+	    mem_slots[i].s = (char *)0;
+	    mem_slots[i].size = 0;
+	}
+    } 
+}
+
Index: trunk/base/src/pkg_mkindex.tcl
===================================================================
--- trunk/base/src/pkg_mkindex.tcl	(revision 214)
+++ trunk/base/src/pkg_mkindex.tcl	(revision 214)
@@ -0,0 +1,8 @@
+#!/usr/bin/env tclsh
+if {$argc < 1} {
+	puts "Usage: $argv0 <directory list>"
+	exit
+}
+foreach dir $argv {
+	pkg_mkIndex $dir *.tcl *.dylib
+}
Index: trunk/base/src/port1.0/Makefile
===================================================================
--- trunk/base/src/port1.0/Makefile	(revision 214)
+++ trunk/base/src/port1.0/Makefile	(revision 214)
@@ -0,0 +1,21 @@
+INSTALLDIR= /usr/local/share/darwinports/Tcl/port1.0
+
+all:
+
+clean:
+	rm -f pkgIndex.tcl
+
+install:
+	mkdir -p ${INSTALLDIR}
+	${.CURDIR}/../pkg_mkindex.tcl ${.CURDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} pkgIndex.tcl ${INSTALLDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} port.tcl ${INSTALLDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} portchecksum.tcl ${INSTALLDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} portconfigure.tcl ${INSTALLDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} portextract.tcl ${INSTALLDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} portfetch.tcl ${INSTALLDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} portmain.tcl ${INSTALLDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} portmake.tcl ${INSTALLDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} portpatch.tcl ${INSTALLDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} portui.tcl ${INSTALLDIR}
+	${INSTALL} ${COPY} -o ${LIBOWN} -g ${LIBGRP} -m ${LIBMODE} portutil.tcl ${INSTALLDIR}
Index: trunk/base/src/port1.0/port.tcl
===================================================================
--- trunk/base/src/port1.0/port.tcl	(revision 214)
+++ trunk/base/src/port1.0/port.tcl	(revision 214)
@@ -0,0 +1,23 @@
+# ex:ts=4
+#
+# Insert some license text here at some point soon.
+#
+# standard package load
+package provide port 1.0
+
+# Initialize the UI abstraction API
+package require portui 1.0
+ui_init
+
+package require portmain 1.0
+package require portfetch 1.0
+package require portchecksum 1.0
+package require portextract 1.0
+package require portpatch 1.0
+package require portconfigure 1.0
+package require portmake 1.0
+
+# System wide configuration
+if [info exists portconf] {
+    source $portconf
+}
Index: trunk/base/src/port1.0/portchecksum.tcl
===================================================================
--- trunk/base/src/port1.0/portchecksum.tcl	(revision 214)
+++ trunk/base/src/port1.0/portchecksum.tcl	(revision 214)
@@ -0,0 +1,71 @@
+# ex:ts=4
+#
+# Insert some license text here at some point soon.
+#
+
+package provide portchecksum 1.0
+package require portutil 1.0
+
+register com.apple.checksum target build checksum_main
+register com.apple.checksum provides checksum
+register com.apple.checksum requires main fetch
+
+# define options
+options checksums
+
+proc md5 {file} {
+    global distpath
+
+    set md5regex "^(MD5)\[ \]\\(($file)\\)\[ \]=\[ \](\[A-Za-z0-9\]+)\n$"
+    set pipe [open "|md5 ${file}" r]
+    set line [read $pipe]
+    if {[regexp $md5regex $line match type filename sum] == 1} {
+	return $sum
+    } else {
+	# XXX Handle this error beter
+	ui_puts $line
+	ui_puts "md5sum failed!"
+	return -1
+    }
+}
+
+proc dmd5 {file} {
+    global checksums
+
+    foreach {name type sum} $checksums {
+	if {$name == $file} {
+	    return $sum
+	}
+    }
+    return -1
+}
+
+proc checksum_main {args} {
+    global checksums distpath portpath all_dist_files
+
+    # If no files have been downloaded there is nothing to checksum
+    if ![info exists all_dist_files] {
+	return 0
+    }
+
+    if ![info exists checksums] {
+	ui_puts "No MD5 checksums."
+	return -1
+    }
+
+    foreach distfile $all_dist_files {
+	set checksum [md5 $distpath/$distfile]
+	set dchecksum [dmd5 $distfile]
+	if {$dchecksum == -1} {
+	    ui_puts "No checksum recorded for $distfile"
+	    return -1
+	}
+	if {$checksum == $dchecksum} {
+	    ui_puts "Checksum OK for $distfile"
+	} else {
+	    ui_puts "Checksum mismatch for $distfile"
+	    return -1
+	}
+    }
+    return 0
+}
Index: trunk/base/src/port1.0/portconfigure.tcl
===================================================================
--- trunk/base/src/port1.0/portconfigure.tcl	(revision 214)
+++ trunk/base/src/port1.0/portconfigure.tcl	(revision 214)
@@ -0,0 +1,37 @@
+# ex:ts=4
+#
+# Insert some license text here at some point soon.
+#
+
+package provide portconfigure 1.0
+package require portutil 1.0
+
+register com.apple.configure target build configure_main
+register com.apple.configure provides configure
+register com.apple.configure requires main fetch extract checksum patch
+
+# define options
+options configure.type configure.args configure.worksrcdir automake automake.env automake.args autoconf autoconf.env autoconf.args xmkmf libtool
+
+proc configure_main {args} {
+    global configure configure.type configure.args configure.worksrcdir automake automake.env automake.args autoconf autoconf.env autoconf.args xmkmf libtool portname portpath workdir worksrcdir prefix
+
+    if [info exists configure.worksrcdir] {
+	set configpath ${portpath}/${workdir}/${worksrcdir}/${configure.worksrcdir}
+    } else {
+	set configpath ${portpath}/${workdir}/${worksrcdir}
+    }
+
+    cd $configpath
+    if [tbool automake] {
+	# XXX depend on automake
+    }
+
+    if [info exists configure.args] {
+	system "./configure --prefix=${prefix} ${configure.args}"
+    } else {
+	system "./configure --prefix=${prefix}"
+    }
+    return 0
+}
+
Index: trunk/base/src/port1.0/portextract.tcl
===================================================================
--- trunk/base/src/port1.0/portextract.tcl	(revision 214)
+++ trunk/base/src/port1.0/portextract.tcl	(revision 214)
@@ -0,0 +1,56 @@
+# ex:ts=4
+#
+# Insert some license text here at some point soon.
+#
+
+package provide portextract 1.0
+package require portutil 1.0
+
+register com.apple.extract target build extract_main 
+register com.apple.extract swdep build depend_libs
+register com.apple.extract provides extract
+register com.apple.extract requires fetch checksum
+
+global extract_opts
+
+# define options
+options extract_opts extract.only extract.cmd extract.before_args extract.after_args
+
+proc extract_main {args} {
+    global portname portpath portpath workdir distname distpath distfiles use_bzip2 extract.only extract.cmd extract.before_args extract.after_args
+
+    if {![info exists distfiles] && ![info exists extract.only]} {
+	# nothing to do
+	return 0
+    }
+
+    # Set up defaults
+    default extract.only $distfiles
+    default extract.cmd gzip
+    default extract.before_args -dc
+    default extract.after_args "| tar -xf -"
+
+    if [info exists use_bzip2] {
+	set extract.cmd bzip2
+    } elseif [info exists use_zip] {
+	set extract.cmd unzip
+	set extract.before_args -q
+	set extract.after_args "-d $portpath/$workdir"
+    }
+
+    ui_puts "Extracting for $distname"
+
+    cd $portpath/$workdir
+    foreach distfile ${extract.only} {
+	ui_puts "$distfile: " -nonewline
+	flush stdout
+	set cmd "${extract.cmd} [join ${extract.before_args}] $distpath/$distfile [join ${extract.after_args}]"
+	if [catch {system $cmd} result] {
+	    ui_puts $result
+	    return -1
+	}
+	ui_puts "done"
+    }
+    return 0
+}
+
Index: trunk/base/src/port1.0/portfetch.tcl
===================================================================
--- trunk/base/src/port1.0/portfetch.tcl	(revision 214)
+++ trunk/base/src/port1.0/portfetch.tcl	(revision 214)
@@ -0,0 +1,84 @@
+# ex:ts=4
+#
+# Insert some license text here at some point soon.
+#
+
+package provide portfetch 1.0
+package require portutil 1.0
+
+register com.apple.fetch target build fetch_main
+register com.apple.fetch provides fetch
+register com.apple.fetch requires main
+
+# define options: distname master_sites
+options master_sites patch_sites extract_sufx distfiles extract_only patchfiles dist_subdir use_zip use_bzip2
+
+proc suffix {distname} {
+    global extract_sufx use_bzip2 use_zip
+    if {[tbool extract_sufx]} {
+	return ${distname}.${extract_sufx}
+    } elseif {[tbool use_bzip2]} {
+	return ${distname}.tar.bz2
+    } elseif {[tbool use_zip]} {
+	return ${distname}.zip
+    } else {
+	return ${distname}.tar.gz
+    }
+}
+
+proc checkfiles {args} {
+    global distdir distfiles patchfiles all_dist_files
+
+    lappend filelist $distfiles
+    if {[info exists patchfiles]} {
+	set filelist [concat $filelist $patchfiles]
+    }
+    # Set all_dist_files to distfiles + patchfiles
+    foreach file $filelist {
+	if {![file exists files/$file]} {
+	    lappend all_dist_files $file
+	}
+    }
+}
+
+proc fetchfiles {args} {
+    global distpath all_dist_files master_sites
+
+    if {![file isdirectory $distpath]} {
+	file mkdir $distpath
+    }
+
+    foreach distfile $all_dist_files {
+	if {![file isfile $distpath/$distfile]} {
+	    ui_puts "$distfile doesn't seem to exist in $distpath"
+	    foreach site $master_sites {
+		ui_puts "Attempting to fetch from $site"
+		if ![catch {exec curl -o ${distpath}/${distfile} ${site}${distfile} >&@ stdout} result] {
+		    set fetched 1
+		    break
+		}
+	    }
+	    if {![info exists fetched]} {
+		return -1
+	    } else {
+		unset fetched
+	    }
+	}
+    }
+    return 0
+}
+
+proc fetch_main {args} {
+    global distname distpath all_dist_files
+
+    # Set distfiles
+    default distfiles [suffix $distname]
+
+    # Check for files, download if neccesary
+    checkfiles
+    if ![info exists all_dist_files] {
+	return 0
+    } else {
+	return [fetchfiles]
+    }
+}
Index: trunk/base/src/port1.0/portmain.tcl
===================================================================
--- trunk/base/src/port1.0/portmain.tcl	(revision 214)
+++ trunk/base/src/port1.0/portmain.tcl	(revision 214)
@@ -0,0 +1,42 @@
+# ex:ts=4
+#
+# Insert some license text here at some point soon.
+#
+
+# the 'main' target is provided by this package
+# main is a magic target and should not be replaced
+
+package provide portmain 1.0
+package require portutil 1.0
+
+register com.apple.main target build main always
+register com.apple.main provides main
+
+# XXX Special case sysportpath. This variable is set by the bootstrap
+# and may not exist
+if [info exists sysportpath] {
+	default distpath $sysportpath/distfiles
+}
+default prefix /usr/local/
+default workdir work
+default filedir files
+default portrevision 0
+default os_arch $tcl_platform(machine)
+default os_version $tcl_platform(osVersion)
+
+# define options
+options portname portversion portrevision categories maintainers workdir worksrcdir no_worksubdir filedir distname sysportpath libpath
+
+proc main {args} {
+    global worksrcdir main_opts portname distname
+
+    if {[tbool no_worksubdir]} {
+	default worksrcdir ""
+    } else {
+	if {[info exists distname]} {
+		default worksrcdir $distname
+	}
+    }
+    return 0
+}
+
Index: trunk/base/src/port1.0/portmake.tcl
===================================================================
--- trunk/base/src/port1.0/portmake.tcl	(revision 214)
+++ trunk/base/src/port1.0/portmake.tcl	(revision 214)
@@ -0,0 +1,36 @@
+# ex:ts=4
+#
+# Insert some license text here at some point soon.
+#
+
+package provide portmake 1.0
+package require portutil 1.0
+
+register com.apple.make target build make_main
+register com.apple.make provides make
+register com.apple.make requires main fetch extract checksum patch configure
+
+# define options
+options make.cmd make.type make.target.all make.target.install
+
+proc make_main {args} {
+    global portname portpath workdir worksrcdir prefix make.type make.cmd make.worksrcdir make.target.all
+
+    default make.type bsd
+    default make.cmd make
+
+    if [info exists make.worksrcdir] {
+	set configpath ${portpath}/${workdir}/${worksrcdir}/${make.worksrcdir}
+    } else {
+	set configpath ${portpath}/${workdir}/${worksrcdir}
+    }
+
+    cd $configpath
+    if {${make.type} == "bsd"} {
+	set make.cmd bsdmake
+    }
+    default make.target.all all
+    system "${make.cmd} ${make.target.all}"
+    return 0
+}
+
Index: trunk/base/src/port1.0/portpatch.tcl
===================================================================
--- trunk/base/src/port1.0/portpatch.tcl	(revision 214)
+++ trunk/base/src/port1.0/portpatch.tcl	(revision 214)
@@ -0,0 +1,40 @@
+# ex:ts=4
+#
+# Insert some license text here at some point soon.
+#
+
+package provide portpatch 1.0
+package require portutil 1.0
+
+register com.apple.patch target build patch_main
+register com.apple.patch provides patch
+register com.apple.patch requires main fetch checksum extract
+
+proc patch_main {args} {
+    global portname patchfiles distpath filedir workdir portpath
+
+    if ![info exists patchfiles] {
+	return 0
+    }
+    foreach patch $patchfiles {
+	if [file exists $portpath/$filedir/$patch] {
+	    lappend patchlist $portpath/$filedir/$patch
+	} elseif [file exists $distpath/$patch] {
+	    lappend patchlist $distpath/$patch
+	}
+    }
+    if ![info exists patchlist] {
+	return -code error "Patch files missing"
+    }
+    cd $portpath/$workdir
+    foreach patch $patchlist {
+	switch -glob -- [file tail $patch] {
+	    *.Z -
+	    *.gz {system "gzcat $patch | patch -p0"}
+	    *.bz2 {system "bzcat $patch | patch -p0"}
+	    default {system "patch -p0 < $patch"}
+	}
+    }
+    return 0
+}
+
Index: trunk/base/src/port1.0/portui.tcl
===================================================================
--- trunk/base/src/port1.0/portui.tcl	(revision 214)
+++ trunk/base/src/port1.0/portui.tcl	(revision 214)
@@ -0,0 +1,144 @@
+# ex:ts=4
+#
+# Insert some license text here at some point soon.
+#
+
+package provide portui 1.0
+package require portutil 1.0
+
+# Can be set to make the entire UI go into "batch mode"
+global _ui_is_enabled
+
+# If set, output debugging messages.
+options ports_debug
+
+# If set, output informational messages (ui_info)
+options ports_verbose
+
+# do whatever interesting things need to be done to initialize the UI
+# environment.  Always called by convention though it does nothing
+# much in the "minimal UI" implementation (though it should always
+# make sure to enable the ui at the very minimum.
+proc ui_init {} {
+    ui_enable
+}
+
+# Enable the UI.  This is merely a convenient hook to be able to turn
+# the UI entirely on or entirely off, for ports that are being built
+# in "batch mode".
+proc ui_enable {} {
+    global _ui_is_enabled
+    set _ui_is_enabled yes
+}
+
+# Disable the UI.  All routines essentially go quiet and return default
+# values.
+proc ui_disable {} {
+    global _ui_is_enabled
+    set _ui_is_enabled no
+}
+
+# Returns 1 if the UI is enabled or 0 if not.
+proc ui_enabled {} {
+    global _ui_is_enabled
+    return [string compare $_ui_is_enabled "no"]
+}
+
+# Output string "str" on whatever the "output device" is, depending on
+# the UI model in use.  If you don't want newlines to be output, you
+# must pass "-nonewline" as the second argument.
+
+proc ui_puts {str {nonl ""}} {
+    if ![ui_enabled] return
+
+    if {$nonl == "-nonewline"} {
+	puts -nonewline stdout $str
+	flush stdout
+    } else {
+	puts $str
+    }
+}
+
+# Output debugging messages if the ports_debug variable is set.
+proc ui_debug {str} {
+    global ports_debug
+
+    if [tbool ports_debug] {
+	puts stderr "DEBUG: $str"
+    }
+}
+
+# Output message if ports_verbose is set.
+# Output debugging messages if the ports_debug variable is set.
+proc ui_info {str} {
+    global ports_verbose
+
+    if [tbool ports_verbose] {
+	ui_puts $str
+    }
+}
+
+# Get a line of input from the user and store in str, returning the
+# number of bytes input.
+proc ui_gets {str} {
+    if ![ui_enabled] {
+	set str ""
+	return 0
+    }
+    upvar $str in_string
+    gets stdin in_string
+}
+
+# Ask a boolean "yes/no" question of the user, using "promptstr" as
+# the prompt.  It should contain a trailing space and/or anything else
+# you want to precede the user's input string.  Returns 1 for "yes" or
+# 0 for "no".  This implementation also assumes an english yes/no or
+# y/n response, but that is not mandated by the spec.  If "defvalue"
+# is passed, it will be used as the default value if none is supplied
+# by the user.
+proc ui_yesno {promptstr {defvalue ""}} {
+    set satisfaction no
+    while {$satisfaction == "no"} {
+	ui_puts $promptstr -nonewline
+	if {[ui_gets mystr] == 0} {
+	    if {[string length $defvalue] > 0} {
+		set mystr $defvalue
+	    } else {
+		if {![ui_enabled]} {return 0}
+		continue
+	    }
+	}
+	if {[string compare -nocase -length 1 $mystr y] == 0} {
+	    set rval 1
+	    set satisfaction yes
+	} elseif {[string compare -nocase -length 1 $mystr n] == 0} {
+	    set rval 0
+	    set satisfaction yes
+	} elseif {![ui_enabled]} {
+	    return 0
+	}
+    }
+    return $rval
+}
+
+# Put up a simple confirmation dialog, requesting nothing more than
+# the user's acknowledgement of the prompt string passed in
+# "promptstr".  There is no return value.
+proc ui_confirm {promptstr} {
+    ui_puts $promptstr -nonewline
+    ui_gets garbagestr
+}
+
+# Display the contents of a file, ideally in a manner which allows the
+# user to scroll through and read it comfortably (e.g. a license
+# text).  For the "simple UI" version of this, we simply punt this to
+# less(1) since rewriting a complete pager for the simple case would
+# be a waste of time.  It's expected in a more complex UI case, a
+# scrolling display widget of some type will be used.
+proc ui_display {filename} {
+    if {![ui_enabled]} {return}
+
+    if [file exists $filename] {
+	system /usr/bin/less $filename
+    }
+}
Index: trunk/base/src/port1.0/portutil.tcl
===================================================================
--- trunk/base/src/port1.0/portutil.tcl	(revision 214)
+++ trunk/base/src/port1.0/portutil.tcl	(revision 214)
@@ -0,0 +1,518 @@
+# ex:ts=4
+#
+# Insert some license text here at some point soon.
+#
+
+package provide portutil 1.0
+package require Pextlib 1.0
+
+global targets
+
+namespace eval portutil {
+    variable uniqid 0
+}
+
+########### External High Level Procedures ###########
+
+# options
+# Exports options in an array as externally callable procedures
+# Thus, "options myarray name date" would create procedures named "name"
+# and "date" that set the array items keyed by "name" and "date"
+# Arguments: <array for export> <options (keys in array) to export>
+proc options {args} {
+    foreach option $args {
+    	eval proc $option {args} \{ global ${option} user_options\; \if \{!\[info exists user_options(${option})\]\} \{ set ${option} {$args} \} \}
+    }
+}
+
+# default
+# Checks if variable is set, if not, sets to supplied value
+proc default {option args} {
+    global $option
+    if {![info exists $option]} {
+	set $option $args
+    }
+}
+
+########### Misc Utility Functions ###########
+
+proc tbool {key} {
+    upvar $key upkey
+    if {[info exists upkey]} {
+	if {$upkey == "yes"} {
+	    return 1
+	}
+    }
+    return 0
+}
+
+# makeuserproc
+# This procedure re-writes the user-defined custom target to include
+# all the globals in its scope.  This is undeniably ugly, but I haven't
+# thought of any other way to do this.
+proc makeuserproc {name body} {
+    regsub -- "^\{(.*)" $body "\{ \n foreach g \[info globals\] \{ \n global \$g \n \} \n \\1 " body
+    eval "proc $name {} $body"
+}
+
+# swdep_resolve
+# XXX - Architecture specific
+# XXX - Rely on information from internal defines in cctools/dyld:
+# define DEFAULT_FALLBACK_FRAMEWORK_PATH
+# /Library/Frameworks:/Library/Frameworks:/Network/Library/Frameworks:/System/Library/Frameworks
+# define DEFAULT_FALLBACK_LIBRARY_PATH /lib:/usr/local/lib:/lib:/usr/lib
+# Environment variables DYLD_FRAMEWORK_PATH, DYLD_LIBRARY_PATH,
+# DYLD_FALLBACK_FRAMEWORK_PATH, and DYLD_FALLBACK_LIBRARY_PATH take precedence
+
+proc swdep_resolve {name chain} {
+    global $name env sysportpath
+    if {![info exists $name]} {
+	return 0
+    }
+    upvar #0 $name upname
+    foreach depspec $upname {
+	if {[regexp {([A-Za-z\./0-9]+):([A-Za-z0-9\.$^\?\+\(\)\|\\]+):([A-Za-z\./0-9]+)} "$depspec" match deppath depregex portname] == 1} {
+	    switch -exact -- $deppath {
+		lib {
+		    if {[info exists env(DYLD_FRAMEWORK_PATH)]} {
+			lappend search_path $env(DYLD_FRAMEWORK_PATH)
+		    } else {
+			lappend search_path /Library/Frameworks /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks
+		    }
+		    if {[info exists env(DYLD_FALLBACK_FRAMEWORK_PATH)]} {
+			lappend search_path $env(DYLD_FALLBACK_FRAMEWORK_PATH)
+		    }
+		    if {[info exists env(DYLD_LIBRARY_PATH)]} {
+			lappend search_path $env(DYLD_LIBRARY_PATH)
+		    } else {
+			lappend search_path /lib /usr/local/lib /lib /usr/lib
+		    }
+		    if {[info exists env(DYLD_FALLBACK_LIBRARY_PATH)]} {
+			lappend search_path $env(DYLD_LIBRARY_PATH)
+		    }
+		}
+		bin {
+		    # XXX broken
+		    set search_path [split $env(PATH) :]
+		}
+		default {
+		    set search_path $deppath
+		}
+	    }
+	}
+    }
+    foreach path $search_path {
+	if {![file isdirectory $path]} {
+		continue
+	}
+	foreach filename [readdir $path] {
+		if {[regexp $depregex $filename] == 1} {
+			ui_debug "Found Dependency: path: $path filename: $filename regex: $depregex"
+			return 0
+		}
+	}
+    }
+    puts "Executing $portname"
+    build $sysportpath/software/$portname build make
+    return 0
+}
+
+########### External Dependancy Manipulation Procedures ###########
+# register
+# Creates a target in the global target list using the internal dependancy
+#     functions
+# Arguments: <identifier> <mode> <args ...>
+# The following modes are supported:
+#	<identifier> target <chain> <procedure to execute> [run type]
+#	<identifier> swdep <chain> <dependency option name>
+#	<identifier> provides <list of target names>
+#	<identifier> requires <list of target names>
+#	<identifier> uses <list of target names>
+#	<identifier> preflight <target name>
+#	<identifier> postflight <target name>
+proc register {name mode args} {
+    global targets
+    dlist_add_item targets $name
+
+    if {[string equal target $mode]} {
+        set chain [lindex $args 0]
+        set procedure [lindex $args 1]
+        if {[dlist_has_key targets $name procedure,$chain]} {
+            ui_puts "Warning: target '$name' re-registered for chain $chain (new procedure: '$procedure')"
+        }
+        dlist_set_key targets $name procedure,$chain $procedure
+
+	# Set runtype {always,once} if available
+	if {[llength $args] == 3} {
+	    dlist_set_key targets $name runtype [lindex $args 2]
+	}
+    } elseif {[string equal swdep $mode]} {
+	set chain [lindex $args 0]
+	set depname [lindex $args 1]
+	if {![dlist_has_key targets $depname procedure,$chain]} {
+	    register $depname target $chain swdep_resolve
+	    register $depname provides $depname
+	    options $depname
+	}
+	register $name requires $depname
+    } elseif {[string equal requires $mode] || [string equal uses $mode] || [string equal provides $mode]} {
+        if {[dlist_has_item targets $name]} {
+            dlist_append_key targets $name $mode $args
+        } else {
+            ui_puts "Warning: target '$name' not-registered in register $mode"
+        }
+        
+        if {[string equal provides $mode]} {
+            # If it's a provides, register the pre-/post- hooks for use in Portfile.
+            # Portfile syntax: pre-fetch { puts "hello world" }
+            # User-code exceptions are caught and returned as a result of the target.
+            # Thus if the user code breaks, dependent targets will not execute.
+            foreach target $args {
+                set id [incr portutil::uniqid]
+                set ident [lindex [dlist_get_matches targets provides $args] 0]
+                set origproc [dlist_get_key targets $ident procedure,build]
+                eval "proc $target {args} \{ \n\
+                    register $ident target build proc-$target$id \n\
+                    proc proc-$target$id \{name chain\} \{ \n\
+                        return \[catch userproc-$target$id\] \n\
+                    \} \n\
+                    eval \"proc do-$target \{\} \{ $origproc $target build \}\" \n\
+                    makeuserproc userproc-$target$id \$args \}"
+                eval "proc pre-$target {args} \{ \n\
+                    register pre-$target$id target build proc-pre-$target$id \n\
+                    register pre-$target$id preflight $target \n\
+                    proc proc-pre-$target$id \{name chain\} \{ \n\
+                        return \[catch userproc-pre-$target$id\] \n\
+                    \} \n\
+                    makeuserproc userproc-pre-$target$id \$args \}"
+                eval "proc post-$target {args} \{ \n\
+                    register post-$target$id target build proc-post-$target$id \n\
+                    register post-$target$id postflight $target \n\
+                    proc proc-post-$target$id \{name chain\} \{ \n\
+                        return \[catch userproc-post-$target$id\] \n\
+                    \} \n\
+                    makeuserproc userproc-pre-$target$id \$args \}"
+            }
+        }
+	
+    } elseif {[string equal preflight $mode]} {
+	# preflight vulcan mind meld:
+	# "your requirements to my requirements; my provides to your requirements"
+	
+	dlist_append_key targets $name provides $name-pre-$args
+	# XXX: this only returns the first match, is this what we want?
+	set ident [lindex [dlist_get_matches targets provides $args] 0]
+	
+	dlist_append_key targets $name requires \
+	    [dlist_get_key targets $ident requires]
+	dlist_append_key targets $ident requires \
+	    [dlist_get_key targets $name provides]
+	
+    } elseif {[string equal postflight $mode]} {
+	# postflight procedure:
+	
+	dlist_append_key targets $name provides $name-post-$args
+		
+	set ident [lindex [dlist_get_matches targets provides $args] 0]
+
+	# your provides to my requires
+	dlist_append_key targets $name requires \
+	    [dlist_get_key targets $ident provides]
+	
+	# my provides to the requires of your children
+	foreach token [join [dlist_get_key targets $ident provides]] {
+	    set matches [dlist_get_matches targets requires $token]
+	    foreach match $matches {
+		# don't want to require ourself
+		if {![string equal $match $name]} {
+		    dlist_append_key targets $match requires $name-post-$args
+		}
+	    }
+	}
+    }
+}
+
+# unregister
+# Unregisters a target in the global target list
+# Arguments: target <target name>
+proc unregister {mode target} {
+}
+
+########### Internal Dependancy Manipulation Procedures ###########
+
+# Dependency List (dlist)
+# The dependency list is really just one big array.  (I would have
+# liked to make this nested arrays, but that's not feasible in Tcl,
+# thus we'll use the $fieldname,$groupname syntax to mimic structures.
+#
+# Dependency lists may contain private data, via the 
+# dlist_*_key APIs.  However, it must be recognized that the
+# following keys are reserved for use by the evaluation engine.
+# (Don't fret, you want these keys anyway, honest.)  These keys also
+# have predefined accessor APIs to remind you of their significance.
+#
+# Reserved keys: 
+# name		- The unique identifier of the item.  No Commas!
+# provides	- The list of tokens this item provides
+# requires	- The list of hard-dependency tokens
+# uses		- The list of soft-dependency tokens
+# runtype	- The runtype of the item {always,once}
+
+# Sets the key/value to an item in the dependency list
+proc dlist_set_key {dlist name key args} {
+    upvar $dlist uplist
+    # might be keen to validate $name here.
+    eval "set uplist($key,$name) $args"
+}
+
+# Appends the value to the list stored at the key of the item
+proc dlist_append_key {dlist name key args} {
+    upvar $dlist uplist
+    if {![dlist_has_key uplist $name $key]} { set uplist($key,$name) [list] }
+    eval "lappend uplist($key,$name) [join $args]"
+}
+
+# Return true if the key exists for the item, false otherwise
+proc dlist_has_key {dlist name key} {
+    upvar $dlist uplist
+    return [info exists uplist($key,$name)]
+}
+
+# Retrieves the value of the key of an item in the dependency list
+proc dlist_get_key {dlist name key} {
+    upvar $dlist uplist
+    if {[info exists uplist($key,$name)]} {
+	return $uplist($key,$name)
+    } else {
+	return ""
+    }
+}
+
+# Adds a colorless odorless item to the dependency list
+proc dlist_add_item {dlist name} {
+    upvar $dlist uplist
+    set uplist(name,$name) $name
+}
+
+# Deletes all keys of the specified item
+proc dlist_remove_item {dlist name} {
+    upvar $dlist uplist
+    array unset uplist *,$name
+}
+
+# Tests if the item is present in the dependency list
+proc dlist_has_item {dlist name} {
+    upvar $dlist uplist
+    return [info exists uplist(name,$name)]
+}
+
+# Return a list of names of items that provide the given name
+proc dlist_get_matches {dlist key value} {
+    upvar $dlist uplist
+    set result [list]
+    foreach ident [array names uplist name,*] {
+	set name $uplist($ident)
+	foreach val [dlist_get_key uplist $name $key] {
+	    if {[string equal $val $value] && 
+		![info exists ${result}($name)]} {
+		lappend result $name
+	    }
+	}
+    }
+    return $result
+}
+
+# Count the unmet dependencies in the dlist based on the statusdict
+proc dlist_count_unmet {names statusdict} {
+    upvar $statusdict upstatusdict
+    set unmet 0
+    foreach name $names {
+	if {![info exists upstatusdict($name)] ||
+	    ![string equal $upstatusdict($name) success]} {
+	    incr unmet
+	}
+    }
+    return $unmet
+}
+
+# Returns true if any of the dependencies are pending in the dlist
+proc dlist_has_pending {dlist uses} {
+    foreach name $uses {
+	if {[info exists ${dlist}(name,$name)]} { 
+	    return 1
+	}
+    }
+    return 0
+}
+
+# Get the name of the next eligible item from the dependency list
+proc dlist_get_next {dlist statusdict} {
+    set nextitem ""
+    # arbitrary large number ~ INT_MAX
+    set minfailed 2000000000
+    upvar $dlist uplist
+    upvar $statusdict upstatusdict
+    
+    foreach n [array names uplist name,*] {
+	set name $uplist($n)
+	
+	# skip if unsatisfied hard dependencies
+	if {[dlist_count_unmet [dlist_get_key uplist $name requires] upstatusdict]} { continue }
+	
+	# favor item with fewest unment soft dependencies
+	set unmet [dlist_count_unmet [dlist_get_key uplist $name uses] upstatusdict]
+	
+	# delay items with unmet soft dependencies that can be filled
+	if {$unmet > 0 && [dlist_has_pending dlist [dlist_get_key uplist $name uses]]} { continue }
+	
+	if {$unmet >= $minfailed} {
+	    # not better than our last pick
+	    continue
+	} else {
+	    # better than our last pick
+	    set minfailed $unmet
+	    set nextitem $name
+	}
+    }
+    return $nextitem
+}
+
+
+# Evaluate the dlist, invoking action on each name in the dlist as it
+# becomes eligible.
+proc dlist_evaluate {dlist downstatusdict action} {
+    # dlist - nodes waiting to be executed
+    upvar $dlist uplist
+    upvar $downstatusdict statusdict
+    
+    # status - keys will be node names, values will be success or failure.
+    array set statusdict [list]
+    
+    # loop for as long as there are nodes in the dlist.
+    while (1) {
+	set name [dlist_get_next uplist statusdict]
+	if {[string length $name] == 0} { 
+	    break
+	} else {
+	    set result [eval $action uplist $name]
+	    foreach token $uplist(provides,$name) {
+		array set statusdict [list $token $result]
+	    }
+	    dlist_remove_item uplist $name
+	}
+    }
+    
+    set names [array names uplist name,*]
+    if { [llength $names] > 0} {
+	# somebody broke!
+	ui_puts "Warning: the following items did not execute: "
+	foreach name $names {
+	    ui_puts "$uplist($name) " -nonewline
+	}
+	ui_puts ""
+    }
+}
+
+proc exec_target {fd chain dlist name} {
+# XXX: Don't depend on entire dlist, this should really receive just one node.
+    upvar $dlist uplist
+    if {[dlist_has_key uplist $name procedure,$chain]} {
+	set procedure [dlist_get_key uplist $name procedure,$chain]
+	ui_debug "Executing $name in chain $chain"
+	set result [$procedure $name $chain]
+	if {$result == 0} {
+	    set result success
+	    if {[dlist_get_key uplist $name runtype] != "always"} {
+		puts $fd $name
+		flush $fd
+	    }
+	} else {
+	    ui_puts "$chain error: $name returned $result"
+	    set result failure
+	}
+    } else {
+	ui_puts "Warning: $name does not support chain $chain"
+	set result failure
+    }
+    return $result
+}
+
+proc eval_targets {dlist chain target} {
+    upvar $dlist uplist
+	
+    # Select the subset of targets under $target
+    if {[string length $target] > 0} {
+        set matches [dlist_get_matches uplist provides $target]
+        if {[llength $matches] > 0} {
+            array set dependents [list]
+            dlist_append_dependents dependents uplist [lindex $matches 0]
+            array unset uplist
+            array set uplist [array get dependents]
+            # Special-case 'all'
+        } elseif {![string equal $target all]} {
+            ui_puts "Warning: unknown target: $target"
+            return
+        }
+    }
+    
+    array set statusdict [list]
+    
+    # Restore the state from a previous run.
+    set fd [read_statefile uplist statusdict]
+    
+    dlist_evaluate uplist statusdict [list exec_target $fd $chain]
+    
+    close $fd
+}
+
+# select dependents of <name> from the <itemlist>
+# adding them to <dependents>
+proc dlist_append_dependents {dependents dlist name} {
+    upvar $dependents updependents
+    upvar $dlist uplist
+
+    # Append item to the list, avoiding duplicates
+    if {![info exists updependents(name,$name)]} {
+	set names [array names uplist *,$name]
+        foreach n $names {
+            set updependents($n) $uplist($n)
+        }
+    }
+    
+    # Recursively append any hard dependencies
+    if {[info exists uplist(requires,$name)]} {
+        foreach dep $uplist(requires,$name) {
+            foreach provide [dlist_get_matches uplist provides $dep] {
+                dlist_append_dependents updependents uplist $provide
+            }
+        }
+    }
+    
+    # XXX: add soft-dependencies?
+}
+
+# read_statefile
+# Read the lines from the file, and for each line
+# that exists in the dlist, make its provides successful
+# and remove it from the dlist.
+proc read_statefile {dlist statusdict} {
+    upvar $dlist uplist
+    upvar $statusdict upstatusdict
+    global portpath workdir
+
+    if ![file isdirectory $portpath/$workdir] {
+	file mkdir $portpath/$workdir
+    } 
+    set fd [open "$portpath/$workdir/.darwinports.state" a+]
+    seek $fd 0
+    while {[gets $fd line] >= 0} {
+        if {[dlist_has_item uplist $line]} {
+            foreach provide [dlist_get_key uplist $line provides] {
+                set upstatusdict($provide) success
+            }
+            dlist_remove_item uplist $line
+        }
+    }
+
+    return $fd
+}
Index: trunk/base/src/portbuild/Makefile
===================================================================
--- trunk/base/src/portbuild/Makefile	(revision 214)
+++ trunk/base/src/portbuild/Makefile	(revision 214)
@@ -0,0 +1,6 @@
+all:
+
+clean:
+
+install:
+	${INSTALL} ${COPY} -o ${BINOWN} -g ${BINGRP} -m ${BINMODE} portbuild.tcl /usr/local/bin/portbuild
Index: trunk/base/src/portbuild/portbuild.tcl
===================================================================
--- trunk/base/src/portbuild/portbuild.tcl	(revision 214)
+++ trunk/base/src/portbuild/portbuild.tcl	(revision 214)
@@ -0,0 +1,45 @@
+#!/usr/bin/tclsh
+# portbuild
+package require darwinports
+
+# globals
+set portdir .
+
+# Standard procedures
+proc print_usage args {
+    global argv0
+    puts "Usage: $argv0 \[-t <target>\] \[-d portdir\] \[options\]"
+}
+
+proc fatal args {
+    global argv0
+    puts stderr "$argv0: $args"
+    exit
+}
+
+# Main
+set target "all"
+for {set i 0} {$i < $argc} {incr i} {
+	switch -regexp -- [lindex $argv $i] {
+		-d {
+			incr i
+			set portdir [lindex $argv $i]
+		}
+		-t {
+			incr i
+			set target [lindex $argv $i]
+		}
+		{[A-Za-z0-9_\.]+=.+} {
+			if {[regexp {([A-Za-z0-9_\.]+)=(.+)} [lindex $argv $i] match key val] == 1} {
+				lappend options [lindex $argv $i]
+			}
+		}
+		default { print_usage; exit }
+	}
+}
+init
+if [info exists options] {
+    build $portdir build $target $options
+} else {
+    build $portdir build $target
+}
