#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <dirent.h>
#include <tcl.h>
#include "wyrmwif.h"
#include "wyrm-io.h"

#define objeq(string,object) streq(string,Tcl_GetString((object)))

		

static int bitmapcommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
	int M,L; Obj *Q; int n; chars s; int i,j,b,w; Obj r,t;
	if (N<3) {Tcl_WrongNumArgs(intr,1,P,"name lines"); return TCL_ERROR;}
	if (N>3 || Tcl_ListObjGetElements(0,P[2],&M,&Q)!=TCL_OK || M==1) {M = N-2; Q = P+2;}
	Tcl_GetStringFromObj(Q[0],&L);
	for (i=1; i<M; i++) {
		Tcl_GetStringFromObj(Q[i],&n);
		if (n!=L) return rprintf(intr,"%!line lengths are different",TCL_ERROR);
	}
	r = oprintf(
			"#define %{y}s_width %d\n"
			"#define %{y}s_height %d\n"
			"static char %{y}s_bits [] = {",/*}*/
			P[1],L,
			P[1],M,
			P[1]);
	for (i=0; i<M; i++) {
		Tcl_AppendToObj(r,"\n\t",-1);
		s = Tcl_GetString(Q[i]);
		for (j=b=0,w=7; j<L; j++) {
			if (s[j]!='_') b |= 1<<w;
			w--;
			if (w<0) {Tcl_AppendObjToObj(r,(t=oprintf("0x%02x,",b))); decr(t); w = 7; b = 0;}
		}
		if (w<7) {Tcl_AppendObjToObj(r,(t=oprintf("0x%02x,",b))); decr(t);}
	}
	Tcl_AppendToObj(r,/*{*/"\n};\n\n",-1);
	Tcl_SetObjResult(intr,r); decr(r);
	return TCL_OK;
}

		

Tcl_CreateObjCommand(intr,"::wyrm::bitmap",bitmapcommand,0,0);
if (Tcl_VarEval(intr,"namespace eval ::wyrm {namespace export bitmap}",0)!=TCL_OK) return TCL_ERROR;

		

<bitmap>

		

enum {LF=0x0A,CR=0x0D,BS=010,FF=014,TAB=011,ll=32,ul=127};

static void crlf(char *fn,int textonly) {
	int c,s=1,m=0;
	FILE *f,*t;
	f = fopen(fn,"r+");
	if (!f) {
		fprintf(stderr,"%s: ",fn); perror("could not open");
		return;
	}
	t = tmpfile();
	if (!t) {
		perror("could not open temporary");
		fclose(f);
		return;
	}
	while (s>0) {
		switch (c=fgetc(f)) {
			case LF: fputc(LF,t); s = 1; break;
			case CR: s = 2; m = 1; break;
			case EOF: if (s==2) fputc(LF,t); s = 0; break;
			default: if (textonly && (ll>c || c>=ul)) goto nontext;
			case BS: case FF: case TAB: if (s==2) fputc(LF,t); s = 1; fputc(c,t);  break;
		}
	}
	if (m) {
		rewind(f); rewind(t); ftruncate(f,0);
		while (c=fgetc(t), c!=EOF) fputc(c,f);
	}
	fclose(f); fclose(t);
	fprintf(stderr,"%s%s\n",fn,m?": modified":"");
	return;
nontext:
	fprintf(stderr,"%s: not a text file\n",fn);
}

static void path(char *P,int textonly) {
	struct stat s;
	if (lstat(P,&s)==0) {
		if (S_ISREG(s.st_mode))
			crlf(P,textonly);
		else if (S_ISDIR(s.st_mode)) {
			DIR *D = opendir(P); struct dirent *d;
			if (!D) {
				fprintf(stderr,"%s: ",P); perror("could not scan directory");
				return;
			}
			while ((d=readdir(D))) {
				char *p;
				if (d->d_name[0]=='.') continue;
				p = allocate(strlen(P)+strlen(d->d_name)+2);
				sprintf(p,"%s/%s",P,d->d_name);
				path(p,textonly);
				dispose(p);
			}
			closedir(D);
		}
	}
}

static int crlfcommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
	int i=1,textonly=0;
	if (i<N && objeq("-text",P[i])) {
		textonly = 1; i++;
	}
	if (i<N && objeq("--",P[i])) {
		i++;
	}
	for (; i<N; i++) {
		path(Tcl_GetString(P[i]),textonly);
	}
	return TCL_OK;
}

		

Tcl_CreateObjCommand(intr,"::wyrm::crlf",crlfcommand,0,0);
if (Tcl_VarEval(intr,"namespace eval ::wyrm {namespace export crlf}",0)!=TCL_OK) return TCL_ERROR;

		

<crlf>

		

namespace eval ::wyrm {
	namespace export encodeimage
	proc encodeimage {args} {
		foreach fn $args {
			set c [open $fn]
			fconfigure $c -translation binary
			set b64 [wyrm::kwbase64 encode [read $c]]
			close $c
			set c [open [file root $fn].txt w]
			while {[string length $b64]>0} {
				puts $c [string range $b64 0 79]
				set b64 [string range $b64 80 end]
			}
			close $c
		}
	}
}

		

<encodeimage>

		

namespace eval ::wyrm {
	namespace export heavyhitters
	proc heavyhitters {args} {
		eval exec du $args | sort -n -r
	}
}

		

<heavyhitters>

		

static int hexdumpcommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
	int ch,i=0; char s[17]; long n=0;
	s[16] = 0;
	ch = fgetc(stdin);
	while (ch!=EOF || i>0) {
		if (i==0)
			printf("%8d: ",n);
		n += 1;
		if (ch==EOF) {
			s[i] = 0;
			printf("   ");
		}else {
			s[i] = ch<' ' || ch>=127 ? '.' : ch;
			printf(" %02x",ch);
			ch = fgetc(stdin);
		}
		i = (i+1) & 15;
		if (i==0) printf("   %s\n",s);
	}

	printf("%ld bytes.\n",n);
	return TCL_OK;
}

		

Tcl_CreateObjCommand(intr,"::wyrm::hexdump",hexdumpcommand,0,0);
if (Tcl_VarEval(intr,"namespace eval ::wyrm {namespace export hexdump}",0)!=TCL_OK) return TCL_ERROR;

		

<hexdump>

		

namespace eval ::wyrm {
	namespace export psx
	proc psx {pattern} {
		if {[string equal $::tcl_platform(os) Darwin]} {
			exec ps ax | grep $pattern | grep -v grep
		} else {
			exec ps -ef | grep $pattern | grep -v grep
		}
	}
}

		

<psx>

		

static void retab(FILE *input,FILE *output,int intab,int outtab) {
	int ch,sp=0;
	while (ch=fgetc(input),ch!=EOF) {
		switch (ch=='\n' ? '\n' : sp<0 ? 0 : ch) {
			case '\n':
				fputc(ch,output); sp = 0;
				break;
			case ' ':
				sp += 1;
				break;
			case '\t':
				sp = (sp/intab + 1)*intab;
				break;
			default:
				if (sp>0) {
					int ntab = outtab ? sp/outtab : 0;
					int nsp  = outtab ? sp%outtab : sp;
					int i;
					for (i=0; i<ntab; i++) fputc('\t',output);
					for (i=0; i<nsp; i++)  fputc(' ', output);
				}
				fputc(ch,output); sp = -1;
				break;
		}
	}
}

static int retabcommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
	FILE *input=0,*output=stdout;
	int	 intab=8,outtab=4;
	int  i;
	char *arg,*p;
	for (i=1; i<N; i++) {
		switch (Tcl_GetString(P[i])[0]=='-' ? Tcl_GetString(P[i])[1] : -1) {
			case 'o': case 'O':
				arg = Tcl_GetString(P[i])[2] ? Tcl_GetString(P[i])+2 : (++i,Tcl_GetString(P[i]));
				if (output!=stdout) fclose(output);
				output = fopen(arg,"w");
				if (!output) {
					return rprintf(intr,"%!could not create output: %s: %s",TCL_ERROR,arg,Tcl_PosixError(intr));
				}
				break;
			case 't': case 'i':
				arg = Tcl_GetString(P[i])[2] ? Tcl_GetString(P[i])+2 : (++i,Tcl_GetString(P[i]));
				intab = strtol(arg,&p,0);
				if (intab<=0 || *p) {
					return rprintf(intr,"%!improper input tab size: %s: %d",TCL_ERROR,arg,intab);
				}
				break;
			case 'T': case 'n':
				arg = Tcl_GetString(P[i])[2] ? Tcl_GetString(P[i])+2 : (++i,Tcl_GetString(P[i]));
				outtab = strtol(arg,&p,0);
				if (outtab<0 || *p) {
					return rprintf(intr,"%!improper output tab size: %s: %d",TCL_ERROR,arg,outtab);
				}
				break;
			case -1:
				input = fopen(Tcl_GetString(P[i]),"r");
				if (!input) {
					return rprintf(intr,"%!could not create input: %s: %s",
							TCL_ERROR,Tcl_GetString(P[i]),Tcl_PosixError(intr));
				}
				retab(input,output,intab,outtab);
				break;
			default:
				return rprintf(intr,"%!unknown parameter: %s:",TCL_ERROR,Tcl_GetString(P[i]));
		}
	}
	if (!input) {
		retab(stdin,output,intab,outtab);
	}
	if (output!=stdout) fclose(output);
	return TCL_OK;
}

		

Tcl_CreateObjCommand(intr,"::wyrm::retab",retabcommand,0,0);
if (Tcl_VarEval(intr,"namespace eval ::wyrm {namespace export retab}",0)!=TCL_OK) return TCL_ERROR;

		

<retab>

		

namespace eval ::wyrm {
	namespace export whereis
	proc whereis {executable} {
		set r {}
		foreach part [split $::env(PATH) :] {
			set path [eval file join $part $executable]
			if {[file executable $path]} {
				lappend r $path
			}
		}
		return $r
	}
}

		

<whereis>

		

int Wyrmutilities_Init(Intr intr) {
	Tcl_PkgProvide(intr,"wyrmutilities","1.0");
	Tcl_PkgRequire(intr,"wyrmwif","1",0);
	<Create commands>
	return Tcl_VarEval(intr,
		#include "wyrm-utilities-tcl.h"
	0);
}

int Wyrmutilities_SafeInit(Intr intr) {
	return rprintf(intr,"%!package not available in a safe interpretter",TCL_ERROR);
}