earlw@pesnta.UUCP (Earl Wallace) (06/13/85)
#! /bin/sh # # This is an another posting of the Little Smalltalk source, the last posting # of this source went out in 5 parts and they were too big (>200k) for most # sites so I redid the whole mess to keep the files around the 50k range. # # The complete set is now 20 parts. # # P.S. - If you don't receive all 20 parts within 5 days, drop me a line. # Also, I have the Rand sources of May 1984, if someone has a more # updated copy, I'll be happy to post them (or YOU can post them :-)) # # -earlw@pesnta # #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # prelude/string.p # prelude/string.st # prelude/symbol.p # prelude/symbol.st # prelude/test.st # prelude/tests.st # prelude/true.p # prelude/true.st # projects/8queen.st # projects/READ_ME # projects/abgen.st # projects/browser.st # projects/class.st # projects/cldict.c # projects/cursin.c # projects/cursin.h # projects/defs.h # projects/env.h # projects/generator.bund # projects/generator.st # projects/hanoi # projects/his.c # projects/line.c # projects/main.c # This archive created: Thu Jun 13 11:32:28 1985 # By: Earl Wallace (Perkin-Elmer Data Systems Group / Customer Service) export PATH; PATH=/bin:$PATH if test -f 'prelude/string.p' then echo shar: will not over-write existing file "'prelude/string.p'" else cat << \SHAR_EOF > 'prelude/string.p' temp <- <primitive 110 18 > <primitive 112 temp 1 " sameAs: " \ #( #[ 32 33 250 2 6 247 7 32 33 250 2 102 248 4 242 \ 32 10 19 243 245] \ #( ) ) > <primitive 112 temp 2 " size " \ #( #[ 32 250 1 100 243 245] \ #( ) ) > <primitive 112 temp 3 " print " \ #( #[ 32 250 1 121 242 245] \ #( ) ) > <primitive 112 temp 4 " printString " \ #( #[ 32 250 1 109 243 245] \ #( ) ) > <primitive 112 temp 5 " new: " \ #( #[ 33 250 1 115 243 245] \ #( ) ) > <primitive 112 temp 6 " deepCopy " \ #( #[ 32 250 1 107 243 245] \ #( ) ) > <primitive 112 temp 7 " copyFrom:length: " \ #( #[ 32 33 34 250 3 106 243 245] \ #( ) ) > <primitive 112 temp 8 " copyFrom:to: " \ #( #[ 32 33 34 33 193 81 192 250 3 106 243 245] \ #( ) ) > <primitive 112 temp 9 " compareError " \ #( #[ 32 48 188 243 245] \ #( 'strings can only be compared to strings' ) ) > <primitive 112 temp 10 " at:put: " \ #( #[ 32 33 34 250 3 105 242 245] \ #( ) ) > <primitive 112 temp 11 " at: " \ #( #[ 32 33 250 2 104 243 245] \ #( ) ) > <primitive 112 temp 12 " asSymbol " \ #( #[ 32 250 1 108 243 245] \ #( ) ) > <primitive 112 temp 13 " > " \ #( #[ 32 33 250 2 6 247 9 32 33 250 2 101 80 204 248 \ 4 242 32 10 19 243 245] \ #( ) ) > <primitive 112 temp 14 " >= " \ #( #[ 32 33 250 2 6 247 9 32 33 250 2 101 80 203 248 \ 4 242 32 10 19 243 245] \ #( ) ) > <primitive 112 temp 15 " <= " \ #( #[ 32 33 250 2 6 247 9 32 33 250 2 101 80 200 248 \ 4 242 32 10 19 243 245] \ #( ) ) > <primitive 112 temp 16 " < " \ #( #[ 32 33 250 2 6 247 9 32 33 250 2 101 80 199 248 \ 4 242 32 10 19 243 245] \ #( ) ) > <primitive 112 temp 17 " = " \ #( #[ 32 33 250 2 6 247 9 32 33 250 2 101 80 201 248 \ 4 242 32 10 19 243 245] \ #( ) ) > <primitive 112 temp 18 " , " \ #( #[ 32 33 250 2 103 243 245] \ #( ) ) > <primitive 98 #String \ <primitive 97 #String #ArrayedCollection #/u/smalltalk/prelude/string.st \ #( ) \ #( #sameAs: #size #print #printString #new: #deepCopy #copyFrom:length: #copyFrom:to: #compareError #at:put: #at: #asSymbol #> #>= #<= #< #= #, ) \ temp 3 5 > > SHAR_EOF if test 2112 -ne "`wc -c < 'prelude/string.p'`" then echo shar: error transmitting "'prelude/string.p'" '(should have been 2112 characters)' fi fi # end of overwriting check if test -f 'prelude/string.st' then echo shar: will not over-write existing file "'prelude/string.st'" else cat << \SHAR_EOF > 'prelude/string.st' Class String :ArrayedCollection [ , aString ^ <primitive 103 self aString> | = aString ^ <primitive 6 self aString> ifTrue: [<primitive 101 self aString> = 0] ifFalse: [self compareError] | < aString ^ <primitive 6 self aString> ifTrue: [<primitive 101 self aString> < 0] ifFalse: [self compareError] | <= aString ^ <primitive 6 self aString> ifTrue: [<primitive 101 self aString> <= 0] ifFalse: [self compareError] | >= aString ^ <primitive 6 self aString> ifTrue: [<primitive 101 self aString> >= 0] ifFalse: [self compareError] | > aString ^ <primitive 6 self aString> ifTrue: [<primitive 101 self aString> > 0] ifFalse: [self compareError] | asSymbol ^ <primitive 108 self> | at: aNumber ^ <primitive 104 self aNumber> | at: aNumber put: aChar <primitive 105 self aNumber aChar> | compareError ^ self error: 'strings can only be compared to strings' | copyFrom: start to: stop ^ <primitive 106 self start (stop - start + 1) > | copyFrom: start length: len ^ <primitive 106 self start len > | deepCopy ^ <primitive 107 self > | new: size ^ <primitive 115 size> | printString ^ <primitive 109 self> | print <primitive 121 self> | size ^ <primitive 100 self> | sameAs: aString ^ <primitive 6 self aString> ifTrue: [<primitive 102 self aString>] ifFalse: [self compareError] ] SHAR_EOF if test 1376 -ne "`wc -c < 'prelude/string.st'`" then echo shar: error transmitting "'prelude/string.st'" '(should have been 1376 characters)' fi fi # end of overwriting check if test -f 'prelude/symbol.p' then echo shar: will not over-write existing file "'prelude/symbol.p'" else cat << \SHAR_EOF > 'prelude/symbol.p' temp <- <primitive 110 3 > <primitive 112 temp 1 " asString " \ #( #[ 32 250 1 93 243 245] \ #( ) ) > <primitive 112 temp 2 " printString " \ #( #[ 32 250 1 92 243 245] \ #( ) ) > <primitive 112 temp 3 " == " \ #( #[ 32 33 250 2 6 247 7 32 33 250 2 91 248 2 242 \ 92 243 245] \ #( ) ) > <primitive 98 #Symbol \ <primitive 97 #Symbol #Object #/u/smalltalk/prelude/symbol.st \ #( ) \ #( #asString #printString #== ) \ temp 2 4 > > SHAR_EOF if test 452 -ne "`wc -c < 'prelude/symbol.p'`" then echo shar: error transmitting "'prelude/symbol.p'" '(should have been 452 characters)' fi fi # end of overwriting check if test -f 'prelude/symbol.st' then echo shar: will not over-write existing file "'prelude/symbol.st'" else cat << \SHAR_EOF > 'prelude/symbol.st' Class Symbol [ == aSymbol ^ <primitive 6 self aSymbol > ifTrue: [<primitive 91 self aSymbol >] ifFalse: [false] | printString ^ <primitive 92 self> | asString ^ <primitive 93 self> ] SHAR_EOF if test 200 -ne "`wc -c < 'prelude/symbol.st'`" then echo shar: error transmitting "'prelude/symbol.st'" '(should have been 200 characters)' fi fi # end of overwriting check if test -f 'prelude/test.st' then echo shar: will not over-write existing file "'prelude/test.st'" else cat << \SHAR_EOF > 'prelude/test.st' Class Test | var | [ printString ^ 'test value ', var printString | set: aVal var <- aVal ] SHAR_EOF if test 99 -ne "`wc -c < 'prelude/test.st'`" then echo shar: error transmitting "'prelude/test.st'" '(should have been 99 characters)' fi fi # end of overwriting check if test -f 'prelude/tests.st' then echo shar: will not over-write existing file "'prelude/tests.st'" else cat << \SHAR_EOF > 'prelude/tests.st' Class One | two | [ start ^ self one | one two <- Two new. two two: self | three two four ] Class Two [ two: back back three | four 'in four' print. self gak ] SHAR_EOF if test 180 -ne "`wc -c < 'prelude/tests.st'`" then echo shar: error transmitting "'prelude/tests.st'" '(should have been 180 characters)' fi fi # end of overwriting check if test -f 'prelude/true.p' then echo shar: will not over-write existing file "'prelude/true.p'" else cat << \SHAR_EOF > 'prelude/true.p' temp <- <primitive 110 5 > <primitive 112 temp 1 " not " \ #( #[ 92 243 245] \ #( ) ) > <primitive 112 temp 2 " ifFalse: " \ #( #[ 93 243 245] \ #( ) ) > <primitive 112 temp 3 " ifTrue: " \ #( #[ 33 165 243 245] \ #( ) ) > <primitive 112 temp 4 " ifFalse:ifTrue: " \ #( #[ 34 165 243 245] \ #( ) ) > <primitive 112 temp 5 " ifTrue:ifFalse: " \ #( #[ 33 165 243 245] \ #( ) ) > <primitive 98 #True \ <primitive 97 #True #Boolean #/u/smalltalk/prelude/true.st \ #( ) \ #( #not #ifFalse: #ifTrue: #ifFalse:ifTrue: #ifTrue:ifFalse: ) \ temp 3 2 > > SHAR_EOF if test 577 -ne "`wc -c < 'prelude/true.p'`" then echo shar: error transmitting "'prelude/true.p'" '(should have been 577 characters)' fi fi # end of overwriting check if test -f 'prelude/true.st' then echo shar: will not over-write existing file "'prelude/true.st'" else cat << \SHAR_EOF > 'prelude/true.st' Class True :Boolean [ ifTrue: trueAlternativeBlock ifFalse: falseAlternativeBlock ^ trueAlternativeBlock value ! ifFalse: falseAlternativeBlock ifTrue: trueAlternativeBlock ^ trueAlternativeBlock value ! ifTrue: trueAlternativeBlock ^ trueAlternativeBlock value ! ifFalse: falseAlternativeBlock ^ nil | not ^ false ] SHAR_EOF if test 433 -ne "`wc -c < 'prelude/true.st'`" then echo shar: error transmitting "'prelude/true.st'" '(should have been 433 characters)' fi fi # end of overwriting check if test -f 'projects/8queen.st' then echo shar: will not over-write existing file "'projects/8queen.st'" else cat << \SHAR_EOF > 'projects/8queen.st' Class Main [ main | lq | lq <- nil. (1 to: 8) do: [:i | lq <- Queen new ; setColumn: i neighbor: lq]. lq first. lq printBoard. lq next. lq printBoard. ] Class Queen | row column neighbor | [ setColumn: aNumber neighbor: aQueen column <- aNumber. neighbor <- aQueen | first (neighbor notNil) ifTrue: [neighbor first]. row <- 1. ^ self testPosition | next (row = 8) ifTrue: [((neighbor isNil) or: [neighbor next isNil]) ifTrue: [ ^ nil ]. row <- 0 ]. row <- row + 1. ^ self testPosition | testPosition (neighbor isNil) ifTrue: [ ^ row ]. (neighbor checkRow: row column: column) ifTrue: [ ^ self next ] ifFalse: [ ^ row ] | checkRow: testRow column: testColumn | columnDifference | columnDifference <- testColumn - column. (((row = testRow) or: [row + columnDifference = testRow]) or: [row - columnDifference = testRow]) ifTrue: [^ true]. (neighbor notNil) ifTrue: [^ neighbor checkRow: testRow column: testColumn] ifFalse: [ ^ false ] | printBoard (neighbor notNil) ifTrue: [ neighbor printBoard ]. ('column ', column printString, ' row ', row printString) print ] SHAR_EOF if test 1161 -ne "`wc -c < 'projects/8queen.st'`" then echo shar: error transmitting "'projects/8queen.st'" '(should have been 1161 characters)' fi fi # end of overwriting check if test -f 'projects/READ_ME' then echo shar: will not over-write existing file "'projects/READ_ME'" else cat << \SHAR_EOF > 'projects/READ_ME' This is a directory of various projects submitted by various students. No guarentee if any of them work with the current system, or even if they work at all. (note - in order to save files, many directories have been converted into bundles. to recreate, create a directory and sh the files.) /browser - an attempt at a ``browser'', actually some of these ideas are quite good, and will probably be included in some future distibution /history - a ``history'' mechanism, similar to csh /window - a window package based upon the Maryland Windows package /simulation - an ice cream store simulation /generator - various playthings for manipulating monadic generators SHAR_EOF if test 672 -ne "`wc -c < 'projects/READ_ME'`" then echo shar: error transmitting "'projects/READ_ME'" '(should have been 672 characters)' fi fi # end of overwriting check if test -f 'projects/abgen.st' then echo shar: will not over-write existing file "'projects/abgen.st'" else cat << \SHAR_EOF > 'projects/abgen.st' Class AbstractGenerator :Generator | baseGenerator initBlock control transform | [ gen: aGenerator init: aBlock control: controlBlock transform: transformBlock baseGenerator <- aGenerator. initBlock <- aBlock. control <- controlBlock. transform <- transformBlock | first | item | initBlock value. item <- baseGenerator first. (item isNil) ifTrue: [^nil] ifFalse: [^ self computeValue: item ] | next ^ self computeValue: (baseGenerator next) | computeValue: aValue ^ Switch new: (control value: aValue) ; case: 1 do: [^ nil] ; case: 2 do: [^ self next] ; case: 3 do: [^ transform value: aValue ] ; case: 4 do: [^ self first ] ; default: ['compute value' print. aValue print] ] SHAR_EOF if test 727 -ne "`wc -c < 'projects/abgen.st'`" then echo shar: error transmitting "'projects/abgen.st'" '(should have been 727 characters)' fi fi # end of overwriting check if test -f 'projects/browser.st' then echo shar: will not over-write existing file "'projects/browser.st'" else cat << \SHAR_EOF > 'projects/browser.st' Class Browser :KeyedCollection |editor sysdir tempfile parser| [ at: aKey ^ <primitive 160 aKey> | at: aKey put: aClass <primitive 98 aKey aClass> | currentKey ^ <primitive 164> | first ^ <primitive 162> | next ^ <primitive 163> | removeKey: aKey ^ <primitive 161 aKey> | removeKey: aKey ifAbsent: errBlock ((self at: aKey) isNil) ifTrue:[^ errBlock] ifFalse:[^ <primitive 161 aKey>] | size ^ <primitive 165> | setEditor: astring (astring class == String) ifTrue:[editor <- astring] ifFalse:['editor must string' print] | getEditor ^ editor | setSysDir: astring (astring class == String) ifTrue:[sysdir <- astring] ifFalse:['system directory must be string' print] | list self do:[:x | x print] | listsys |s| self do:[:x | s <- (s <- ((x filename asString) copyFrom:1 length:(sysdir size))). (s sameAs: sysdir) ifTrue:[x print] ] | listnosys |s| self do:[:x | s <- (s <- ((x filename asString) copyFrom:1 length:(sysdir size))). (s sameAs: sysdir) ifFalse:[x print] ] | listsub: aclass self do:[:x | ((x superClass ) == aclass) ifTrue:[x print] ] | edit: aclass |x| x <- editor , ' ', ( aclass filename asString). <primitive 167 x> | include: afilename |x| x <- parser , ' ', afilename , ' >' ,tempfile. (<primitive 167 x> = 0) ifTrue:[<primitive 168 tempfile>] ifFalse:['could not include file' print] | setParser: astring parser <- astring | getParser ^ parser | setTempfile: astring tempfile <- astring | getTempfile ^ tempfile | delete: aclass self removeKey:(aclass asSymbol) ifAbsent:['no such class' print] | test 'yeaa it works 333222 ' print ] SHAR_EOF if test 2529 -ne "`wc -c < 'projects/browser.st'`" then echo shar: error transmitting "'projects/browser.st'" '(should have been 2529 characters)' fi fi # end of overwriting check if test -f 'projects/class.st' then echo shar: will not over-write existing file "'projects/class.st'" else cat << \SHAR_EOF > 'projects/class.st' Class Class [ edit <primitive 150 self> | list <primitive 157 self> | new | superclass newinstance | superclass <- <primitive 151 self>. <primitive 3 superclass > ifTrue: [newinstance <- superclass new ]. newinstance <- <primitive 153 self newinstance >. <primitive 155 self #new > ifTrue: [newinstance <- newinstance new]. ^ newinstance | new: aValue | superclass newinstance | superclass <- <primitive 151 self>. <primitive 3 superclass > ifTrue: [newinstance <- superclass new ]. newinstance <- <primitive 153 self newinstance >. <primitive 155 self #new: > ifTrue: [newinstance <- newinstance new: aValue ]. ^ newinstance | printString ^ <primitive 152 self > | respondsTo <primitive 154 self> | respondsTo: aSymbol ^ <primitive 155 self aSymbol> | superClass ^ <primitive 151 self> | view <primitive 156 self> | filename ^ <primitive 166 self> | isSys |s| :q ] SHAR_EOF if test 1402 -ne "`wc -c < 'projects/class.st'`" then echo shar: error transmitting "'projects/class.st'" '(should have been 1402 characters)' fi fi # end of overwriting check if test -f 'projects/cldict.c' then echo shar: will not over-write existing file "'projects/cldict.c'" else cat << \SHAR_EOF > 'projects/cldict.c' /* Little Smalltalk Internal class dictionary timothy a. budd, 10/84 */ # include <stdio.h> # include "object.h" # include "string.h" # include "primitive.h" struct class_entry { char *cl_name; object *cl_description; struct class_entry *cl_link; }; static struct class_entry *class_dictionary = 0; static struct class_entry *current = 0; static int size = 0; enter_class(name, description) char *name; object *description; { struct class_entry *p; for (p = class_dictionary; p; p = p->cl_link) if (strcmp(name, p->cl_name) == 0) { assign(p->cl_description, description); return; } /* not found, make a new entry */ size++; p = structalloc(struct class_entry); p->cl_name = name; sassign(p->cl_description, description); p->cl_link = class_dictionary; class_dictionary = p; } object *lookup_class(name) char *name; { struct class_entry *p; for (p = class_dictionary; p; p = p->cl_link) if (strcmp(name, p->cl_name) == 0) return(p->cl_description); return((object *) 0); } object *delete_class(name) char *name; { struct class_entry *p,*last; object *del_class; if (class_dictionary == 0) return((object *) 0); last = (struct class_entry *) 0; for (p = class_dictionary; p; p = p->cl_link) { if (strcmp(name,p->cl_name) == 0) { if (last) last->cl_link = p->cl_link; else class_dictionary = p->cl_link; del_class = p->cl_description; if (current == p) current = p->cl_link; free(p); size --; return(del_class); } last = p; } return((object *) 0); } free_all_classes() { struct class_entry *p; for (p = class_dictionary; p; p = p->cl_link) { obj_dec(p->cl_description); } } class_list() { struct class_entry *p; for (p = class_dictionary; p; p = p->cl_link) { primitive(SYMPRINT, 1, &(((class *) p->cl_description)->class_name)); } } object *class_first() { current = class_dictionary; return(current->cl_description); } object *class_next() { if (current) current = current->cl_link; if (current) return(current->cl_description); return((object *) 0); } char *class_current() { if (current) return(current->cl_name); return((char *) 0); } int class_size() { return(size); } SHAR_EOF if test 2805 -ne "`wc -c < 'projects/cldict.c'`" then echo shar: error transmitting "'projects/cldict.c'" '(should have been 2805 characters)' fi fi # end of overwriting check if test -f 'projects/cursin.c' then echo shar: will not over-write existing file "'projects/cursin.c'" else cat << \SHAR_EOF > 'projects/cursin.c' #include <stdio.h> #include <curses.h> #include <setjmp.h> #include <sgtty.h> #include <fcntl.h> #include <errno.h> # include "cursin.h" # define fnull ((forest)0) # define cnull ((char)0) /* written by Gary Levin, minor modifications by Kelvin Nilsen */ /* forest is the binary representation of a labeled tree in_label is the label of the incoming branch (null for root) translation is the translation of the string formed by the labels from the root to the leaf (null for non-leaves) */ typedef struct Fnode * forest; struct Fnode { forest first_child, sibling; char in_label; enum log_symbol translation; }; forest str_to_forest(); forest makeFnode(); bool not_init = TRUE; bool cursin_error = FALSE; bool use_defaults = FALSE; forest translate_tree; log_char back_char; /* cursinit() initialize the cursor input processor */ cursinit(){ char buffer[20]; char *p; forest f; int cnt; not_init = FALSE; f = fnull; p=buffer; printf("%s",tgetstr("ks", &p)); f = str_to_forest("\04",f,Leof); /* ^D */ p = buffer; if (tgetstr("ku", &p) && !use_defaults) f = str_to_forest(buffer,f,Lu); else f = str_to_forest("\5",f,Lu); /* ^E */ p = buffer; if (tgetstr("kd", &p) && !use_defaults) f = str_to_forest(buffer,f,Ld); else f = str_to_forest("\30",f,Ld); /* ^X */ p = buffer; if (tgetstr("kl", &p) && !use_defaults) f = str_to_forest(buffer,f,Ll); else f = str_to_forest("\32",f,Ll); /* ^Z */ p = buffer; if (tgetstr("kb", &p) && !use_defaults) f = str_to_forest(buffer,f,Lb); else f = str_to_forest("\10",f,Lb); /* ^H */ p = buffer; if (tgetstr("kr", &p) && !use_defaults) f = str_to_forest(buffer,f,Lr); else f = str_to_forest("\03",f,Lr); /* ^C */ p = buffer; if (tgetstr("kh", &p) && !use_defaults) f = str_to_forest(buffer,f,Lh); else f = str_to_forest("\07",f,Lh); /* ^G */ cnt = tgetnum("kn"); if (cnt > 0 && !use_defaults) { p=buffer; f = str_to_forest(tgetstr("k0",&p),f,Lfr); } else f = str_to_forest("\06",f,Lfr); /* ^F */ if (cnt > 1 && !use_defaults) { p=buffer; f = str_to_forest(tgetstr("k1",&p),f,Lfl); } else f = str_to_forest("\01",f,Lfl); /* ^A */ if (cnt > 2 && !use_defaults) { p=buffer; f = str_to_forest(tgetstr("k2",&p),f,Leol); } else f = str_to_forest("\24",f,Leol); /* ^T */ if (cnt > 3 && !use_defaults) { p=buffer; f = str_to_forest(tgetstr("k3",&p),f,Ldc); } else f = str_to_forest("\177",f,Ldc); /* rubout */ if (cnt > 4 && !use_defaults) { p=buffer; f = str_to_forest(tgetstr("k4",&p),f,Ldw); } else f = str_to_forest("\27",f,Ldw); /* ^W */ if (cnt > 5 && !use_defaults) { p=buffer; f = str_to_forest(tgetstr("k5",&p),f,Ldl); } else f = str_to_forest("\14",f,Ldl); /* ^L */ if (cnt > 6 && !use_defaults) { p=buffer; f = str_to_forest(tgetstr("k6",&p),f,Ldeol); } else f = str_to_forest("\31",f,Ldeol); /* ^Y */ translate_tree = f; if( cursin_error && !use_defaults ) { cursin_error = FALSE; use_defaults = TRUE; cleanup(); cursinit(); } else if (cursin_error) cant_happen(30); } /* str_to_forest(s,f,c) returns the forest that results from adding a path for S to F with translation C. prints error message and calls die if S is contained in any path already in F or if S extends a previous leaf (this would indicate that some paths are prefixes) */ forest str_to_forest(s,f,c) char * s; forest f; enum log_symbol c; { forest root; if( *s == cnull ) return(f); root = f; /* f:= &Fnode (among sibs of root) with in_label = *s, fnull o.w. */ while( f != fnull && f->in_label != *s ) { f = f->sibling; } if( *(s+1) != cnull ){ if( f != fnull ) { if( f->first_child == fnull ) cursin_error = TRUE; else f->first_child = str_to_forest(s+1, f->first_child, c); return( root ); } else return( makeFnode( str_to_forest(s+1,fnull,c), root, *s, lnull)); } else{ if( f == fnull ) return makeFnode( fnull, root, *s, c); if(f->translation == c) return root; cursin_error = TRUE; return root; } } /* makeFnode allocates a Fnode and initializes the fields */ forest makeFnode(first,sib,in_c,trans) forest first,sib; char in_c; enum log_symbol trans; { forest temp; temp = (forest) malloc( sizeof * temp ); if( temp==0 ) cursin_error = TRUE; temp-> first_child = first; temp-> sibling = sib; temp-> in_label = in_c; temp-> translation = trans; return( temp ); } static char workc = 0; static forest workt; /* cursin() read the next logical character using getch (see curses) */ log_char cursin() { char c; log_char retv; if (workt) /* then we previously jumped away from input */ { workc = input(); /* finish the input */ retv = look_up(); workt = 0; return retv; } else { c = input(); workc = c; workt = translate_tree; retv = look_up(); workt = 0; return retv; } } /* look_up(c,f) if C is not one of the in_labels for the roots of forest F, return C as a non-logical character otherwise if C is the in_label of a leaf, return the translation as a logical character otherwise lookup the rest of the input in the children of C */ log_char look_up() { log_char lc; while( workt != fnull && workt->in_label != workc ){ workt = workt->sibling; } if( workt == fnull) { lc.logical = FALSE; lc.symbol = workc; return( lc ); } if( workt->first_child == fnull ){ lc.logical = TRUE; lc.symbol = (char) workt->translation; return( lc ); } workt = workt->first_child; workc = input(); return look_up(); } cleanup(f) forest f; { if (f != fnull) { cleanup(f->first_child); cleanup(f->sibling); free(f); } } extern int block; /* should we block or jump out? */ extern int inisstd; /* input is stdin? */ extern FILE *fdstack[]; extern int fdtop; extern jmp_buf lin_top; extern int errno; /** input - input a character, may jump out if not ready */ input() { static int c; long numchars; static int eof_found = FALSE; if (eof_found) longjmp(lin_top, 1); /* return -1 */ if (!inisstd) /* isatty? */ { if (((c = fgetc(fdstack[fdtop])) == EOF) || c == 'D'-'@') { fclose(fdstack[fdtop--]); if (fdtop < 0) { eof_found = TRUE; longjmp(lin_top, 1); /* return -1 */ } inisstd = (fdstack[fdtop] == stdin); return input(); } else return c; } else { if (!block) { int fil_flags; fil_flags = fcntl(0, F_GETFL, 0); fcntl(0, F_SETFL, fil_flags | FNDELAY); if (read(0, &c, 1) != 1) { int sav_err; sav_err = errno; fcntl(0, F_SETFL, fil_flags); if (sav_err == EWOULDBLOCK) longjmp(lin_top, 2); /* return 0 */ else /* assume eof */ { eof_found = TRUE; longjmp(lin_top, 1); /* return -1 */ } } fcntl(0, F_SETFL, fil_flags); } else if (read(0, &c, 1) != 1) { eof_found = -1; longjmp(lin_top, 1); /* return -1 */ } if (c == 'D'-'@') { eof_found = -1; longjmp(lin_top, 1); /* return -1 */ } return c; } } SHAR_EOF if test 7201 -ne "`wc -c < 'projects/cursin.c'`" then echo shar: error transmitting "'projects/cursin.c'" '(should have been 7201 characters)' fi fi # end of overwriting check if test -f 'projects/cursin.h' then echo shar: will not over-write existing file "'projects/cursin.h'" else cat << \SHAR_EOF > 'projects/cursin.h' typedef struct{ bool logical; char symbol; } log_char; typedef log_char * ptr_log_char; extern log_char cursin(); extern push_back(); extern log_char look_up(); /* Logical characters (may be represented by */ /* multiple character sequences) */ /* */ /* Lb = backspace, Lh = home, */ /* Lu, Ld, Ll, Lr are the arrows keys */ enum log_symbol { lnull, Leof, Lb, Ld, Lh, Ll, Lr, Lu, Lfr, Lfl, Leol, Ldc, Ldw, Ldl, Ldeol }; SHAR_EOF if test 451 -ne "`wc -c < 'projects/cursin.h'`" then echo shar: error transmitting "'projects/cursin.h'" '(should have been 451 characters)' fi fi # end of overwriting check if test -f 'projects/defs.h' then echo shar: will not over-write existing file "'projects/defs.h'" else cat << \SHAR_EOF > 'projects/defs.h' #define RTARROW Lr #define LTARROW Ll #define UPARROW Lu #define DNARROW Ld #define FRTARROW Lfr #define FLTARROW Lfl #define MVEOL Leol #define MVBOL Lh #define DCHAR Ldc #define DPCHAR Lb #define DWORD Ldw #define DLINE Ldl #define DEOLINE Ldeol #define LEOF Leof #define MAX_HIST 8192 #define MAX_INSTR 512 SHAR_EOF if test 312 -ne "`wc -c < 'projects/defs.h'`" then echo shar: error transmitting "'projects/defs.h'" '(should have been 312 characters)' fi fi # end of overwriting check if test -f 'projects/env.h' then echo shar: will not over-write existing file "'projects/env.h'" else cat << \SHAR_EOF > 'projects/env.h' /* Little Smalltalk execution environment definitions. The Little Smalltalk system is tailored to various machines by changing defined constants. These constants, and their meanings, are as follows: GAMMA defined if gamma is part of the math library FACTMAX maximum integer value for which a factorial can be computed by repeated multiplication without overflow. INLINE generate inline code for increments or decrements - produces larger, but faster, code. MDWINDOWS defined if the maryland windows package is used OPEN42 defined if berkeley style (3 argument) opens are used In addition to defining constants, the identifier type ``undefined character'' needs to be defined. Bytecodes are stored using this datatype. On machines which do not support this datatype directly, macros need to be defined that convert normal chars into unsigned chars. unsigned chars are defined by a typedef for ``uchar'' and a pair of macros that convert an int into a uchar and vice-versa. In order to simplify installation on systems to which the Little Smalltalk system has already been ported, various ``meta-defines'' are recognized. By defining one of these symbols, the correct definitions for other symbols will automatically be generated. The currently recognized meta-defines are as follows: BERK42 Vax Berkeley 4.2 DECPRO Dec Professional 350 running Venix PDP1170 PdP 11/70 RIDGE Ridge ROS 3.1 Finally, a few path names have to be compiled into the code. These path names are the following: TEMPFILE - a temporary file name in mktemp format PARSER - the location of the parser PRELUDE - the location of the standard prelude in ascii format FAST - the location of the standard prelude in saved format */ # define TEMPFILE "/usr/tmp/stXXXXXX" # define PARSER "/usr/budd/st80/bin/parse" # define PRELUDE "/usr/budd/st80/prelude/standard" # define FAST "/usr/budd/st80/prelude/stdsave" /* meta-define */ # define BERK42 /*------------------------------ VAX Berkeley 4.2 definition */ # ifdef BERK42 # define GAMMA /* gamma value is known */ # define FACTMAX 12 # define OPEN42 /* use 4.2 style opens */ typedef unsigned char uchar; # define itouc(x) ((uchar) x) # define uctoi(x) ((int) x) /* # define MDWINDOWS */ # endif /* BERK42 definition */ /* ---------------------------------------RIDGE ROS 3.1 definition */ # ifdef RIDGE # define GAMMA /* gamma value is known */ # define FACTMAX 12 # define OPEN42 /* use 4.2 style opens */ typedef unsigned char uchar; # define itouc(x) ((uchar) x) # define uctoi(x) ((int) x) # endif /* RIDGE definition */ /* --------------------------------------------DEC PRO definitions */ # ifdef DECPRO /* GAMMA, OPEN42 not defined */ # define FACTMAX 6 /* unsigned characters not supported, but can be simulated */ typedef char uchar; # define itouc(x) ((uchar) x) # define uctoi(x) (unsigned) (x >= 0 ? x : x + 256) # endif /* DECPRO definition */ /* --------------------------------------------PDP11/70 definitions */ # ifdef PDP1170 /* GAMMA, OPEN42 not defined */ # define FACTMAX 6 /* unsigned characters not supported, but can be simulated */ typedef char uchar; # define itouc(x) ((uchar) x) # define uctoi(x) (unsigned) (x >= 0 ? x : x + 256) # endif /* PDP1170 definition */ /******************************************************************/ /* the following are pretty much independent of any system */ # define INLINE /* produce in line code for incs and decs */ /*# define MDWINDOWS*/ /* maryland windows package available */ SHAR_EOF if test 3525 -ne "`wc -c < 'projects/env.h'`" then echo shar: error transmitting "'projects/env.h'" '(should have been 3525 characters)' fi fi # end of overwriting check if test -f 'projects/generator.bund' then echo shar: will not over-write existing file "'projects/generator.bund'" else cat << \SHAR_EOF > 'projects/generator.bund' : To unbundle, sh this file echo unbundling 8queen.st 1>&2 cat >8queen.st <<'End' Class Main [ main | lq | lq <- nil. (1 to: 8) do: [:i | lq <- Queen new ; setColumn: i neighbor: lq]. lq first. lq printBoard. lq next. lq printBoard. ] Class Queen | row column neighbor | [ setColumn: aNumber neighbor: aQueen column <- aNumber. neighbor <- aQueen | first (neighbor notNil) ifTrue: [neighbor first]. row <- 1. ^ self testPosition | next (row = 8) ifTrue: [((neighbor isNil) or: [neighbor next isNil]) ifTrue: [ ^ nil ]. row <- 0 ]. row <- row + 1. ^ self testPosition | testPosition (neighbor isNil) ifTrue: [ ^ row ]. (neighbor checkRow: row column: column) ifTrue: [ ^ self next ] ifFalse: [ ^ row ] | checkRow: testRow column: testColumn | columnDifference | columnDifference <- testColumn - column. (((row = testRow) or: [row + columnDifference = testRow]) or: [row - columnDifference = testRow]) ifTrue: [^ true]. (neighbor notNil) ifTrue: [^ neighbor checkRow: testRow column: testColumn] ifFalse: [ ^ false ] | printBoard (neighbor notNil) ifTrue: [ neighbor printBoard ]. ('column ', column printString, ' row ', row printString) print ] End echo unbundling abgen.st 1>&2 cat >abgen.st <<'End' Class AbstractGenerator :Generator | baseGenerator initBlock control transform | [ gen: aGenerator init: aBlock control: controlBlock transform: transformBlock baseGenerator <- aGenerator. initBlock <- aBlock. control <- controlBlock. transform <- transformBlock | first | item | initBlock value. item <- baseGenerator first. (item isNil) ifTrue: [^nil] ifFalse: [^ self computeValue: item ] | next ^ self computeValue: (baseGenerator next) | computeValue: aValue ^ Switch new: (control value: aValue) ; case: 1 do: [^ nil] ; case: 2 do: [^ self next] ; case: 3 do: [^ transform value: aValue ] ; case: 4 do: [^ self first ] ; default: ['compute value' print. aValue print] ] End echo unbundling generator.st 1>&2 cat >generator.st <<'End' Class Generator :Collection [ select: aBlock ^ AbstractGenerator new ; gen: self init: [] control: [:x | (x isNil) ifTrue: [1] ifFalse: [(aBlock value: x) ifTrue: [3] ifFalse: [2] ] ] transform: [:x | x ] | collect: aBlock ^ AbstractGenerator new ; gen: self init: [] control: [:x | (x isNil) ifTrue: [1] ifFalse: [3]] transform: aBlock | until: aBlock ^ AbstractGenerator new ; gen: self init: [] control: [:x | ((x isNil) or: [ aBlock value: x ]) ifTrue: [1] ifFalse: [3] ] transform: [:x | x ] | while: aBlock ^ AbstractGenerator new ; gen: self init: [] control: [:x | ((x notNil) and: [ aBlock value: x]) ifTrue: [3] ifFalse: [1] ] transform: [:x | x ] | first: limit | counter | ^ AbstractGenerator new ; gen: self init: [counter <- 0] control: [:x | ((x notNil) and: [(counter <- counter + 1) <= limit]) ifTrue: [3] ifFalse: [1] ] transform: [:x | x] | repeated ^ AbstractGenerator new ; gen: self init: [] control: [:x | (x isNil) ifTrue: [4] ifFalse: [3] ] transform: [:x | x] ] End echo unbundling primes.st 1>&2 cat >primes.st <<'End' Class Primes :Generator | primeGenerator lastPrime | [ first primeGenerator <- 2 to: 20. ^ lastPrime <- primeGenerator first | next primeGenerator <- Factor new; gen: primeGenerator factor: lastPrime. ^ lastPrime <- primeGenerator next ] Class Factor | baseGenerator myFactor | [ gen: aGen factor: aFactor baseGenerator <- aGen. myFactor <- aFactor | next | possible | [ (possible <- baseGenerator next) notNil ] whileTrue: [ (possible \\ myFactor ~= 0) ifTrue: [ ^ possible ] ]. ^ nil ] End echo unbundling switch.st 1>&2 cat >switch.st <<'End' Class Switch | key found | [ new: aKey found <- false. key <- aKey | case: test do: aBlock (key = test) ifTrue: [found <- true. aBlock value] | default: aBlock found ifFalse: aBlock ] End SHAR_EOF if test 4089 -ne "`wc -c < 'projects/generator.bund'`" then echo shar: error transmitting "'projects/generator.bund'" '(should have been 4089 characters)' fi fi # end of overwriting check if test -f 'projects/generator.st' then echo shar: will not over-write existing file "'projects/generator.st'" else cat << \SHAR_EOF > 'projects/generator.st' Class Generator :Collection [ select: aBlock ^ AbstractGenerator new ; gen: self init: [] control: [:x | (x isNil) ifTrue: [1] ifFalse: [(aBlock value: x) ifTrue: [3] ifFalse: [2] ] ] transform: [:x | x ] | collect: aBlock ^ AbstractGenerator new ; gen: self init: [] control: [:x | (x isNil) ifTrue: [1] ifFalse: [3]] transform: aBlock | until: aBlock ^ AbstractGenerator new ; gen: self init: [] control: [:x | ((x isNil) or: [ aBlock value: x ]) ifTrue: [1] ifFalse: [3] ] transform: [:x | x ] | while: aBlock ^ AbstractGenerator new ; gen: self init: [] control: [:x | ((x notNil) and: [ aBlock value: x]) ifTrue: [3] ifFalse: [1] ] transform: [:x | x ] | first: limit | counter | ^ AbstractGenerator new ; gen: self init: [counter <- 0] control: [:x | ((x notNil) and: [(counter <- counter + 1) <= limit]) ifTrue: [3] ifFalse: [1] ] transform: [:x | x] | repeated ^ AbstractGenerator new ; gen: self init: [] control: [:x | (x isNil) ifTrue: [4] ifFalse: [3] ] transform: [:x | x] ] SHAR_EOF if test 1152 -ne "`wc -c < 'projects/generator.st'`" then echo shar: error transmitting "'projects/generator.st'" '(should have been 1152 characters)' fi fi # end of overwriting check if test -f 'projects/hanoi' then echo shar: will not over-write existing file "'projects/hanoi'" else cat << \SHAR_EOF > 'projects/hanoi' From rogerh Fri Dec 14 14:11:54 1984 Received: by arizona.UUCP (4.12/4.7) id AA07979; Fri, 14 Dec 84 14:11:36 mst Date: Fri, 14 Dec 84 14:11:36 mst From: rogerh (Roger Hayes) Message-Id: <8412142111.AA07979@arizona.UUCP> To: budd Subject: hanoi.st Status: R Class Hanoi | a b c | [ new a <- Pole new: 10. b <- Pole new: 300. c <- Pole new: 600 | setup | screen rop d | screen <- Form new becomeScreen. rop <- RasterOp new. rop destForm: screen. rop dest: 0@0. rop extent: screen extent. rop rule: (rop ruleFor: #white). rop copyBits. (4 to: 1 by: -1) do: [ :n | d <- Disk new: n. (d isNil) ifTrue: [ ^ nil]. d moveTo: a horiz. a push: d. ] | exec self move: 4 from: a to: b using: c. ^ 'Done!' | move: n from: s to: d using: x (n > 1) ifTrue: [ self move: (n-1) from: s to: x using: d. self moveTop: s to: d. self move: (n-1) from: x to: d using: s ] ifFalse: [ self moveTop: s to: d ] | moveTop: pole1 to: pole2 | disk | disk <- pole1 pop. disk moveTo: (pole2 horiz). pole2 push: disk ] Class Pole | disks horiz nextVert | [ horiz ^ horiz | pop | d | d <- disks removeLast. d pop. nextVert <- nextVert + d thickness. ^ d | push: d disks addLast: d. nextVert <- nextVert - d thickness. d push: nextVert | new: aNumber nextVert <- 400. disks <- OrderedCollection new. horiz <- aNumber ] Class Disk | form pos rop | [ new: size form <- Form new read: ('d',(size asString),'Form'). (form extent x = 0) ifTrue: [ ^ self error: 'cant find disc ', (size asString)]. rop <- RasterOp new. rop sourceForm: form. rop source: 0 @ 0. rop rule: (rop ruleFor: #copy). rop destForm: (Form new becomeScreen). rop dest: 0 @ 0. rop extent: form extent. pos <- 0 @ 0 | thickness ^ form extent y | moveTo: x | i | (x < (pos x)) ifTrue: [i <- -3] ifFalse: [i <- 3]. ((pos x) to: x by: i) do: [ :newx | rop dest: newx @ (pos y). rop copyBits]. pos <- rop dest | pop " take self off pole " ((pos y) downTo: (200 - self thickness)) do: [ :y | rop dest: (pos x) @ y. rop copyBits]. " elevate to transport level " ((rop dest y) downTo: 150) do: [ :y | rop dest: (pos x) @ y. rop copyBits]. pos <- rop dest | push: y | thisx | " descend to top of rod " thisx <- pos x. ((pos y) to: 200) do: [ :y | rop dest: thisx @ y. rop copyBits]. " impale self " (200 to: y) do: [ :y | rop dest: thisx @ y. rop copyBits]. pos <- rop dest ] SHAR_EOF if test 4047 -ne "`wc -c < 'projects/hanoi'`" then echo shar: error transmitting "'projects/hanoi'" '(should have been 4047 characters)' fi fi # end of overwriting check if test -f 'projects/his.c' then echo shar: will not over-write existing file "'projects/his.c'" else cat << \SHAR_EOF > 'projects/his.c' #include <stdio.h> #include <sgtty.h> #include <ctype.h> #include <curses.h> #include "cursin.h" #include "pat.h" #include "defs.h" /* taken from curses.h and modified */ #define cbreak() (_tty.sg_flags|=CBREAK, _pfast=_rawmode=TRUE, stty(_tty_ch,&_tty)) #define nocbreak() (_tty.sg_flags&=~CBREAK,_rawmode=FALSE,_pfast=!(_tty.sg_flags&CRMOD),stty(_tty_ch,&_tty)) extern char spat[]; char *fix_line(); /* what is the basic unit of manipulation by the history manager? A complete instruction (this may be multiple lines) How do we deal with commands that wrap around? Move the whole word to the next line, indent, and place a '\' in the last column of the preceding line. Implicitly, reform paragraphs? No, users may want to be able to control where the line breaks. always assume nothing on screen beneath current position has any significance some terminals permit the placement of characters in the bottom right without scrolling, others scroll automatically. Two solutions: Always explicitly scroll anytime anyone wants to put a character in the questionable position. After putting a character in the questionable position, always check to see what the current cursor is. I like the first option better, it allows me to always do the same thing, regardless of the current terminal type. */ /* keep global variables for */ int totrows, totcols; /* total number of rows, columns on terminal */ char history[MAX_HIST]; /* history buffer */ char *sohist = history; char *eohist = history; int his_cnt = 0; /* how many characters in history */ static char *cur_his; /* points to current focus of interest within history buffer */ #define hnext(p) (p+1 >= history+MAX_HIST)? history: p+1 #define hprev(p) (p > history)? p-1: history+MAX_HIST-1 char termbuf[1024]; setup() { char *cp, *getenv(); if (tgetent(termbuf, getenv("TERM")) != 1) cant_happen(31); totrows = tgetnum("li"); totcols = tgetnum("co"); if (totrows == -1 || totcols == -1) cant_happen(32); cursinit(); initscr(); clear(); /* clear the screen */ raw(); /* set to raw mode */ noecho(); /* don't implicitly echo characters */ scrollok(stdscr, TRUE); move(0,0); refresh(); } finish() { noraw(); echo(); endwin(); } /* update, starting on specified row, rewrite the instruction in its entirety, leaving cursor over specified character, assume the instruction conforms to the following: The first line has no more than 71 characters Subsequent lines have no more than 63 characters No more than 24 lines total. Each character except '\n' occupy a single position on terminal screen All but last line are terminated with '\' Returns the row number of the start of the instruction, as it now stands. */ update(text, top_row, cursor) char *text; int top_row; char *cursor; /* index of cursor position within text. - if index of new line or null terminator, then position cursor after last character of line */ { int nurow, nucol; register int i, j; nurow = -1; for(i=0; ; i++) { int indent; move(top_row+i, 0); if (i) indent = 12; else indent = 8; while (isspace(*text)) text++; for(j=indent; j--; ) addch(' '); for(j=0; ; j++) { if (nurow == -1 && text >= cursor) { nurow = i; nucol = j + indent; } /* should we adjust cursor? */ if (*text == '\n') addch('\\'); if (*text) addch(*text); else { if (i + top_row >= totrows) top_row -= totrows + 1 -(i + top_row); clrtobot(); move(nurow + top_row, nucol); refresh(); return top_row; } if (*text++ == '\n') break; } } } char ins_buf[1024]; /* edit the current command line, after printing its current state on the terminal */ get_instruction() { static char *workbuf; static char *textp; register char *scp, *dcp; static int ccnt; static int processing = 0; static int top_row; workbuf = ins_buf; if (!processing) { int crow, ccol; cur_his = eohist; ccnt = 0; workbuf[0] = '\0'; textp = workbuf; getyx(stdscr, crow, ccol); top_row = crow; processing = TRUE; } for(;;) { log_char c; top_row = update(workbuf, top_row, textp); c = cursin(); if (c.logical) { switch((enum log_symbol) c.symbol) { case LEOF: cant_happen(33); case RTARROW: if (*textp) textp++; else beep(); break; case LTARROW: if (textp > workbuf) textp--; else beep(); break; case UPARROW: *textp = '\0'; ccnt = uphist(workbuf); textp = workbuf; break; case DNARROW: *textp = '\0'; ccnt = dnhist(workbuf); textp = workbuf; break; case FRTARROW: if (!*textp) { beep(); break; } textp++; for( ; *textp && !isspace(*textp); ) textp++; /* skip current word */ for( ; *textp && isspace(*textp); ) textp++; /* and space that follows */ break; case FLTARROW: if (textp <= workbuf) { beep(); break; } textp--; for( ; textp > workbuf && isspace(*textp); ) textp--; /* skip space */ for( ; textp > workbuf && !isspace(*(textp-1)); ) textp--; /* and preceding word */ break; case MVEOL: while (*textp) textp++; break; case MVBOL: textp = workbuf; break; case DCHAR: if (!*textp) { beep(); break; } dcp = textp; scp = textp+1; ccnt--; while (*dcp++ = *scp++) ; textp = fix_line(workbuf, textp); break; case DPCHAR: if (textp <= workbuf) beep(); else { textp--; dcp = textp; scp = textp+1; ccnt--; while (*dcp++ = *scp++) ; textp = fix_line(workbuf, textp); } break; case DWORD: if (!*textp) { beep(); break; } dcp = textp; for(scp=textp+1; *scp && !isspace(*scp); ) scp++; while (*scp && isspace(*scp)) scp++; while (*dcp++ = *scp++) ; /* check for lines too long */ textp = fix_line(workbuf, textp); ccnt = strlen(workbuf); break; case DLINE: textp = workbuf; ccnt = 0; *textp = '\0'; break; case DEOLINE: for(scp=textp; *scp; scp++) ; *textp = '\0'; ccnt = strlen(workbuf); break; default: cant_happen(34); } } else { if (c.symbol == '\r') c.symbol = '\n'; if (c.symbol == '\n') { if ((textp > workbuf && *(textp-1) != '\\') || (textp == workbuf)) { char tbuf[MAX_INSTR]; int length; for( ; *textp; ) textp++; /* move to eol */ top_row = update(workbuf, top_row, textp); processing = FALSE; addch('\n'); addhistory(workbuf); /* insert '\' before each nuline to make parser happy */ length = strlen(workbuf) + 1; length = MAX_INSTR - length; for(scp = workbuf, dcp = tbuf; *dcp++ = *scp++; ) ; for(scp = tbuf, dcp = workbuf; *scp; ) { if (*scp == '\n') { *dcp++ = '\\'; if (!length--) cant_happen(39); } *dcp++ = *scp++; } *dcp = '\0'; return 1; } else if (ccnt + 4 < MAX_INSTR) { *(textp-1) = '\n'; c.symbol = ' '; } else beep(); /* fall through to add space */ } if (isprint(c.symbol) && ccnt+4 < MAX_INSTR) { /* open up a hole */ for(scp = textp; *scp; ) scp++; dcp = scp+1; for( ; scp >= textp; ) *dcp-- = *scp--; *textp++ = c.symbol; textp = fix_line(workbuf, textp); ccnt = strlen(workbuf); } else beep(); } } } /* if any line of instruction is too long, fix it, return new cp */ char *fix_line(buf, cp) register char *buf, *cp; { register int i; int max_chars; char *start_row, *oldcp; /* find beginning of line */ oldcp = cp; if (cp > buf) cp--; /* if i'm on a newline, ignore it */ while (cp >= buf && *cp != '\n') cp--; if (cp < buf) max_chars = 71; else max_chars = 67; /* cp now-points to beginning of current line */ /* count the characters */ start_row = cp++; while (isspace(*cp) && *cp != '\n') cp++; /* don't count space at start of line */ for(i=0; *cp && *cp != '\n'; cp++) if (++i == max_chars) { /* split the line */ /* because we keep a running total, we only split once. */ register char *scp, *dcp; char *savcp; savcp = cp--; /* character pointed to by cp must be moved to next line, replace it with '\' */ /* look for preceding word break */ /* leave room for '\' */ if (oldcp >= savcp) oldcp++; while (cp > start_row && !isspace(*cp)) cp--; while (cp > start_row && isspace(*cp)) cp--; /* add to beginning of space */ if (cp == start_row) { /* single word occupies entire line */ for(scp = savcp; *scp; scp++) ; dcp = scp + 1; while (scp >= savcp) *dcp-- = *scp--; *savcp++ = '\n'; } else { for(scp = savcp; *scp; scp++) ; dcp = scp + 1; cp++; /* break before spaces */ while (scp >= cp) *dcp-- = *scp--; *cp++ = '\n'; } break; } return oldcp; } beep() { putchar('G'-'@'); } /* invoke history system to locate preceding line with pattern specified by buf, place replacement string in same buf, return # of lines in new buf */ uphist(buf) char *buf; { register char *tcp; char *sbuf; sbuf = buf; if (!*buf) /* duplicate last line */ strcpy(buf, ".*"); if (makepat(buf) != MYOK) { beep(); /* bad pattern */ makepat(".*"); } for(;;) { if (cur_his == sohist) { beep(); *sbuf = '\0'; return 0; } else /* move to preceding line */ { buf = sbuf; cur_his = hprev(cur_his); /* ignore null */ cur_his = hprev(cur_his); while (*cur_his) cur_his = hprev(cur_his); cur_his = hnext(cur_his); /* copy current line onto buf */ for (tcp = cur_his; *tcp; tcp = hnext(tcp)) *buf++ = *tcp; *buf++ = '\0'; if (match(sbuf, spat)) return strlen(sbuf); } } } /* invoke history system to locate following line with pattern specified by buf, place replacement string in same buf, return # of lines in new buf */ dnhist(buf) char *buf; { register char *tcp; char *sbuf; sbuf = buf; if (!*buf) strcpy(buf, ".*"); if (makepat(buf) != MYOK) { beep(); makepat(".*"); } for(;;) { if (cur_his == eohist) { *sbuf = '\0'; beep(); return 0; } else { /* move to next line */ buf = sbuf; while (*cur_his) cur_his = hnext(cur_his); cur_his = hnext(cur_his); if (cur_his == eohist) { *sbuf = '\0'; beep(); return 0; } else { for(tcp = cur_his; *tcp; ) { *buf++ = *tcp; tcp = hnext(tcp); } *buf++ = '\0'; } if (match(sbuf, spat)) return strlen(sbuf); } } } /* add line to history, if necessary delete lines from beginning of buffer to make room. */ addhistory(line) char *line; { while (*line) adch(*line++); adch('\0'); } adch(c) char c; { if (his_cnt == MAX_HIST) fre_his(); *eohist = c; his_cnt++; eohist = hnext(eohist); } fre_his() { while (*sohist) { sohist = hnext(sohist); his_cnt--; } sohist = hnext(sohist); /* eat up null terminator */ his_cnt--; } SHAR_EOF if test 11304 -ne "`wc -c < 'projects/his.c'`" then echo shar: error transmitting "'projects/his.c'" '(should have been 11304 characters)' fi fi # end of overwriting check if test -f 'projects/line.c' then echo shar: will not over-write existing file "'projects/line.c'" else cat << \SHAR_EOF > 'projects/line.c' /* Little Smalltalk line grabber - does lowest level input for command lines. */ # include <stdio.h> # include <setjmp.h> # include "object.h" # include "primitive.h" # define MAXINCLUDE 10 # define MAXBUFFER 2000 /* text buffer */ FILE *fdstack[MAXINCLUDE]; int fdtop = -1; int inisstd = 0; /* set file - set a file on the file descriptor stack */ set_file(fd) FILE *fd; { if ((++fdtop) > MAXINCLUDE) cant_happen(20); fdstack[fdtop] = fd; if (fd == stdin) inisstd = 1; else inisstd = 0; } jmp_buf lin_top; int block; /* line-grabber - read a line of text do blocked i/o if blocked is nonzero, otherwise do non-blocking i/o */ /* return 0 if line is complete, 1 if complete line, -1 if end of input */ int line_grabber(lblock) int lblock; { int ret, row, col; block = lblock; if (ret = setjmp(lin_top)) return ret-2; else { get_instruction(); return 1; } } SHAR_EOF if test 895 -ne "`wc -c < 'projects/line.c'`" then echo shar: error transmitting "'projects/line.c'" '(should have been 895 characters)' fi fi # end of overwriting check if test -f 'projects/main.c' then echo shar: will not over-write existing file "'projects/main.c'" else cat << \SHAR_EOF > 'projects/main.c' #include <stdio.h> #include <curses.h> #include "defs.h" extern char ins_buf[]; main() { char workbuf[MAX_INSTR]; int crow, ccol, ret_val; int num_schedules; set_file(stdin); setup(); num_schedules = 0; do { if ((ret_val = line_grabber(0)) == 1) { printw("\n\rgot:\n"); printw(ins_buf); printw("\nwith %d schedules\n\r", num_schedules); num_schedules = 0; } else if (ret_val == -1) break; else num_schedules++; } while(ret_val != -1); finish(); printf("\n"); } cant_happen(num) int num; { fprintf(stderr, "can't happen #%d\n", num); finish(); exit(1); } SHAR_EOF if test 599 -ne "`wc -c < 'projects/main.c'`" then echo shar: error transmitting "'projects/main.c'" '(should have been 599 characters)' fi fi # end of overwriting check # End of shell archive exit 0