diff -Nru scheme9-2009.09.06/ABOUT scheme9-2010.11.13/ABOUT --- scheme9-2009.09.06/ABOUT 1970-01-01 00:00:00.000000000 +0000 +++ scheme9-2010.11.13/ABOUT 2010-07-20 12:32:02.000000000 +0000 @@ -0,0 +1,26 @@ + + ____ ____ ____ ____ ____ + / ___)/ __ \| __)| __)/ ___) Scheme 9 from Empty Space + \___ \\__ /| __)| __)\___ \ Yet another implementation + (____/(___/ |_| |____)(____/ of a dead language + + This branch of S9fES is a hack. When something is broken or + missing, fix it. Do with the code whatever you want, it is + neither "mine" nor "yours." Rip it apart, make something new + out of it, claim it is yours, re-license it, sell it, give + it away, do not even tell me about it. This is all fine by + me. Freedom cannot be possessed. Whenever there is freedom, + it belongs to all. + + Being a hack, in this case, does not mean that the code is + fragile. Au contraire. The S9 interpreter has been running + large amounts of code for very long times without breaking, + and I trust it to run even the most critical programs. + + It does mean, though, that when it *does* break, you are on + your own. I am hacking it for fun and may or may not respond + to bug reports. Most probably I will fix bugs that are being + reported to me, but I will follow my own schedule. + + Nils M Holm < n m h at t 3 x . o r g > + diff -Nru scheme9-2009.09.06/CHANGES scheme9-2010.11.13/CHANGES --- scheme9-2009.09.06/CHANGES 2009-09-06 06:59:05.000000000 +0000 +++ scheme9-2010.11.13/CHANGES 2010-11-13 08:10:42.000000000 +0000 @@ -1,5 +1,639 @@ + Change Log +2010-11-13 + Fix: sudden allocation of large vector failed, even if enough + vector space was present (this did not happen when allocating + lots of small vectors, releasing them, and then allocating a + large vector). (s9.c) +2010-10-29 + Fix: missing hash-table reference in memoize.scm. (lib/) +2010-10-11 + Added GET-PROP, PUT-PROP, etc. (lib/) +2010-10-08 + Added STRING-PREFIX=? and STRING-PREFIX-CI=? procedures. (lib/) +2010-10-07 + Fix: MAKE-STRING and MAKE-VECTOR did not check for negative + arguments. (s9.c) +2010-10-06 + Added TIME-ADD, TIME-SUBTRACT, TIME-DIFFERENCE, TIME-BEFORE?, + and TIME-AFTER? procedures. (lib/) + Moved SWAP! to "setters.scm"; removed "swapb.scm". (lib/) +2010-10-05 + Added small-magnitude bit operators (bitops). (lib/) +2010-10-04 + Renamed BITWISE-AND-NOT --> BITWISE-NOT-AND, + BITWISE-OR-NOT --> BITWISE-NOT-OR, + BITWISE-XOR-NOT --> BITWISE-NOT-XOR. (lib/) + Added fast bit operations (BIT-OP). (s9.c) +2010-10-03 + Misc. minor changes. This is the book version. +2010-09-29 + Applied minor change ro RIB internal structure. (s9.c) +2010-09-27 + Added \i (image) mode to EDOC. (prog/) +2010-09-23 + Added "NIL" and "@ rest" syntax to MAKE-MATCHER. (lib/) +2010-09-22 + Added line concatenation via \\ to EDOC, made EDOC's -b + option link to a file given on the command line instead of + hardwiring "index.html". (prog/) +2010-09-21 + Changed MAKE-MATCHER semantics. Once again. :-/ But this + time it will be final! (lib/) + Moved the MAKE-MATCHER code to the EDOC section. (lib/, edoc/) +2010-09-19 + Re-organized the "primitives" section. (s9.c) +2010-09-16 + Moved SYNTAX-RULES to EDOC section. (lib/, edoc/) +2010-09-13 + EDOC: Improved layout of Lout output; still experimental, + though! (prog/) +2010-09-11 + Fixed some minor 64-bit/prototyping glitches. (s9*.c) +2010-09-10 + Added HTMLIFY-CHAR and LOUTIFY-CHAR to library. (lib/) + Started Lout backend in EDOC. (prog/) +2010-09-09 + EDOC: improved error messages, implemented strict mode + (being picky about matching braces). (prog/) +2010-09-07 + Fixed botched optimization in EXP function. (s9-real.scm) +2010-09-06 + Cleaned up real number primitives. (s9-real.c) +2010-09-05 + DISPLAY/WRITE now round the last digit of real numbers with + large mantissas, so 1.99999999999999997 actually prints as + 2.0 on 32-bit systems. (s9-real.scm) + Added INC!, DEC!, and SET-VARS! syntax. (lib/) +2010-09-04 + Factored out CHECK-BINDINGS and SPLIT-BINDINGS in the Scheme + core. (s9.scm) + Fix: a quotation char ('`,) followed by a closing paren swallowed + that closing paren. (s9.c) +2010-09-03 + Fix: APPEND accepted atoms in positions other than the last. (s9.scm) + PRETTY-PRINT now prints (and), (or), and (begin) more nicely. + (contrib/) +2010-09-02 + Allowed nested quasiquotation as long as an embedded QUASIQUOTE + is inside of UNQUOTE or UNQUOTE-SPLICING. (s9.scm) + Applied more optimizations to MAKE-MATCHER. (lib/) + Added GROUP-LIST procedure to library. (lib/) + Fix: WITH-OUTPUT-TO-FILE always returned #. (s9.scm) +2010-09-01 + Made STRING and VECTOR primitives. (s9.c) + Fix: SYS:READLINK did not NUL-terminate its return string. (ext/) + Optimized internal accessors of MAKE-MATCHER. (lib/) +2010-08-31 + Changed PACKAGE syntax and semantics. (lib/) + Added Red-Black Trees. (lib/) + Various small changes. (s9.c) +2010-08-29 + Changed MAKE-MATCHER syntax. (lib/) + Retired ML-MATCH syntax. (lib/) +2010-08-26 + Applied various cosmetics and micro-optimizations. (s9.c) +2010-08-25 + Changed environment box model from (name . (value)) to + (name . value), (ab?)using the CDR field as a box. This + saves quite a few conses during evaluation. (s9.c) + Improved syntax checking in local DEFINEs. (s9.c) + Added detection of improper lists (syntax errors) in + special forms. (s9.c) +2010-08-24 + Made STATS primitive expand macros before evaluation. (s9.c) +2010-08-22 + Fix: Made EXPT return an inexact number when passed an inexact + argument, because conversion lost digits. Also made SQRT return + an inexact result. (s9-real.scm) +2010-08-20 + Documented EDOC using EDOC. (prog/) + Fix: counting newlines in block comments. (s9.c) +2010-08-19 + SCM2HTML: added support for block comments. (s9.c) +2010-08-15 + Fix: all real numbers must be inexact according to R4RS. (s9.c) + Fixed a precision bug in mixed bignum/real operations. (s9-real.c) + Fixed missing trailing zero in (number->string 1.0). (s9-real.scm) +2010-08-14 + Cleaned up SCM2HTML program. (contrib/) + Added C2HTML program. (contrib/) +2010-08-13 + Changed interface of SCM2HTML and moved it to contrib/. + Added SCM2HTML1 program (SCM2HTML wrapper). (prog/) + Fix: (+ 0.0 -1.0e-999999999) gave 0.0. (s9-real.c) + Fix: (+ #e0.0 #e1.0e-999999999) gave an inexact result. (s9-real.c) +2010-08-12 + ARSE: made [d][/]x and [d][?]x repeatable. (contrib/) + Added ,q (sys:exit) meta command. (s9.c) + Added #| ... |# comments. (s9.c) +2010-08-10 + Tweaked real number interface (internal). (s9*.[ch]) + Updated the man page. (s9.1) +2010-08-09 + Finished integration of big real number support. (*.c, *.scm) +2010-08-08 + Re-integrated big real arithmetics. (*.[ch], *.scm) + Added real number test suite. (util/) +2010-08-07 + Added make-cats.scm program and CATEGORIES.html file. (util/) +2010-08-06 + ARSE: fix: clear undo log when loading a different file + into an edit buffer. (contrib/) +2010-08-03 + Fix: (,x) was interpreted as a meta command. (s9.c) + Fix: SYNTAX-RULES failed to detect some syntax errors + before ellipses. (lib/) + S9 SOS: make instantiation invalid. (contrib/) + Added 'COMPRESS: option to RUNTIME-STATS. (ext/) +2010-08-02 + Applied some cosmetics to SYNTAX-RULES. (lib/) + Added LISTQ syntax. (lib/) + Made APPEND fold to the right (O(n) instead of (O(n^c) + when appending multiple lists). (s9.scm) + Added COLS program. (prog/) +2010-08-01 + CHAR-CANVAS: auto-clipping out-of-range coordinates. (lib/) + RUNTIME-STATS: misc. small fixes. (ext/) +2010-07-31 + Added plotter and table formatter to RUNTIME-STATS. (ext/) + Fixed CANVAS-PLOT-LINE. (lib/) +2010-07-30 + Added the RUNTIME-STATS procedure to library. (ext/) + Added SWAP! syntax to library. (lib/) + Added character-based canvas to library. (lib/) +2010-07-29 + Made STATS return a list instead of printing its data. (s9.c) + Added SYS:GETTIMEOFDAY extension procedure. (ext/) + Added TIME procedure to library. (/ext) + Fixed S9 SOS built-in hierarchy. (contrib/) +2010-07-28 + Added meta commands, which are entered by typing a #\, + at the top level and without any enclosing parens. See + S9(1) for details. (s9.c) +2010-07-27 + Added PUSH! and POP! macros. (lib/) + Added PACKAGE macro. (lib/) +2010-07-26 + Removed UNDEFINED primitive; causes only trouble. (s9.c) + Added minor optimizations to MAKE-MATCHER. (lib/) + Made MAKE-MATCHER and ML-MATCH two separate packages. (lib/) +2010-07-25 + Made S9 not count initial GC in STATS. (s9.c) + Added cons cell statistics to interpreter. (s9.c) + Fix: SYNTAX-RULES failed to expand stuff following "...". (lib/) +2010-07-24 + Added TREE-MAP procedure. (lib/) + Fix: RE-MATCH returned wrong format when processing + REs beginning with "^" in combination with 'ALL. (lib/) +2010-07-23 + Finished the S9 SOS and its documentation. (contrib/) +2010-07-21 + Made ":set regex" default in ARSE. (contrib/) +2010-07-20 + Bootstrapped SOS. (contrib/) +2010-07-19 + ARSE: removing output that begins with ";" when reloading + a buffer. (lib/) +2010-07-18 + Added first sketch of SOS (Scheme Object System). (contrib/) + Added 'REVERSE keyword to T-SORT; added T-SORT-NET. (lib/) + Added 'TOP-DOWN option to T-SORT. (lib/) + ARSE: added "scheme-init" option. (contrib/) +2010-07-17 + Added 'CONVERT-UNREADABLE option to READ-FROM-STRING. (lib/) + Added help pages for the REVERSE!, STATS, SYNTAX?, TRACE, VOID, + and UNDEFINED procedures. (help/) +2010-07-16 + Added UNDEFINED procedure; see s9(1). (s9.c) +2010-07-15 + Added KEYWORD-VALUE procedure. (lib/) + Rewrote HASH-TABLE, added support for 'SIZE and 'TEST keywords. + (lib/) + Added WHEN, UNLESS, WHILE, and UNTIL syntax. (lib/) + ARSE: made [TAB] insert blanks when not typing a symbol. (contrib/) +2010-07-14 + Added DUPLICATES procedure and friends. (lib/) + DEFINE-STRUCTURE not reports duplicate slot names. (lib/) +2010-07-13 + Added queue data type. (lib/) +2010-07-12 + Added MEMOIZE procedure and DEFINE-MEMOIZED syntax. (lib/) +2010-07-11 + Added ID (identity) procedure. (lib/) + ARSE: added regex support to [/] and [?] commands. (contrib/) + Re-organized library. (lib/) + Added check-descr.scm to check descriptions for web dump. (util/) +2010-07-10 + Added SPLIT and MERGE procedures, rewrote MERGESORT. (lib/) + Fixed stuck state (0) in RANDOM-STATE. (lib/) + Fix: SYS:MAKE-INPUT-PORT and SYS:MAKE-OUTPUT-PORT + could return a closed port due to GC. (ext/) + Rewrote BITWISE-... operators. (lib/) + Added INTEGER->BINARY-STRING and BINARY-STRING->INTEGER. (lib/) + Fix: RE-SUBST generated wrong matches with trailing "\\)". (lib/) +2010-07-09 + ARSE: fixed spurious trailing lines after undo. (contrib/) + ARSE: added regular expression support (:s). (contrib/) + Added COMPOSE, COMPLEMENT, TRUE, and FALSE procedures. (lib/) + Added RANDOM and RANDOM-STATE procedures. (lib/) +2010-07-08 + Added SYNTAX? primitive. (s9.c) + Added T-SORT (topological sort) procedure. (lib/) + Added EQUAL-CI? procedure. (lib/) + Added TYPE-OF procedure and TYPE-CASE syntax. (lib/) + Added ASSP and MEMP procedures. (lib/) + Applied various small fixes to PRETTY-PRINT. (contrib/) + Updated man page. (s9.1) +2010-07-07 + Added RE-SUBST procedure to REGEX package. (lib/) + Added TREE-COPY procedure. (lib/) +2010-07-06 + Added auto-completion to ARSE. (contrib/) + Added ADJOIN, SET-DIFFERENCE, and SUBSET? procedures. (contrib/) + Added -COPY procedure to DEFINE-STRUCTURE. (lib/) + Replaced lots of REVERSEs with REVERSE!. (*) +2010-07-05 + Added POSITION and friends to library. (lib/) + ARSE: fixed tab expansion; added "unexpand" option. (contrib/) +2010-07-04 + Added the AMB (backtracking) operator. (lib/) + Added HASH-TABLE-REMOVE! and ALIST->HASH-TABLE; renamed + HASH-TABLE->LIST to HASH-TABLE->ALIST. (lib/) + Fix: (cond ('(()))) was an error. (s9.c) +2010-07-03 + Fix: FOR-ALL sometimes returned #T unexpectedly. (lib/) + Fix: CALL/CC could crash AND, BEGIN, COND, and OR. :-/ (s9.c) + Added ARRAY-MAP procedure. (lib/) +2010-07-02 + Added more array operations. (lib/) +2010-07-01 + Added Common LISP-style CATCH/THROW. (lib/) + Added ARRAYs and array operations. (lib/) +2010-06-30 + Renamed DEFINE-RECORD to DEFINE-STRUCTURE, allowed simpler + slot syntax. (lib/) +2010-06-29 + ARSE: reload main buffer automatically when recovering from + a REPL error. (s9.c) + ARSE: fix: undo delete lines at end of buffer. (contrib/) +2010-06-28 + Renamed EXPAND-MACRO to MACRO-EXPAND (more CL'ish). (s9.c) + Added MACRO-EXPAND-1 procedure. (s9.c) + Added Common LISP TAGBODY to library. (lib/) +2010-06-27 + Added CALL-WITH-CURRENT-CONTINUATION (CALL/CC). (s9.c) + Related critical change in s9.c:_eval(): + name = car(rib_source(rib)); + - /* Save result */ + - car(Stack) = Acc; + if (Trace_list != NIL) + Imported CALL/CC description from R4RS. (help/) + Added LET/CC to library. (lib/) + Added cooperative thread functions. (lib/) + Removed CALL-WITH-ESCAPE-CONTINUATION. +2010-06-26 + Added REVERSE! primitive and used in some places. (s9.c, s9.scm) + Made (re-match (re-comp "^") "foo") ==> ((0 0)) + and (re-match (re-comp "$") "foo") ==> ((3 3)). (lib/) + Added 'ALL option to RE-MATCH. (lib/) + Added VECTOR-MAP, made VECTOR-MAP! variadic. (lib/) + Added STRING-MAP and STRING-MAP!. (lib/) +2010-06-25 + Made S9 ignore SIGPIPE, so the SYS: procedures can catch broken pipe + conditions themselves. (ext/) + ARSE: ignore broken pipe condition when writing to REPL. (contrib/) + ARSE: added autocenter option. (contrib/) + Cleaned up the REGEX procedures and added submatches. (lib/) + Made RE-MATCH return ranges rather than strings. (lib/) +2010-06-24 + Misc. clean-up. +2010-06-23 + Factored out all the S9fES stuff in ARSE, so it can be ported to + other Schemes more easily. (contrib/) + ARSE: [r] did not check autoindent option. (contrib/) + Added ARSE porting instructions. (contrib/) + Added VECTOR-MAP! and STRING-SCAN procedures. (lib/) + ARSE: expanding tabs to spaces when reading filters, etc. (contrib/) +2010-06-22 + Added DEFINE-RECORD syntax. (lib/) + (DEFINE-SYNTAX (F ...) ) accepted only a single-expression + body. Fixed that. (s9.c) + ARSE: no longer displaying the REPL buffer when reloading or + recompiling. (contrib/) + ARSE: some general clean-up. (contrib/) +2010-06-21 + Finished Unix extension test suite. (util/) + Documented SYS:SLEEP, SYS:USLEEP. (help/) +2010-06-20 + SYS:CHOWN did not work. (ext/) + ARSE: :s//... did not allow leading blanks in . (contrib/) + ARSE: missing REAL-POS! in SUBSTITUTE and COLON-READ. (contrib/) + Added SYS:SLEEP, SYS:USLEEP procedures. (ext/) +2010-06-19 + Removed SYS:LCHMOD; not portable. (ext/) + Cleaned up symlinks in help directory. (help/) +2010-06-18 + Fix: hash tables did not allow negative numeric keys. (lib/) +2010-06-17 + Added a quick and dirty dependency checking mode to S9RESOLVE. + (prog/) + Fixed some unresolved library dependencies. ;-) + * Explanation: + * The default image file contains most of the S9fES library + * functions, so it does not really need all those LOAD-FROM-LIBRARY + * calls. However, I consider it to be good style to make library + * dependencies explicit by adding them anyway. S9RESOLVE -d detects + * missing LOAD-FROM-LIBRARYs. +2010-06-16 + Factored out FIND-HELP-PATH procedure. (ext/) + Added SPAWN-SHELL-COMMAND procedure. (ext/) + SPAWN-COMMAND has new semantics, SPAWN-SHELL-COMMAND implements + the old behavior. (ext/) + Added more missing symlinks to help directory. (help/) +2010-06-14 + Added the SYS:FILENO procedure. (ext/) + Fix: SYS:SELECT sometimes returned #F even when some + descriptors were ready. (ext/) + Fix: PP-FILE could not find LINEFEED procedure. (contrib/) + Made the pretty-printer indent embedded IF, COND, etc in + code mode rather than data mode. (contrib/) +2010-06-13 + Removed CURS:KEY-EOL from curses, because it is not the key + labeled "END" on a PC keyboard. Which KEY_ constant is used + for this key? My /usr/include/curses.h says KEY_SELECT, but + this does not appear to make sense. (ext/) +2010-06-12 + Made READ-FROM-STRING skip over comments in multi-line input. + (contrib/) + Added SYS:CATCH-ERRORS and SYS:STRERROR primitives. (ext/) + Made SPAWN-COMMAND redirect stderr of the spawned command to + stdout so it can be read by the parent. (ext/) + Added URL-DECODE procedure to library. (lib/) +2010-06-11 + Added the PP-STRING procedure to the pretty-printer. (contrib/) +2010-06-10 + Added the INET-SERVER procedure to the extension library. (ext/) + Rewrote S9HTS using INET-SERVER. (prog/) + Reinstalled and fixed a load of wrong or missing symlinks in + help directory. (help/) +2010-06-09 + Added the SPLIT-URL procedure to the library. (lib/) +2010-06-08 + Added SYS:INET-GETPEERNAME primitive to Unix extension. (ext/) + Implemented S9HTS, a simple HTTP server. (prog/) + Added STRING-POSITION and friends to library. (lib/) + Added STRING-LAST-POSITION and friends to library. (lib/) +2010-06-06 + Added the CURSES_RESET compile time option, which will + run CURS:ENDWIN automatically in the REPL, so Curses + cannot hose the interface in interactive sessions. + Of course, when using this option, (CURS:INITSCR) will + not have any effect when entered at the REPL. (s9.c) + Moved ARSE (was: SCHED) to contrib/, kept only the + command line interface in prog/. + Added ARSE installation procedure to Makefile. + Documented ! option. (s9.1) + Fix: not all globals were initialized in PRETTY-PRINT. (contrib/) + Fix: PP printed a lonely closing paren in intended applications + with no arguments. (contrib/) +2010-06-05 + Added !image option to change the heap image name ad hoc. (s9.c) +2010-06-02 + Fixed a few bugs in ADVGEN; it only worked due to the below + bug in S9. :-/ +2010-06-01 + Fix: Local environments of *dynamically* scoped (a.k.a. top-level) + procedures were still being propagated to functions called *iff* + there were multiple levels of local definitions in the top-level + procedure, e.g.: + (define (g) x) + (define (f) (let ((x 0)) + (let () ; <-- this triggered the bug + (g) + #f))) + (f) ==> 0 ; should be an error (x undefined) + This is definitely fixed now. Regression test added. (s9.c) +2010-05-31 + Intercepted more funny characters. (s9.c) +2010-05-30 + Made STRING->NUMBER accept base prefixes. (s9.scm) + Replaced some applications of the obsolete WRONG procedure + with applications of ERROR. (s9.scm) + Made the interpreter identify funny input characters. (s9.c) +2010-05-28 + Fixed a GC bug introduced by growing the pools independently. + This bug was triggered by using more vector space than node + space. (s9.c) + Improved the stress test suite. (util/) +2010-05-27 + ADVGEN: renamed GO/RET to GO/SEL. (prog/) + Tweaked the sample adventure. (prog/) +2010-05-26 + S9 now takes its image name from argv[0] instead of + hardwiring it. (s9.[ch]) + Added new FORMAT help page with better explanations and + lots of examples; try (help 'format). (help/) +2010-05-25 + Fix: FORMAT recursed indefinitely in case of an error + due to re-use of the name ERROR. (contrib/) +2010-05-24 + Added expansion template to AND-LET* description. (lib/) + Added Curses interface help pages. (help/) + Added CURS:LINES and CURS:COLS procedures. (ext/) + Fix: MAKE-STRING did not type-check second argument. (s9.c) +2010-05-23 + Added first version of a CURSES(3) interface. (ext/) + Fixed GC bug in APPEND2. + Made cons and vector pools grow independently. (s9.c) +2010-05-22 + Stopped interpreter from reporting infinite sequences of '(' + in error messages, even if the reported structure is cyclic. + Added AND-LET*. (lib/) + Minor cosmetics. +2010-05-21 + Improved limited output in error messages. (s9.c) + Running "make tests" will now use a minimum heap image, + so unresolved references in the library will be detected. + (Makefile) + Improved ADVGEN error messages. (prog/) + Added COPY-FROM special description to ADVGEN. (prog/) +2010-05-20 + Made DEFINE-SYNTAX an alias for DEFINE-MACRO; removed + DEFINE-MACRO. (s9.c) + Moved SYNTAX-RULES to the extension library. (lib/) + Added the STANDARD-ERROR-PORT, WITH-OUTPUT-TO-STDERR, + and CALL-WITH-STDERR procedures. (ext/) + Limited size of Scheme objects in error messages. (s9.c) + Updated S9(1) man page and help pages. (help/) + Various small fixes and cosmetics. +2010-05-19 + Added GO/RET operator to ADVGEN. (prog/) + Applied various minor improvements to the pretty-printer. + (contrib/) + Added default values to PARSE-OPTIONS!. (ext/) + Added SCMPP pretty-print utility. (prog/) + Added more features to ADVGEN; see prog/advgen.txt. +2010-05-18 + Fixed a long-standing bug that caused the following program + to evaluate to 1: + (define (g) x) + (define (f) + (let ((x 1)) + (g) + #f)) + (f) + This happened only if (g) was *not* a tail call. The critical + part of the fix is: + + if (!tail && cdr(Environment) != NIL) + + Environment = cdr(Environment); + in s9.c:bind_arguments(). +2010-05-17 + Added ADVGEN documentation, fixed some minor bugs. (prog/) +2010-05-16 + Added GO/CUT operator to ADVGEN. (prog/) + Added STRING-FIND-LAST, STRING-FIND-LAST-WORD, + STRING-CI-FIND-LAST, STRING-CI-FIND-LAST-WORD. (lib/) + Fix: SCM2HTML did no longer accept input from stdin. (prog/) + Fix: SCM2HTML rendered #[bdox] literals in wrong color. (prog/) + Fix: ADVGEN: stupid bug in HTML postlude. (prog/) + Fix: SCM2HTML: #\$ is a valid symbol character. (prog/) + Added missing symlinks to help database. (help/) +2010-05-15 + Documented NAME->FILE-NAME. (contrib/) + Added code to install utility programs. (Makefile) + Added COUNTER option type and "--" special argument + to PARSE-OPTIONS!. (ext/) + Added ADD/GO and REM/GO actions to ADVGEN. (prog/) +2010-05-14 + Added new option types to PARSE-OPTIONS!. (ext/) +2010-05-13 + Added STRING-TRANSLATE procedure to library. (lib/) + Finished sample ADVGEN adventure. (prog/) + Fixed a bug in PARSE-OPTIONS!: option args were always + taken from first option. Oops. (lib/) +2010-05-12 + Fixed names in error messages of CAAR..CDDDDR. (s9.c) + Implemented first version of ADVGEN, an HTML adventure + generator. (prog/) +2010-05-11 + Made email addresses in the code harder to harvest. +2010-05-10 + Added HTMLIFY utility. (prog/) + Added stuff for automatic web site creation. (util/) +2010-05-09 + Renamed all UNIX:... symbols to SYS:... and made naming + more consistent. All names in the SYS-UNIX extension now + begin with SYS:. (ext/) + Moved SYS:FLUSH with no args to library (FLUSH-OUTPUT-PORT). (ext/) + Added LETREC* syntax. (lib/) +2010-05-08 + While I am at it: made these procedures primitives: + APPEND, LIST-TAIL, MIN, MAX. (s9.c, s9.scm) + Fixed READ-FROM-STRING (mixed up some numbers and + symbols). (lib/) + Added #B, #D, #O, #X prefixes to READ-FROM-STRING. (lib/) + Renamed STRING-FIND to STRING-LOCATE and STRING-CONTAINS + to STRING-FIND. Also swapped the arguments of STRING-FIND + so that STRING-FIND and STRING-LOCATE are more consistent + now. (lib/, contrib/) + Added [+-][st] modifiers to CHANGE-MODE. (ext/unix.scm) +2010-05-07 + Made these procedures primitives: ABS, ASSQ, ASSV, + CAAR..CDDDDR, EQV?, EVEN?, LENGTH, LIST, MEMQ, MEMV, + NEGATIVE?, NOT, NULL?, ODD?, POSITIVE?, REVERSE, ZERO?. + Resulting speed increase is between 30% (libtest) and + 70% (htmlize library). (s9.c, s9.scm) + Added -9 (highlight non-R4RS symbols) and -x (highlight + extensions) arguments to SCM2HTML utility. (prog/) + Added indentation of DO. (contrib/pretty-print.scm) + Fixed evluation of DO in PROGRAM?: allowed more than + one statement in body, made statement in termination + clause optional. (lib/programp.scm) +2010-05-06 + Made DRAW-TREE print more compact trees by emitting the + conses of (...(x)...) as soon as possible. (contrib/draw-tree.scm) + Added interactive mode to SOCCAT program. (prog/) + Added UNIX:ACCESS help page. +2010-05-05 + Added purely functional streams to library. (lib/streams.scm) + Added UNIX:WAITPID procedure. + Fixed type checking in UNIX:KILL (accepted single argument). + Added the SOCCAT utility. (prog/soccat) +2010-05-04 + Added UNIX:SELECT procedure. +2010-05-03 + Made argument of FLUSH optional (defaults to current output port). + Added UNIX:INET-CONNECT, UNIX:INET-LISTEN, and UNIX:INET-ACCEPT + procedures. + Made UNIX:* procedures print more informative error messages. + Added mode argument to UNIX:MKDIR, made it optional in MKDIR. +2010-05-02 + Made UNIX:STAT not follow symlinks. + Added STRING-CONTAINS-WORD and STRING-CI-CONTAINS-WORD. (lib/) + Added FIND-HELP procedure. (ext/) + Made PARSE-OPTIONS! accept symbolic options (instead of strings). +2010-05-01 + Added UNIX:SETUID, UNIX:SETGID. UNIX:GETPGID, UNIX:SETPGID. + Added DISPLAY*. (lib/) +2010-04-30 + Added the UNIX:FORK, UNIX:WAIT, and UNIX:EXECV procedures. + Added the UNIX:ACCESS and SEARCH-PATH procedures. (ext/) + Replaced the primitive UNIX:SPAWN and SPAWN procedures with + the high-level SPAWN-COMMAND procedure. (ext/spawn-command.scm) + Added S9RESOLVE program, which resolves S9fES library + dependencies. (prog/) + Hash tables sizes now adapt automatically. (lib/hash-table.scm) +2010-04-29 + Added more Unix procedures: UNIX:CLOSE, UNIX:CREAT, UNIX:DUP, + UNIX:DUP2, UNIX:LSEEK, UNIX:MAKE-INPUT-PORT, UNIX:MAKE-OUTPUT-PORT, + UNIX:OPEN, UNIX:PIPE, UNIX:READ, UNIX:WRITE, UNIX:UMASK. + Also added the APPEND-TO-OUTPUT-FILE procedure. (ext/) +2010-04-28 + Added PARSE-OPTIONS! and friends. (ext/parse-options.scm) + Installing contribs directly in @LIBDIR@ now. + Made UNIX:READDIR skip the "." and ".." entries. + Added UNIX:RENAME procedure. +2010-04-27 + Added the STRING-UNSPLIT procedure (lib/). + Made HASH-TABLE-REF return just a value (lib/hash-table.scm). + Error messages are now printed on stderr when the interpreter + runs in quiet mode (-q). + Added DIRNAME procedure. + Moved contrib/pretty-print.scm to prog/scm2html.scm and made + it a stand-alone program. + Moved S9 configuration from Makefile to config.scm. +2010-04-26 + Added help pages for all remaining UNIX: procedures. + Added the STAT-type? predicates for finding out the + type of a directory entry. + Added the BASENAME procedure. + Removed the S9U(1) man page, because it basically duplicates + the help pages. + Added "programs" section (prog/) and dupes program. +2010-04-25 + Added "pattern=mode" to UNIX:CHMOD. + Added some UNIX: procecures to the help database. + Added STRING-PARSE procedure. + Made STRING-SPLIT generate empty strings when multiple + subsequent separators are found. + Updated S9U(1) man page (was S9E(1) man page). + Updated help pages. +2010-04-24 + Merged S9 and S9E interpreters; configure in Makefile. + Added third return value (PID) to UNIX:SPAWN. + Added UNIX:KILL and KILL procedures. + Added R4RS test cases to test suite. +2010-04-23 + Removed real number stuff. + Removed Scientific Calculator stuff. + Removed statistics package. + +------------------------------------------------------------------------ +Forked this version. +------------------------------------------------------------------------ + 2009-09-06 Removed EXPAND-QUASIQUOTE. It is no longer needed, because EXPAND-MACRO can now be used to expand quasiquoted forms. @@ -651,7 +1285,9 @@ Removed redundant clauses from FOLD-LEFT and FOLD-RIGHT. Fixed a bug in the syntax checker of SYNTAX-RULES. +------------------------------------------------------------------------ Major change: re-implemented DEFINE-SYNTAX/SYNTAX-RULES +------------------------------------------------------------------------ 2007-09-23 Applied some cosmetical changes to DEFINE-SYNTAX. @@ -711,7 +1347,9 @@ macros. Rewrote LET, LETREC, LET*, CASE, DELAY using DEFINE-MACRO. +------------------------------------------------------------------------ Major change: switching from DEFINE-SYNTAX to DEFINE-MACRO +------------------------------------------------------------------------ 2007-08-29 Misc. small, cosmetical changes. diff -Nru scheme9-2009.09.06/_checksums scheme9-2010.11.13/_checksums --- scheme9-2009.09.06/_checksums 1970-01-01 00:00:00.000000000 +0000 +++ scheme9-2010.11.13/_checksums 2010-11-15 07:04:30.000000000 +0000 @@ -0,0 +1,618 @@ +B6E6756DD201C208 007E 0136 ./CHANGES +C5A9C656080C0CB7 0003 0096 ./LICENSE +2E93DA64FD6DD68F 0010 0069 ./Makefile +E9D52BDA6C0373AA 000D 0149 ./README +1173B5576DFE3C24 0001 0071 ./Todo +BD5DFBE451AB08A9 004C 0178 ./contrib/format.scm +100F1A8BDF797E35 0015 01E6 ./contrib/format.txt +5C5C9843E47C67EA 0013 0000 ./contrib/format-test.scm +43E78BF8E0383243 0011 01EF ./contrib/prolog.scm +26B56D012C7CBCE8 002B 00A7 ./contrib/pretty-print.scm +CDB9C0D9804A3499 0005 00A5 ./contrib/string-locate.scm +B7BB3AE2312DFC7C 0009 00EF ./contrib/help.scm +0D4D8582018ED96B 000B 002A ./contrib/draw-tree.scm +252845640B42008C 0003 0066 ./contrib/prolog-test.scm +B4AC830C3FEB62E3 0004 01DA ./contrib/zebra.scm +C2B78263F52FDFBA 011F 0187 ./contrib/arse.scm +77422B070766E805 0036 0185 ./contrib/arse.help +30E77F29041814BC 000A 0037 ./contrib/arse.porting +2BC07EE287C84B81 0024 0153 ./contrib/sos.scm +A6DAD4B694212F23 003A 0003 ./contrib/sos.txt +71D8EA411E5AFAC3 002C 0041 ./contrib/scm2html.scm +EB499F5D7952D750 0006 012F ./contrib/scheme.css +6B201CC0F576B3B5 0020 000B ./contrib/c2html.scm +D6B78AF6F837AD7B 0001 01DD ./contrib/ccode.css +6BE6C7DFB6D14040 0011 0055 ./contrib/S9Book +CD26C7DFB6D58530 0011 0055 ./contrib/S9Book-bw +2C24057583368B49 003C 01F7 ./ext/unix.c +ABC0E347E3E0419A 0001 01CD ./ext/leap-yearp.scm +7AC417FB58330CEE 0004 01BC ./ext/spawn-command.scm +CB4A6F7377890832 001D 01FB ./ext/unix.scm +12F3EE2A8EFE9D8F 0003 0029 ./ext/proper-timep.scm +BB19B9DB9ACFB486 0002 019A ./ext/basename.scm +3537E3B7CEE725C2 0005 005C ./ext/unix-time-to-time.scm +122536A742945D3A 0004 00B6 ./ext/time-to-unix-time.scm +194A06798D641687 0003 0187 ./ext/dirname.scm +4760F916274C5773 000A 0098 ./ext/format-time.scm +C8EB696C0A295FB0 0002 013C ./ext/append-to-output-file.scm +80FA58FD9E68ED68 0013 00D7 ./ext/parse-optionsb.scm +99075BB3F42F2FEC 0003 000B ./ext/search-path.scm +80B7D54E68371624 0002 014C ./ext/unix-tools.scm +6A6197718428417D 0009 0029 ./ext/find-help.scm +529E389AA5BCF29F 0003 0163 ./ext/mode-to-string.scm +6C354F422B824223 0002 0057 ./ext/flush-output-port.scm +1D6C7C162E1D1D96 0004 0094 ./ext/standard-error.scm +9011B44D62B8FE94 0018 006E ./ext/curses.c +1A684E0AA784046B 0004 00C6 ./ext/curses.scm +53C6B42F398740EB 0009 0005 ./ext/inet-server.scm +D4AA1E3C63B59881 0004 017C ./ext/spawn-shell-command.scm +97E3AD410D58AC82 0002 00D9 ./ext/find-help-path.scm +224E48355EDB0067 0005 0124 ./ext/time.scm +32A6A7EFCB1A32D9 0014 0057 ./ext/runtime-stats.scm +08A16490E6BE5F75 0006 010D ./ext/time-ops.scm +A9C546DB6776B2E2 0009 01E5 ./ext/get-line.scm +40F2B9ACEEF4812E 0001 0187 ./lib/count.scm +63751ECFEA8745CC 0001 0147 ./lib/depth.scm +CD9A1C12D0BFAE22 0002 009B ./lib/filter.scm +BFC5090677BDE97E 0002 0009 ./lib/flatten.scm +0D6B744F32A44783 0003 000A ./lib/iota.scm +C17FF0BD24E02A58 0002 00DA ./lib/mergesort.scm +3A3450D853D227C8 0002 01FC ./lib/partition.scm +A8ECE331FB4EFC80 0002 0125 ./lib/quicksort.scm +D8C9A4ADE673B381 0003 011C ./lib/remove.scm +8CE3C38A17194A68 0002 0040 ./lib/replace.scm +45DACA5A7F1A7A2A 0002 0044 ./lib/substitute.scm +D90AC6D161260DC5 0002 0199 ./lib/read-line.scm +D40504FDB3202797 0001 0197 ./lib/explode.scm +B9D5A1845E750D73 0002 0048 ./lib/implode.scm +CC63C857C7C00125 0003 0051 ./lib/exists.scm +583C3EC3202239A7 0004 005A ./lib/factor.scm +E4057AB8A113CE68 0002 0061 ./lib/factorial.scm +7F58DE29507A396C 0003 0142 ./lib/for-all.scm +CDF2C6E42DC2D003 0002 002F ./lib/hyper.scm +37D649343B0B0D83 0001 0171 ./lib/sum.scm +3807F9E256E47E54 0002 0103 ./lib/integer-sqrt.scm +DCAD16F33F0C1287 0003 01AC ./lib/combine.scm +8974FB9C48CEA7B1 0005 01FA ./lib/hof.scm +614ABD21E007F6CC 0003 00DB ./lib/make-partitions.scm +CA7DB6E7A80018D4 0002 0099 ./lib/list-to-set.scm +E619C3543303567F 0002 00E0 ./lib/intersection.scm +E1E7DB8418D6A141 0001 018C ./lib/transpose.scm +BA5446973DFC4D9E 0001 016F ./lib/union.scm +E9824478BB080288 001D 01B9 ./lib/regex.scm +5F7D1A8D300C0696 0003 0066 ./lib/string-split.scm +AF472733BF51408C 0015 0046 ./lib/read-from-string.scm +253A048C7FE857FC 0008 0104 ./lib/write-to-string.scm +32CFEDC1BC154D93 000C 0048 ./lib/package.scm +F2285C6F3952CC81 000B 01BA ./lib/amk.scm +88A0439341F7E9C9 000C 019B ./lib/symbols.scm +46589C2564C7352E 000E 0110 ./lib/records.scm +4EE2CA8E79290210 0003 0111 ./lib/cond-expand.scm +67F57647DE13471B 0005 012E ./lib/letrecstar.scm +6AC231C23DF4942C 000C 0162 ./lib/programp.scm +43E43B45CC8C9947 0005 00C5 ./lib/fluid-let.scm +58A47C821F163213 0002 0147 ./lib/read-file.scm +F3DBC83D3F4EE7DE 000B 01B0 ./lib/bitwise-ops.scm +AFC13A3739C65619 0003 00CD ./lib/fluid-let-sr.scm +D398F2735FEFB782 0005 005B ./lib/keyword-value.scm +1FBA323889AE41BE 0013 003D ./lib/matcher.scm +FE2C2EF1C236019C 0002 00F4 ./lib/string-case.scm +28D96781FFDDFC3C 0002 0195 ./lib/unsort.scm +C546E1E81DB3214E 0003 01E1 ./lib/string-parse.scm +EFA424017319DD64 0002 00E4 ./lib/string-unsplit.scm +DBAD6424EC2A8023 0002 013E ./lib/sieve.scm +06B7FEA1EA0D455E 0002 0174 ./lib/displaystar.scm +0C45AFA6EAD99000 0002 01CD ./lib/list-tools.scm +BA479FF31BA2222D 0002 00A4 ./lib/syntax-extensions.scm +352062E4DBADD9DE 0002 0018 ./lib/math-tools.scm +60D38FFB1269A17F 0002 004C ./lib/set-tools.scm +5B3D3BF5EF8377ED 0001 019F ./lib/io-tools.scm +71491CFD0BCC7381 0002 0169 ./lib/string-tools.scm +A2035E44B7D012E6 000C 015A ./lib/streams.scm +EF2D2B6137B5393D 0004 0083 ./lib/string-find.scm +A33E5D155C85211C 0003 009E ./lib/string-translate.scm +EE608E10F44357CA 0003 0099 ./lib/string-digest.scm +7C3C1F77DC6247A4 0004 0130 ./lib/string-find-last.scm +17AC75F87578046C 0006 0136 ./lib/name-to-file-name.scm +0306F9EAE24A269E 0005 00FA ./lib/and-letstar.scm +55B372C11647F2F8 0010 002F ./lib/syntax-rules.scm +4E24DE73C0336F73 0005 01DC ./lib/string-position.scm +14F99B2CF3B23051 0006 006B ./lib/string-last-position.scm +974F5671D02D73D6 0008 0153 ./lib/split-url.scm +1A9435E233D0B117 0004 00C1 ./lib/url-decode.scm +68F192A08ED25146 0009 005D ./lib/tagbody.scm +E8C3DDFDC6CFE370 0004 00B5 ./lib/vector-map.scm +437810D8DD083FAB 0002 0142 ./lib/string-scan.scm +BCCA176214E03876 0001 0197 ./lib/sort.scm +BFC1BF6594F359B2 0003 0006 ./lib/string-map.scm +4C71188CBE713376 0002 0103 ./lib/sublist.scm +7FB85A3BA0B0AD86 0003 003B ./lib/subvector.scm +0FBE86429D67CFAA 0001 0107 ./lib/vector-tools.scm +EB792E83DD53A382 0002 00BE ./lib/letcc.scm +5FF7DBE462DB50E8 0004 019D ./lib/threads.scm +DD941219EC4F8E3B 0004 005B ./lib/catch.scm +4DDD16DDCC2BE8B1 000D 01C5 ./lib/define-structure.scm +FB14583C43AAE066 0011 0104 ./lib/array.scm +59680D3923392DAB 0006 01BC ./lib/amb.scm +4DD002E20FCA84E2 0003 0143 ./lib/position.scm +0D1EF4142243A71E 0002 00F4 ./lib/set-difference.scm +33BD1B5B23105559 0001 016B ./lib/adjoin.scm +1B197C1DD4A83027 0002 01A4 ./lib/subsetp.scm +87D48DEC97BDA17B 0003 014F ./lib/tree-copy.scm +7D59BB96155DBB8F 0002 018D ./lib/equal-cip.scm +18A1AF51C9D95D27 0003 01C7 ./lib/type-case.scm +DE7226B07B5E153B 0002 001B ./lib/assp.scm +8CA649F2923C995D 0002 0001 ./lib/memp.scm +DB310D336023DA6C 000E 0157 ./lib/t-sort.scm +04700139D92FBC5D 0001 0136 ./lib/graph-tools.scm +30B79B87A2D08A44 0002 0169 ./lib/tree-equalp.scm +B5168FEC9C5E8DD1 0001 019B ./lib/data-structures.scm +15F71AF05A28C593 0005 005D ./lib/permute.scm +719746455EA8E50D 0004 00AD ./lib/random.scm +86067F578C75F8C0 0003 0009 ./lib/split.scm +B0D6D8DEBDA39014 0003 0170 ./lib/merge.scm +BBF61C01D93FC08D 0004 0124 ./lib/integer-to-binary-string.scm +EFB04C323131FBE1 0002 0083 ./lib/id.scm +DBB0D6C87F533231 0004 01C7 ./lib/memoize.scm +FA74CF0CAD8F7E91 0004 01D7 ./lib/queue.scm +A3FAAE0633A19D08 0003 0173 ./lib/duplicates.scm +3BE6AC78B9ECB468 0003 0004 ./lib/when.scm +9460A366B322935D 0003 0123 ./lib/while.scm +04C4E24E1017DF19 000E 00F0 ./lib/hash-table.scm +1BD7270BF9525A5E 0001 0116 ./lib/_template +1C8025E903A40069 0003 0013 ./lib/tree-map.scm +B8B428ACB7D12BCD 0004 00A1 ./lib/simple-module.scm +FB82D61F3589F4A2 000C 012C ./lib/char-canvas.scm +3F2F395E18517EFD 0002 004C ./lib/listq.scm +27AE634991581A4E 0003 00D8 ./lib/appendb.scm +D059711FDA108228 0002 00C5 ./lib/random-sort.scm +AEA747A52D1A9BA6 0002 0170 ./lib/string-reverse.scm +3785FA9EE847D3AE 000F 01F1 ./lib/rb-tree.scm +A6A9A5B2CF9359E5 0002 0142 ./lib/group-list.scm +57B192274161CE4A 0006 01A5 ./lib/setters.scm +4A0285F6C46A7016 0002 00CE ./lib/htmlify-char.scm +1F54387FEEEA5377 0003 0131 ./lib/loutify-char.scm +597F8E84D36F9207 0003 00A7 ./lib/string-expand.scm +6D477D813A19E2EA 0006 0132 ./lib/bitops.scm +7B2167B2E683B982 0002 0101 ./lib/string-prefixeqp.scm +0185AE2B78B0E7E5 0005 01AC ./lib/get-prop.scm +5B2D3B028569A340 001A 0021 ./s9.h +268BBEB769AA932C 0001 00A1 ./mkfile +01251DFC552FD68C 001C 0195 ./s9.1 +05934D024A9C3ADF 00DB 0093 ./s9.c +F3745DDA6DBA591E 0022 002A ./s9-real.c +4F3144D68686E09A 000C 008C ./util/rpp.c +46E388DA334DE03F 0001 00BA ./util/rp_html +4A0B6FE521D0CAE4 0078 00F8 ./util/test.scm +86CF147C1D54449E 0036 01F2 ./util/libtest.scm +4D1E4254DAC7BBCA 0003 01D2 ./util/libtest.sh +44A28116ECA32586 0001 012E ./util/dirhead +DE7A8645D1E5B6DD 0013 0035 ./util/descriptions +8469A9698973E578 0001 0045 ./util/dirtail +374FAFB4A32B0D73 0007 00FB ./util/srtest.scm +BEC17F5D11E17A3E 000E 01A0 ./util/make-html +7D57A753502BF0A2 0008 01C7 ./util/s9.css +43DF34182F2FF115 0004 00A7 ./util/make-docs +829A74B5D45B97E0 0001 0143 ./util/libhead +8469A9698973E578 0001 0045 ./util/libtail +C614BD411B952B0B 0018 002F ./util/make-help-links +D2DD6A9E841CEE6D 0008 0114 ./util/stress-tests.tgz +7497FDDC0469C0FE 0022 001F ./util/systest.scm +010F2AB76061134F 0003 00E5 ./util/check-descr.scm +17424CC3D8FB0AAB 000F 002F ./util/categories.html +921E23C8B0BB59F3 0005 0137 ./util/make-cats.scm +91698035D48FDD91 005B 0094 ./util/realtest.scm +195E15120205FE13 0021 0057 ./s9.1.txt +DEC4353681FA1518 0002 008E ./config.scm +1D477C6A1A87D4A9 0004 0102 ./prog/c2html1.scm +30D77A89732742E0 0011 01F7 ./prog/s9resolve.scm +1E981ED8326E49DF 0006 0028 ./prog/soccat.scm +41AC9AF380F88756 0005 00C5 ./prog/htmlify.scm +EB000181BA3C83DD 0006 00FF ./prog/dupes.scm +0354BE0979A8EA67 0005 0179 ./prog/s9help.scm +7A26191A005E7C93 0006 00E6 ./prog/scm2html1.scm +982346F67315897A 0026 01BF ./prog/advgen.txt +ED3E319C3A2A602C 002E 0167 ./prog/advgen.scm +D5177D4F283C4D7A 0002 0172 ./prog/adventure.intro +012A6A5A625CFA48 0001 0032 ./prog/adventure.imprint +5138E755D8B67BE8 0004 0134 ./prog/scmpp.scm +6436704C08A1CA61 0030 00D9 ./prog/adventure.adv +1066BD0000EB981A 0002 01DB ./prog/arse1.scm +4B41FF1492AB688B 0001 0171 ./prog/dot.arserc +D006C8770215042B 0012 00F0 ./prog/s9hts.scm +7FAF9CEAEAC4ED3D 0005 0162 ./prog/cols.scm +FF39CF60C9EFBA35 003E 00E2 ./prog/edoc.scm +2DE1CC1539911E87 0002 0162 ./prog/edoc.css +8C1FEF02DA3405B6 0003 0058 ./ABOUT +4A8313B64FB612B1 0002 0085 ./freebsd-port/Makefile +9A388033D7A8E5ED 0001 00C7 ./freebsd-port/distinfo +FE9EBD5F8B33AC8B 0001 0126 ./freebsd-port/pkg-descr +33BB64631324458D 0030 0189 ./freebsd-port/pkg-plist +8917DCEE57C08C00 002B 008D ./s9.scm +CDB173E1B4541723 0022 0173 ./s9-real.scm +47DBFFF80F5D21D9 0004 0157 ./help/help +661324FFC5F99F37 0001 010C ./help/not +53F34BBE0E762149 000A 0146 ./help/eqvp +E1C076DC0ED20B52 0001 00A1 ./help/delete-file +FCC4F26DB41D498E 0001 00BF ./help/booleanp +0A0201187FF17E63 0004 006B ./help/eqp +866329B191D7C535 0002 00A2 ./help/equalp +A99BE705C3286E20 0001 00D1 ./help/pairp +87541D69B0DD9264 0001 018B ./help/cons +1C0287BACD349661 0001 0101 ./help/car +43345406369E0511 0001 00EA ./help/cdr +7B892CC73268D91D 0001 0113 ./help/set-carb +DD092CC73E6EE51D 0001 0113 ./help/set-cdrb +49144AF7400A2BEB 0001 0195 ./help/caar +47F6BB6F96DF82C5 0001 0066 ./help/nullp +30D874F7C963DBB3 0001 014F ./help/listp +2E1C1644DC4271CC 0001 009B ./help/list +F80040835202DBC4 0002 006D ./help/append +0FA13318EDBCE560 0001 00AA ./help/length +BD006A4AD45AD987 0001 00E0 ./help/reverse +D4DA59D76927DF0C 0001 00EF ./help/list-tail +339C3DF15A0902E7 0001 00B1 ./help/list-ref +FE52C2EE12ED1A6B 0002 012E ./help/memq +BB59F534C038455F 0003 0046 ./help/assq +F13B1FDC05220069 0001 0123 ./help/symbolp +5C006B86A416387A 0002 01E9 ./help/symbol-to-string +FFD712951E986CA0 0002 0182 ./help/string-to-symbol +D3AC55056D6013FB 0002 0120 ./help/numberp +723401B46F941B19 0002 0149 ./help/eq +8F7DFB75600607B7 0001 0161 ./help/zerop +F89E61506D3BCCCA 0001 0124 ./help/max +7FCA8AA9ED919399 0001 0135 ./help/plus +F772586588436FEB 0002 0056 ./help/letstar +A3DBB9B49FF6571E 0001 0194 ./help/minus +CD0876DF8D09544F 0001 0064 ./help/abs +ED21DFF355609178 0002 01F7 ./help/quotient +B4D6738A213678F4 0001 0136 ./help/gcd +5E8C72263E4A9F6B 0001 0087 ./help/expt +7EE7005FA0B664FF 0002 01F1 ./help/number-to-string +396A86F978E2691F 0002 018C ./help/string-to-number +47F6AD7265F72B2F 0001 0063 ./help/charp +0F4E2B5890E28201 0002 01AB ./help/chareqp +15BBCEF2F110A02D 0002 0064 ./help/char-cieqp +1FDAAECAFF73A521 0001 0062 ./help/stringp +69F44FE30855E2D6 0002 00C1 ./help/char-alphabeticp +05E253858FA57298 0002 00D4 ./help/char-to-integer +016FD40CB81A3054 0001 012C ./help/char-upcase +AEBD88BC372813FE 0001 0126 ./help/make-string +CFCAC4F83631B677 0001 0066 ./help/string +C0AD0942F6BD5441 0001 0066 ./help/string-length +FD9414A50CCB235E 0001 00B9 ./help/string-ref +D18BB104FAF24DA7 0001 01C4 ./help/string-setb +D08DE76A98C1659C 0001 0185 ./help/stringeqp +56D1F61BB024A0EB 0003 002E ./help/stringltp +0274ECDB7A14247E 0001 0162 ./help/substring +CD69082199FD61FB 0001 0092 ./help/string-append +9BCDEA940934D9B0 0001 015C ./help/string-to-list +7E55751E754984D2 0001 0061 ./help/string-copy +9A8DC0DD636CB104 0001 008A ./help/string-fillb +1FDAAECAFF8AE441 0001 0062 ./help/vectorp +84BAFE6797269F02 0001 0126 ./help/make-vector +6295BD6EC2CEAFF0 0001 00AE ./help/vector +C0ACF3D1A98DAE41 0001 005A ./help/vector-length +2D6029ED924988EB 0001 00DF ./help/vector-ref +2A90618E8E3EF811 0001 01CB ./help/vector-setb +E44F03CA249D95DA 0001 0181 ./help/vector-to-list +2F3311B2773B7DD4 0001 0096 ./help/vector-fillb +3BD901B13E228404 0001 0119 ./help/procedurep +9C5A49E678C30A79 0001 01FD ./help/apply +4C38382F79D2F47F 0002 0108 ./help/map +B48E9CE8B19828EB 0002 002E ./help/for-each +D63037A83320D3A6 0006 01EF ./help/force +4AFECBCD0C045854 0002 0145 ./help/call-with-input-file +75B09654770C391F 0001 00B8 ./help/input-portp +B0A15F7083ACAE07 0001 0098 ./help/current-input-port +8CE2893D00081790 0002 00DB ./help/with-input-from-file +42DF7984B2DAF995 0001 00DE ./help/open-input-file +9CCEC5921C6EAAD9 0001 0140 ./help/open-output-file +FCBA96E241A61162 0001 016C ./help/close-input-port +B196B16E16B7FE18 0003 0032 ./help/read +DDD237E8BE024F43 0001 0194 ./help/read-char +B6B79654EBBC2659 0002 014C ./help/peek-char +41D6770B764EDF8A 0001 011B ./help/eof-objectp +CB9A176C325C547E 0001 01EF ./help/write +6FE85B58F53FA1B9 0002 0137 ./help/display +0E99C808CDA36E76 0001 0165 ./help/newline +2F75DAB51423748B 0001 016A ./help/write-char +CEA7F4A94912B97A 0002 0044 ./help/load +ACE80EF36232CAF5 0001 0082 ./help/file-existsp +928D26B4886D0A0F 0002 019A ./help/fold-left +5E6019B99FE8B951 0002 01A8 ./help/fold-right +EDFC3017A178CA81 0001 0170 ./help/gensym +5561784AD1AC096A 0001 016F ./help/load-from-library +D4434A5A4849D237 0002 01F9 ./help/locate-file +5BB42AE88C65C33F 0001 0158 ./help/print +1E5144F364D286AD 0001 00F5 ./help/set-input-portb +14DCA205B0FB881D 0001 004F ./help/symbols +92955140AFBD5155 0002 0025 ./help/begin +2E566C19D7CA9B1D 0003 014C ./help/case +2A7DA465FA499B69 0004 0070 ./help/cond +1486E5A007D84F58 0006 0112 ./help/define +F6BCBCF48F2B11D8 0004 01B9 ./help/do +E5F3B7EDA5D74209 0002 00BD ./help/if +6C62CA3217818CCA 0005 00EA ./help/lambda +20A8B099FD5D5FD6 0004 00D4 ./help/let +518F148E60D12E68 0005 0190 ./help/quasiquote +00F375A7417A83FC 0003 01C6 ./help/letrec +2846CA666A47A766 0002 002E ./help/or +7241F45320A1CE33 0002 001B ./help/and +540072530B9243D6 0003 0066 ./help/quote +7F1B8989D96DBE7B 0001 018F ./help/setb +D958B8FEF861CE97 0003 00B9 ./help/starstar +2622C2980F135391 0005 0038 ./help/define-syntax +25890AFCEDBB7626 0008 0120 ./help/syntax-rules +CE0D1394FEF04A3A 0007 00FC ./help/bitwise-and +3768766B9B3BC823 0004 0077 ./help/complement +54D562EEECF3764C 0002 0038 ./help/cond-expand +2A3958BBA59E0809 0001 0068 ./help/count +241FB7D7FE02D7E2 0001 0065 ./help/depth +EA0BD37F31399C23 0002 0023 ./help/draw-tree +2BDE90A46F2679E4 0002 0030 ./help/exists +C5FADB0B1C643C78 0001 008F ./help/explode +B1C866ACE3A22CC1 0001 00AE ./help/factor +A6ACBEB145E4718B 0001 0086 ./help/factorial +B09D2354B3588A82 0001 00E6 ./help/filter +1E8F23CDE9EFAAB1 0001 0070 ./help/flatten +C3997D1846A4ADAC 0002 0062 ./help/fluid-let +455A31843367BB2C 0002 00AE ./help/for-all +7A4563450BEEADC4 0016 000D ./help/format +714AA761FEF3E65F 0001 00A1 ./help/hyper +DC580E2147174751 0001 008F ./help/implode +A8CDACFBB36871F8 0001 00A0 ./help/integer-sqrt +FBCF0F5CE928E18C 0001 008F ./help/intersection +73F723CD0D600007 0002 0007 ./help/iota +ECBF24F76381ECE4 0001 00BC ./help/list-to-set +C84211AD60173198 0005 013C ./help/make-hash-table +49F7822FA2DDFE9C 0001 0132 ./help/make-partitions +F20A42684718B288 0001 00F0 ./help/mergesort +218BD3FBB8EC463E 0003 010C ./help/make-rbt +B64A05E9383515D3 0002 0087 ./help/module +0BB815ED4BA77DB4 0001 01B0 ./help/partition +D93A96398513C2EB 0005 00BF ./help/pretty-print +83D102D4D8E241AD 0001 0102 ./help/programp +E9119B5E9C02F064 0005 008F ./help/record +5DDE64070A618856 0004 002C ./help/prolog +0B62532314BCF04C 0001 0069 ./help/sum +A79C26476D12163C 0001 00EC ./help/quicksort +74A8780BA79845CA 0008 0083 ./help/re-comp +EA8E3D2A23A3D35C 0001 013D ./help/read-file +EBC3E5892C914D5A 0003 00D4 ./help/read-from-string +523B1244EA20929B 0001 0124 ./help/read-line +EF41CA6D8191865B 0002 0069 ./help/remove +9D81B54122E38363 0001 00D9 ./help/replace +0A16B3B1642DCC94 0002 0023 ./help/runstar +B852ADB8CC9AA1DD 0001 0120 ./help/mode-to-string +9E99EF2D701CBBF3 0003 0034 ./help/string-find +B37AD5C68D27CF06 0001 0167 ./help/string-split +228CEDE182C718B2 0001 0082 ./help/union +4DAB29EAD1E9BD65 0001 0105 ./help/substitute +E1C0B565153724BD 0001 00CE ./help/transpose +E5A1A71B3E24D67F 0002 005C ./help/write-to-string +BC000B9E3F8DD391 0001 0159 ./help/zebra +695252F45313FA22 0001 01BE ./help/string-upcase +8722254C1AD83B67 0005 00C8 ./help/define-matcher +B80C6EC59A5AF300 0004 0014 ./help/sys_chmod +FAAB85AC61691BF2 0002 00EA ./help/sys_chown +1BF3AA7C897F650F 0001 01B6 ./help/sys_access +D5D6BCE65AFAF8EC 0001 01E8 ./help/sys_dup +62D4469F6EB1582A 0001 0087 ./help/sys_chdir +71E46E57EC1D595A 0001 0158 ./help/sys_command-line +FA16D1F3B8DB2C7E 0001 00E9 ./help/sys_errno +49E17F8CF5FBEACF 0001 0079 ./help/sqrt +2F30936CC619F3B3 0001 0136 ./help/string-parse +D350E1D141374F06 0002 01C3 ./help/format-time +49F259B5E49143BC 0001 0135 ./help/sys_execv +E62237738116D451 0001 0122 ./help/sys_exit +06A72210662C30D5 0001 00CA ./help/unsort +B190022B897D8ECE 0001 0097 ./help/dump-image +82099D6C5E84CCC2 0001 0172 ./help/error +C0B23AD62EF9AC48 0001 0083 ./help/sys_flush +3210149963B4BF38 0001 0112 ./help/sys_fork +790EE7D90A6554BE 0001 00E1 ./help/sys_usleep +669FC1D7C791C672 0002 0125 ./help/sys_user-name +61A942513D409E8A 0003 0085 ./help/letrecstar +E782A08A5DD8FFFA 0001 01D8 ./help/string-digest +EC8FDB20B82CE7B0 0002 00F6 ./help/sys_lseek +677F26A1CF421947 0001 0072 ./help/sys_getcwd +0734810294441500 0004 00E4 ./help/sys_open +1FE670CA632B1079 0001 00E1 ./help/sys_getenv +C02C078EFF63A2F9 0001 00B2 ./help/sys_readlink +BA01E37EDA7A5FAC 0001 01A2 ./help/sys_getgrnam +6F9A412E447FBE2D 0001 00A3 ./help/sys_rename +B9CFA8D2CD96E823 0001 0102 ./help/sys_getpgid +8F5DBB6099C7CF26 0002 00BA ./help/sys_select +C07BD3A2DD3E3480 0001 01DA ./help/search-path +FCD7A0CB47CED647 0001 00AC ./help/sieve +65B5CB37B7B2948E 0001 00A7 ./help/sys_symlink +70DA01BA5EBB83F3 0001 0066 ./help/sys_getpid +6715D8AC8452AE12 0001 00AB ./help/sys_system +560AA96FF00A203F 0001 0121 ./help/sys_getpwent +6FF8D9AE3EA7560E 0002 0160 ./help/sys_umask +16F23B05BC8DBCF3 0002 0145 ./help/sys_getpwnam +EDD40A694FD8BC3C 0001 00B0 ./help/sys_unlock +795FDF51F39A7A41 0001 00A9 ./help/sys_getuid +F066B007B2BFDCB6 0001 0128 ./help/sys_utimes +1594A2CB3BF0FB98 0002 00B1 ./help/sys_wait +5218AB8B869DD3D8 0002 0134 ./help/sys_inet-connect +952D692DAE0F3D14 0003 015A ./help/sys_inet-listen +FB3F869BFE549F2A 0001 0145 ./help/time-to-unix-time +E3EAB3684D97468B 0002 0018 ./help/unix-time-to-time +4AFBCCEF33668995 0003 01C5 ./help/sys_stat-name +457E2685F3E4C9AE 0002 010B ./help/sys_kill +6F02211B72EB86AC 0001 00AA ./help/sys_link +4DE1D6A43CAB018D 0001 019E ./help/sys_lock +91BE92451E36B15C 0002 0025 ./help/sys_make-input-port +83C84260D64B0198 0001 013C ./help/basename +F0A2988C5FA5C9EB 0001 00CE ./help/string-unsplit +625C19BDA277F159 0002 005C ./help/dirname +7CAE2038F383B483 0001 0106 ./help/proper-timep +2955E9371992BD49 0001 00D6 ./help/leap-yearp +0E608F84E037B53D 0001 0093 ./help/sys_rmdir +55EBF2AE01EEFE27 0001 010A ./help/sys_mkdir +BAEB4003169F6163 0002 0062 ./help/sys_pipe +F906CC6FB5F7E502 0002 01E0 ./help/sys_read +75828B5D60345669 0001 00E7 ./help/sys_readdir +2F7FD4580DE5F80E 0001 015C ./help/sys_setuid +85506A0DCF96929E 0003 017B ./help/sys_stat +21AA7BAC84405A40 0001 009D ./help/sys_unlink +0B704D4FA8083C42 0001 01A2 ./help/append-to-output-file +AA9D2CF109836DBE 0008 0120 ./help/parse-optionsb +3A44BD896F3B679D 0002 010F ./help/spawn-command +BBE90906F78D5CC6 0001 0173 ./help/displaystar +804A04F4584DEF93 0002 0164 ./help/find-help +0BD8A7D6E28F81E3 0001 0166 ./help/sys_group-name +4043B50374DD774F 0002 0079 ./help/string-locate +FBFB832A394E2885 0001 0122 ./help/flush-output-port +4792DF88BC510423 0002 0135 ./help/spawn-shell-command +BE49E09270B67713 0001 00D1 ./help/arse +9216DD2EF179F4EC 0003 0098 ./help/string-find-last +502195C81D62DBEE 0001 00CA ./help/find-help-path +98A9D956B0296E46 0007 01B0 ./help/make-stream +AD43B87553E65669 0003 0009 ./help/name-to-file-name +9C58EDECDD7632E9 0002 010A ./help/standard-error-port +82042165D46179DC 0001 01C2 ./help/string-translate +667A63CD767F86BA 0001 011C ./help/string-scan +25FFBAA24E0CA85A 0002 0137 ./help/and-letstar +0B37DB694DDC98E9 0004 0008 ./help/curs_addch +236CFD0EB2D656C2 0001 011A ./help/sys_get-magic-value +BFD3AB7223997572 0005 018C ./help/curs_flushinp +FC9C65C7893D884F 0003 01B8 ./help/curs_delch +98E11D9E2831E2E9 0003 00AB ./help/curs_attroff +580AF7C92A9FE9D3 0008 0003 ./help/curs_cbreak +FC868632BC7CA693 0001 00C8 ./help/sort +926038290F0E94B4 0002 00A2 ./help/curs_clear +2D1C16DDE9934377 0002 0039 ./help/curs_cursoff +59499F1CCB70DE3D 0002 0106 ./help/curs_endwin +906E19D3055D53B4 0001 019F ./help/sys_inet-getpeername +0CAC9540B280555D 0003 0082 ./help/string-position +6A5BDC5CBA154415 0003 00E4 ./help/string-last-position +DC87F9BEA3C3586F 0003 0199 ./help/split-url +61CAF566763FBDEF 0004 00C8 ./help/inet-server +D2E5E78554AFB360 0003 00B9 ./help/sys_stat-regularp +71E8F4AD376AA918 0001 00EF ./help/sys_strerror +2F842389B22DE240 0002 014A ./help/sys_catch-errors +3930459BFBB90A82 0001 01BA ./help/url-decode +84D5C063C269A4C6 0001 00A4 ./help/sys_fileno +CC629553B36D0CB8 0001 01D3 ./help/r4rs-procedures +7398BED1962955F2 000A 0121 ./help/define-class +B1939A02FFFCFC91 0002 00DA ./help/vector-map +D0E1C4C0DFDFF387 0002 0064 ./help/string-map +40FF08B0421226B4 0001 01D4 ./help/subvector +E5A0D57F52A65A88 0001 010B ./help/sublist +3DC5CF87C621F682 0008 014E ./help/call-with-current-continuation +D00D9A57DAFBC082 0001 018D ./help/letslashcc +FB7F8ABBEBBA4339 0002 01AC ./help/thread-create +26F211647EF2D804 0003 0057 ./help/macro-expand +3B183ECA317A27AB 0002 01D0 ./help/tagbody +77BF1066C1F86945 0004 01B9 ./help/define-structure +C1D8CB0C2792C2A1 0002 016A ./help/catch +188068E2980ADAEE 0006 01AF ./help/make-array +865F77F01D7BFA43 0004 00E6 ./help/amb +AF1ABC9656DF86AA 0002 013A ./help/position +E5A5C1533335B20A 0001 0095 ./help/set-difference +F53A2093CDC4DC62 0001 008D ./help/adjoin +346CCD20F82D5933 0001 0175 ./help/subsetp +FAF897ED06DA5888 0001 00E5 ./help/equal-cip +D1355159A53B585A 0002 008C ./help/type-case +089C9401C639A498 0001 00E3 ./help/memp +93655CC86AD6C4DD 0001 00F6 ./help/assp +FF11EAF88A237E85 0007 00A6 ./help/t-sort +0A016D2691DB34E7 0001 01E1 ./help/tree-equalp +0E24B273D7F0E671 0002 0054 ./help/permute +7FCD8B4E1E1CC35E 0001 01FE ./help/combine +B11AB79FCED66A8F 0002 0064 ./help/random +994A9659F3A6B630 0001 01B8 ./help/split +BCA63543DD90B44E 0002 00D7 ./help/merge +2490D732981BC7E6 0002 01C9 ./help/integer-to-binary-string +9E044064DD6E9277 0001 019D ./help/id +74FDD4DA062D10B3 0003 0040 ./help/memoize +EEB541D28080E25E 0002 00D1 ./help/duplicates +8544230D84DCE009 0003 00DF ./help/queue +F971EE7A3343FC20 0002 00EF ./help/while +8A42094360BA93F7 0002 00E6 ./help/when +2DF51C4997A511C6 0002 0026 ./help/exp +133D746315222649 0002 01E9 ./help/keyword-value +A37062A140EC90BA 0001 01E0 ./help/reverseb +65EB237F12D967A1 0002 00DE ./help/stats +A72A9BA85252A32A 0001 00C3 ./help/syntaxp +96ECF75C0549DC32 0002 0018 ./help/trace +C57360FEDEB8A394 0001 003F ./help/void +5CA152AFE5E12183 0001 00C3 ./help/undefined +3ED511392BFD7FDC 0001 01FD ./help/tree-map +EFBB41D6B4713244 0003 00F4 ./help/pushb +71CD6D04F427D2D7 0003 01F4 ./help/package +942DF1C95FE2B148 0001 01CC ./help/sys_gettimeofday +A9789182F79F4FA3 0002 004E ./help/time +A78C32CFC04633EA 0005 010B ./help/runtime-stats +6BD461EF7D206B6B 0005 00A2 ./help/make-canvas +375CB8653F842935 0001 013E ./help/listq +C8D809564EFA9C72 0002 0011 ./help/appendb +7E16E1264AE92CED 0001 016D ./help/random-sort +72A0CE33B08696EE 0003 0019 ./help/floor +8E569C47770B0189 0001 00E5 ./help/exactp +7C51CCD3BB4FA92E 0002 0129 ./help/exponent +B41256C7F2177100 0002 00BD ./help/exact-to-inexact +F97EBF707A616273 0001 016E ./help/string-reverse +7E7A5BF514FC9B97 0004 00F0 ./help/c2html +4C00F9A4794BD0C0 0006 000C ./help/scm2html +57CC02731CCC1B25 0001 0156 ./help/group-list +34A1A9C11BC7A55A 0002 01DA ./help/char-readyp +1FFC26939DCB6ADA 0001 0139 ./help/loutify-char +20BBC8B4FB096EC6 0001 0131 ./help/htmlify-char +B69732DBF6D298C0 0001 0185 ./help/string-expand +048D3537F6E42410 0003 01A8 ./help/bit-op +EF389292ED27E9DB 0005 0050 ./help/bit0 +0AEC7BCD50BCE1DF 0003 01A6 ./help/time-add +AEFECC0BF199CC59 0003 012A ./help/get-line +BD9FB5F53EBD62DA 0001 0169 ./help/string-prefixeqp +13E5035D129E4992 0003 0057 ./help/get-prop +CD04ECD716FAF815 003A 01CC ./MASCOT.jpg +4919295E6B408256 0044 0145 ./edoc/s9-real.c.edoc +342C912FC19221EE 0031 002E ./edoc/s9-real.scm.edoc +12ED6282987E8386 01E1 01C6 ./edoc/s9.c.edoc +F03FB81DA81297BD 004E 01D9 ./edoc/s9.h.edoc +E34D5161E4492255 0057 00FC ./edoc/s9.scm.edoc +75B0E54500870D1A 0007 01ED ./edoc/Makefile +00000000044FF10E 0001 0014 ./edoc/reset-c +B41F19FC4EF39C7F 0002 015C ./edoc/f09.tr +057DDEA8CAAD6A9B 0003 00D1 ./edoc/index.html +22E871B59E111BAE 0002 0015 ./edoc/f04.tr +68AC3E26FF504729 0002 014B ./edoc/f08.tr +E74DE71284C71E9D 0031 0141 ./edoc/matcher.scm.edoc +29145744B5C01ECC 0002 0016 ./edoc/f15.tr +5AE569D3944562B0 0005 016C ./edoc/f02.tr +FE27E4FE63AAA103 0001 0109 ./edoc/f16.tr +899CD2BAD2F19723 0002 013C ./edoc/f07.tr +000000000537F23E 0001 0014 ./edoc/reset-scm +E524631A315D68AF 0001 0184 ./edoc/f01.tr +DEFA195FD5C35167 0009 00AA ./edoc/toc.edoc +F24268E9CF15D003 0008 0118 ./edoc/cover.lt +904214C27CAD2524 0002 010D ./edoc/f06.tr +7EDC59277A318136 0023 0138 ./edoc/syntax-rules.scm.edoc +FC256250C3DDB53F 0009 0012 ./edoc/preface.edoc +766412F174D5F224 0002 0139 ./edoc/f05.tr +E07AB7B7DB496EB4 0001 00C1 ./edoc/pngwrite +224BCC4FD3FB33BA 0008 0093 ./edoc/extensions.edoc +CBD5A7436B73AFA2 0002 0103 ./edoc/f03.tr +2D50E2F07FAA2691 0003 0041 ./edoc/f13.tr +796E862AC006830A 0001 0142 ./edoc/f11.tr +60C26813AEB37446 0001 01B1 ./edoc/f14.tr +74032A117291E724 0001 00F8 ./edoc/f17.tr +2F3475ADD08A64F7 0003 016B ./edoc/f18.tr +2E7E589879F3E120 0004 002E ./edoc/f19.tr +3A7D9452C59600EB 0001 0110 ./edoc/f24.tr +711D2FE6C9A8118B 0001 0187 ./edoc/f25.tr +265047732B90408D 0005 0154 ./edoc/f26.tr +CFCBA8ADB42E8ED2 0002 01A6 ./edoc/f20.tr +FDF964ACC3A3B44E 0002 00DF ./edoc/f12.tr +7901CC1A27E6AFC2 0001 01F0 ./edoc/f27.tr +2BFA963EBEEB742B 0003 005A ./edoc/f28.tr +82511D31919DA229 0003 0045 ./edoc/f10.tr +86D16C196E7B585C 0015 011E ./edoc/ascii-diagrams +BC34CF38C42D94AC 0002 0097 ./edoc/f30.tr +4BD157684DA6F195 0002 01C7 ./edoc/f31.tr +E72E3036CC7D5C40 06C7 01BC ./edoc/s9.lt +2B9B9103EDDFE3CE 0099 019D ./edoc/ndx.html diff -Nru scheme9-2009.09.06/config.scm scheme9-2010.11.13/config.scm --- scheme9-2009.09.06/config.scm 1970-01-01 00:00:00.000000000 +0000 +++ scheme9-2010.11.13/config.scm 2010-07-30 14:10:21.000000000 +0000 @@ -0,0 +1,21 @@ +; Configuration file for the S9 default heap image. +; Choose your extras or add your own stuff. + +(load-from-library "help.scm") +(load-from-library "pretty-print.scm") +(load-from-library "draw-tree.scm") + +(load-from-library "hash-table.scm") +(load-from-library "keyword-value.scm") +(load-from-library "id.scm") + +(load-from-library "graph-tools.scm") +(load-from-library "io-tools.scm") +(load-from-library "list-tools.scm") +(load-from-library "math-tools.scm") +(load-from-library "set-tools.scm") +(load-from-library "string-tools.scm") +(load-from-library "syntax-extensions.scm") +(load-from-library "vector-tools.scm") + +(load-from-library "unix-tools.scm") diff -Nru scheme9-2009.09.06/configure scheme9-2010.11.13/configure --- scheme9-2009.09.06/configure 2009-09-06 06:59:05.000000000 +0000 +++ scheme9-2010.11.13/configure 1970-01-01 00:00:00.000000000 +0000 @@ -1,25 +0,0 @@ -#!/bin/sh - -f="" -p=`echo $PATH | sed -e 's/:/ /g'` -for d in $p; do - if [ -x "$d/fortune" ]; then - f=$d/fortune - break - fi - if [ "$f" != "" ]; then break; fi -done - -if [ -x "$f" ]; then - echo - $f -else - echo - cat < Delete region. + When [d] is followed by a cursor motion command, it deletes + all characters between the current cursor position and the + destination of that motion command. E.g.: + [d][}] delete to the end of the paragraph; + [d][%] delete to matching parenthesis; + [d]['][m] delete to line containing the marker; + [d][t][x] delete up to next 'x' character. + + [D] Delete to end of line. + + #[i]text[ESC] Insert text at cursor position. + + #[I]text[ESC] Insert text at the beginning of the line. + Note that this command actually inserts at the + first *non-blank* position of the line. + + #[J] Join the current line with the next one. + Use [r][CR] to break up a line. + + #[o]text[ESC] Open a new line below the current one. + + #[O]text[ESC] Open a new line above the current one. + + #[p] Paste deleted or yanked text after cursor. + #[P] Paste deleted or yanked text before cursor. + When deleting or yanking columns of a single line, these + commands will insert columns of text, otherwise they will + insert lines. When inserting lines, [p] will paste below + the current line and [P] will paste above. + + #[r]c Replace the current character with c. + When c is [CR], the current line is broken up into two + separate lines at the cursor position. When breaking up a + line the count is ignored. + + [R]text[ESC] Replace characters. + + #[x] Delete character right from cursor. + #[X] Delete character left from the cursor. + + #[y][y] Yank (copy) current line. + + #[y][w] Yank (copy) current word. + + #[y] Yank (copy) region. + When [y] is followed by a cursor motion command, it yanks + all characters between the current cursor position and the + destination of that motion command. + E.g.: + [y][}] yank to the end of the paragraph; + [y][%] yank to matching parenthesis; + [y]['][m] yank to line containing the marker; + [y][t][x] yank up to next "x" character. + + [Y] Yank (copy) to end of line. + + ==== MISCELLANEOUS COMMANDS ================================================== + + #[^B] Move to previous page. + + #[^D] Scroll down half a screenful. + + #[^F] Move to next page. + + [^G] Print buffer status. + + [^L] Repaint screen. + [^R] Repaint screen. + + [.] Repeat last insert/delete command. + + ['][m] Set marker at current cursor position. + + [u] Undo insert/delete commands. + [u][u] will undo undo, i.e.: restore the state before undoing + the command. Repeating undo will undo multiple changes, e.g: + [u][.][.][.] will go back four steps in the undo history. While + undoing multiple changes, pressing [u] again will change the + direction of undo/redo history traversal. Here is an example: + + +-------------------- undo four commands + | +-------- redo two of the undone commands + | | +-- undo one of the redone commands + | | | + [u][.][.][.][u][.][u] + + #[z]c Zero (re-position) line. + [z][CR] move current line to top of the screen; + [z][.] move current line to middle of the screen; + [z][-] move current line to bottom of the screen. + When a count is given, the command will move to the + specified line. The default is the current line. + + ==== BLOCK COMMANDS ========================================================== + + [!][!][CR] Send current line through filter + [!][CR] Send region through filter + + #[<][<] Outdent current line + #[<] Outdent region + See [>]. + + #[>][>] Indent current line + #[>] Indent region + The [<] and [>] commands change the indentation of the affected + region by an amount of blanks that is specified by the INDENT + option. This number can be changed by specifying a count. + NOTE: When the cursor is on a '(' or ')' character, [>][>] + and [<][<] will change the indentation of the corresponding + *expression*. + + [~][~] Change case of current line + [~] Change case of region + + ==== BUFFER COMMANDS ========================================================= + + [^^] Edit the previously visited buffer. + (Yes, this is [control]-[^].) + + [TAB] Edit the next buffer in the buffer list. + (Rotate buffers.) + + [Z][Z] Save buffer and exit. + + See below for more buffer commands. + + ==== COLON COMMANDS ========================================================== + + Colon mode is entered by pressing [:] -- hence its name. + + Colon commands are entered at the bottom of the window. The following editing + commands can be used in the colon buffer: + + [^A] Move to the beginning of the buffer. + [^E] Move to the end of the buffer. + [^B] Move to previous character. (also [left]) + [^F] Move to next character. (also [right]) + [^U] Delete buffer. + [ESC] Abort command. + [CR] Run command. + + All colon commands have the following general form: + + [[,]][!] [ ...] + + The and parts specify the region (in lines) on which the command + will operate: + + # a series of digits indicates a line number; + . indicates the current line; + $ indicates the last line in the buffer; + 'm indicates the line containing the marker; + % is an abbreviation for 1,$. + + When only is specified, is set to . + + Not all commands expect a region. When none is given, a default is + used. Most commands operate on the entire buffer by default, some + on the current line. This will be indicated on a per-command basis + below. + + :! Run shell command (no lines affected) + + This command passes the given command to a subshell for execution. The + editing session is suspended until the command returns. The buffer will + not be altered. + + + :buffer close[!] Close the current buffer (whole buffer affected) + :bc[!] + + Close the current buffer and start editing the previously selected + buffer. This command will fail if there is only one buffer or the + current buffer is modified. Attaching a "!" to the command will close + the current buffer even if it is modified. + + :buffer list List buffers (no lines affected) + :bl + + List all buffers with buffer number, lines in the buffer, flags and file + name. Note that the buffer number may change! Flags include M=modified + and T=transient. + + :buffer open # Open buffer (no lines affected) + :bo # + + Start editing the buffer with the number # in the buffer list. Note that + buffer numbers may change! + + :buffer rotate Rotate buffers (no lines affected) + :br + + Start editing the next buffer in the list of buffers. + + :buffer swap Swap buffers (no lines affected) + :bs + + Start editing the previously visited buffer. + + :edit[!] file Load file into buffer (whole buffer affected) + :e[!] file + + Load the specified file into the current buffer. This command will fail + if the text in the buffer is modified. Attaching a "!" to the command + will discard the current contents and load the new file anyway. + + :help Open help buffer (no lines affected) + :h + Display this help file. + + :quit[!] Quit (all buffers affected) + :q[!] + + Quit ARSE. This command will fail if the text in the buffer is modified + or if any modified buffers exist. Attaching a "!" to the command will + discard all buffers and quit anyway. + + :read Read and insert file (lines added) + :r + + Read the content of the given file and insert it below the current line. + + :rehash Rehash completion symbols (no lines affected) + + Extract all symbols from the help database and store them in the + completion table that is used to auto-complete symbols when pressing + [TAB] in insert mode. The table is stored in the ~/.arse.symbols file. + + :s///[g] Substitute text. (default: current line) + :s|...| + :s,..., + + Substitute each occurence of the text in the specified range by + . Unless the 'g' flag is attached replace only the first occurrence + in each line. When 'g' is attached, replace all occurences. + s||| or s,,, may be used when the old or new text + contains any '/' characters. + When the "regex" option is set, perform regular expression substitution, + otherwise operate on literal text. + + :set option [...] Set options (no lines affected) + :set all Display options (no lines affected) + + List of set editor options. See next section. + + :version Display version (no lines affected) + :ver + + Display ARSE version. + + :write[!] file Write lines (default: all lines) + :w[!] file + + Write the specified range to the given file. When the file exists, do not + overwrite it. Attach a '!' to the command to overwrite an existing file. + When the current buffer has no name, this command will give it one. + + :write[!] Write buffer (whole buffer affected) + :w[!] + + Write the current buffer to its associated file. When the buffer is + read-only, transient or not modified, do not write the file. Attach a + '!' to the command to write a read-only buffer. + + :write-all[!] Write all buffers (all buffers affected) + :wall[!] + + Attempt to write all modified buffers to their associated files. Writing + a buffer fails when the buffer is read-only or has no name. Read-only + buffers are written when a '!' is attached to the command. + + :xit[!] Save and exit (whole buffer affected) + :x[!] + + Write the current buffer and exit. This is equal to running :w and then + :q. (Q.v.) + + ==== OPTIONS ================================================================= + + Boolean options are set with :set option + and reset with :set nooption + + Multiple options may be specified on a single line unless one of them is a + string option, e.g.: + + :set noshowmode scroll=10 + + but + + :set scheme-repl="s9 -q" + :set scroll=10 + + The double quotes around string options are optional, but if one is specified, + both must be present. (A single quote character will be considered to be part + of the option.) + + Options placed in the file $HOME/.arserc will be read at startup time. All + options are set on a per-buffer basis. The current set of options is copied + to fresh buffers when they are created. The following options exist: + + autocenter (ac) boolean default: noautocenter + + When searching text, automatically center matching lines (as if pressing + [z][.]). When the option is off, scroll as little as possible. + + autoindent (ai) boolean default: autoindent + + In insert mode automatically indent each line with the same number of + leading blanks as used in the previous line. + + crlfmode (cr) boolean default: automatic + + When writing a file, insert a CR character before each LF marking the + end of a line. This option is set when loading a file that contains + such CR characters. + + errorbells (eb) boolean default: errorbells + + Sound an audible bell in case of an error. + + ignorecase (ic) boolean default: noignorecase + + When searching and replacing text, do no distinguish between upper and + lower case characters. + + indent (in) integer default: 2 + The number of spaces by which the indent ([>]) and outdent ([<]) commands + will change the indentation of a region by default. + + readonly (ro) boolean default: automatic + + When this option is set in a buffer, that buffer cannot be written to + disk. It can still be modified, though. + + regex (re) boolean default: regex + + When this option is set, the [/], [?], and :s commands operate on regular + expressions rather than on literal text. ARSE supports basic regular + expressions and back references. See the documentation of the RE-SUBST + procedure for details. + + sharebuffers (sb) boolean default: sharebuffers + + When this option is set the yank buffer and the search buffer are shared + among editing buffers, so you can yank or delete text in one buffer and + paste it to another. The sharebuffers option itself is shared between + all buffers, so setting it once modifies it in all buffers. + + scroll (sc) integer default: text-lines/2 + + The number of lines by which the [^U] and [^D] commands will scroll the + screen by default. + + showmatch (sm) boolean default: showmatch + + Show matching parentheses when they are in the same screenful of text as + the one right from the cursor. Slow, but nice. + + showmode (smd) boolean default: showmode + + Show a status line with various intersting information at the bottom of + the screen. + + standout (so) boolean default: standout + + Display the status line (if showmode is set) and error message in a + standout display mode (e.g.: in inverse mode). + + unexpand (ue) boolean default: nounexpand + + Unexpand leading blank characters to TABs. ARSE never preserves TABS, but + always expands them when loading a file. When this option is set, it at + least unexpands leading ones when saving. TAB size is eight columns. + + wordset (ws) integer default: 2 + + The character sets that constitute "words" and "bigwords". Basically a word + is a coherent sequence of characters that belong to one out of these sets: + + (a) alphanumeric characters + (b) R4RS symbol characters (above plus "!@$%^&*-/_+=~.?<>:") + (c) non-whitespace characters + + The "wordset" option may be set to the values 1, 2, or 3, which defines + "words" and "bigwords" as used in the [w],[W],[b],[B],[e], and [E] commands + as follows: + + wordset words bigwords + 1 (a) (b) + 2 (a) (c) + 3 (b) (c) + + ==== SCHEME PROGRAMMING SUPPORT ============================================== + + ---- Options ----------------------------------------------------------------- + + autoload (al) boolean default: noautoload + + Each buffer with this option set will be LOADed automatically when a new + Scheme process is created, for example after recovering from an error. + Note that the first buffer opened by ARSE will always have the autoload + flag set. + + code-marker (cm) string default: "" + + When this option is set to a non-empty string, ARSE will operate in + "document mode". In document mode, reloading a file (with the [=][r] + command or by auto-loading) will not pass any lines to the REPL until a + "code-marker" is found in a line. The next code-marker turns off loading + again. This mode allows to load documents that contain Scheme code in one + piece. The code-marker value is a regular expression. In HTML text, for + example, you might set it to "". + + repl-timeout (rt) integer default: 2 + + The time to wait for a response from the REPL (see scheme-repl option). + When no response is received in the given amount of time assume that the + REPL process stalled and disconnect it. + + saveintbuf (sib) boolean default: saveintbuf + + When this option is set, the Scheme interaction buffer will be saved + automatically when ARSE is exited and reloaded when the interaction buffer + is opened again. + + scheme-init (si) string default: "" + + A system-specific init string to be sent to the Scheme REPL immediately + after connecting to the interpreter. + + scheme-repl (sr) string default: "s9 -q" + + The command for invoking a Scheme system that provides a REPL + (read-eval-print loop). The interactive session should not issue any + prompts, but just swallow forms and spit out normal forms. + + ---- Commands ---------------------------------------------------------------- + + [^C] Interrupt. + Interrupt the Scheme interpreter while receiving output from + the REPL. Programs that hang without sending any output will + be stopped automatically after the amount of time specified + in the "repl-timeout" option. + + [TAB] Auto-complete. + When in insert mode, auto-complete the current identifier. + Identifiers suitable for auto-completion are extracted from the + help database. Use the :rehash command to update the completion + table. When there is no partial indentifier to the left of the + cursor, insert an expanded TAB character. + + [=][b] Back to previous help topic. + Go back to the previously visited help topic. Works only in the + Scheme help buffer. + + [=][c] Compile. + Send the definition currently containing the cursor to the + Scheme REPL, effectively recompiling the definition. + + [=][e] Evaluate. + When the cursor is on a '(' or ')' character, pass all characters + up to the matching parenthesis to the Scheme REPL for evaluation. + REPL output will be appended to the Scheme interaction buffer. + + [=][f] Format. + When the cursor is on a '(' or ')' character, pass all characters + up to the matching parenthesis through the S9 pretty printer in + data mode. + + [=][h] Help. + Extract the Scheme symbol under the cursor and look it up in the + S9fES online help database. When a matching page is found, load + it into the Scheme Help buffer and switch to that buffer. + + [=][i] Interaction buffer. + Switch to the Scheme interaction buffer. + + [=][n] New REPL. + Disconnect any active REPL and start a fresh one. + + [=][o] Add auto-completion symbol + Temporarily add the symbol under the cursor to the auto-completion + list, so it can be expanded by pressing [TAB]. + + [=][p] Pretty-print. + When the cursor is on a '(' or ')' character, pass all characters + up to the matching parenthesis through the S9 pretty printer. + + [=][r] Reload. + Send the entire buffer to the connected Scheme process. + + [v] View expression. + Highlight the innermost expression around the cursor. + + ==== Differences to VI ======================================================= + + ARSE is an extended subset of the real VI editor. I have attempted to make + ARSE feel like VI as much as possible, except for the following points. When + ARSE differs from VI in other points, you may consider this to be a bug. + + Omissions + + - tons of commands and options are unimplemented. + + Differences + + - ARSE expands all tabs to spaces; I consider this to be a feature. + + - trailing blanks are trimmed when leaving input mode; + + - [<] and [>] outdent and indent expressions rather than regions when the + cursor is on a '(' or ')' character; + + - [<] and [>] indent by two characters by default; an explicit count + specifies spaces rather than TABs; + + - [~] works on regions rather than individual characters; + + - [u] can be undone and redone (like in nvi); + + - [(] and [)] move the cursor to the beginning and end of an expression + rather than sentence; + + - [w], [b], and friends can be configured to operate on Scheme symbols; + + - [^A] locates the Scheme identifier under the cursor; + + - When 'showmatch' is set, ARSE highlights matching parens in command mode + rather than in input mode. It highlights only parentheses and no other + kinds of brackets. + + Additions + + - there are various options that cannot be found in vi; many of them are + related to Scheme programming; + + - When no argument is passed to :e, the interactive directory browser is + started; + + - ARSE is a multi-buffer editor, so there are various colon commands for + manipulating buffers (:buffer, etc). + + ============================================================================== diff -Nru scheme9-2009.09.06/contrib/arse.porting scheme9-2010.11.13/contrib/arse.porting --- scheme9-2009.09.06/contrib/arse.porting 1970-01-01 00:00:00.000000000 +0000 +++ scheme9-2010.11.13/contrib/arse.porting 2010-07-21 12:14:14.000000000 +0000 @@ -0,0 +1,127 @@ + + ARSE is mostly written in portable R4RS Scheme but, of + course, there are some portions that cannot be done portably. + This is a summary of the parts that will have to be adapted + in order to port ARSE to a different Scheme environment. + + The ARSE source code consists of about 4000 lines of S9fES + code that expand to about 7500 lines of more or less portable + R4RS Scheme code when resolving the library dependencies. + This can be done automatically with the S9RESOLVE program + (prog/) or by including the files listed in the LOAD-FROM-LIBRARY + statements at the beginning of the program manually. (Of + course, you have to do this recursively, because included + files may -- and more than often will -- contain additional + LOAD-FROM-LIBRARY statements.) + + HINT: If you want to know what a certain S9fES extension + procedure does, just load the ARSE source code into ARSE, + move the cursor on the procedure name in question and press + [=][h]. This will load the description of the procedure + into the help buffer. + + ----- SYNTAX-RULES --------------------------------------------- + + There are two minor macros (SWAP! and CTL) in the code that use + SYNTAX-RULES. SWAP can easily be expanded in situ, CTL can be + turned into a function with little loss of performance. + + ----- STRUCTURES ----------------------------------------------- + + ARSE uses the S9fES DEFINE-STRUCTURE syntax, which is probably + not portable. So you will have to use an alternative structure + syntax or use a vector and create the corresponding setters + and getters manually. The buffer (BUF) is the only structure + used in ARSE. + + ----- SEMI-PORTABLE EXTENSION PROCEDURES ----------------------- + + ARSE uses a few extension procedures that are included in + source form in the S9fES package but use extension procedures + internally. So you will probably have to rewrite some of + these procedures: + + FIND-HELP-PATH (recommended) Used to locate the S9fES help + pages. When in a hurry, you may just hardwire the path. + + FLUSH-OUTPUT-PORT (required) Used to send output to the + REPL. + + SEARCH-PATH (required) Used to locate the Scheme interpreter. + + SPAWN-COMMAND (required) Used to run the Scheme interpreter. + + SPAWN-SHELL-COMMAND (recommended) Used to run filters ([!] + command). + + ----- CURSES --------------------------------------------------- + + Because ARSE is a screen editor, you will, of course, need + some means of cursor addressing. ARSE uses the S9fES Curses + extension to achieve this. The procedures for cursor + addressing are factored out cleanly and listed at the + beginning of the code. None of these procedures are really + optional. + + ----- SYSTEM PROCEDURES ---------------------------------------- + + First of all: ARSE relies on the underlying Scheme system to + ignore SIGPIPE as it will happily send REPL input over a broken + pipe. So catch it if you can. + + CHMOD (optional) Used to preserve the mode of the edited + file when saving a buffer. + + DIRECTORY? (optional) Used by the directory browser to check + whether a file is regular or a directory. If this is hard + to do, just comment out the call to the directory browser. + + ERRNO and ERRNO->STRING (optional) Used for error reporting. + + FD-CREAT (optional) Used to test whether a file can be + created. + + FD-SELECT and FD-READ (required) Used to read input from + the REPL. Because the REPL may stall (e.g. when feeding + it a single opening parenthesis), it has to be read using + read(2) and select(2). Without these the Scheme process + will not work reliably. + + GETCWD (optional) Used by the directory browser. + + GETENV (required) Used to read the HOME and PATH environment + variables. + + GETPID (optional) Used to generate a unique file name. + Probably easy to work around. + + MAKE-OUTPUT-PORT (required) Wraps a Scheme output port + around a naked file descriptor. Required to communicate + with the Scheme process. + + MODE->STRING (optional) Used by the directory browser. + + READ-DIRECTORY (optional) Used by the directory browser. + + REMOVE-FILE and RENAME-FILE (required) Used to save buffers. + + RUN-SHELL-COMMAND (optional) Used for shell escapes + (:!command). + + SEND-SIGNAL (optional) Used to make sure that the REPL goes + down when disconnecting the Scheme process. + + STAT-FILE (optional) Used to preserve the file mode when + saving a buffer. Also used in the directory browser. + + UNIX-TIME (optional) Used to generate a unique symbol. + Probably easy to work around. + + WAIT-FOR-PROCESS (recommended) Used to disconnect the Scheme + process gracefully. Without it, zombies will be left in the + process space. + + ---------------------------------------------------------------- + + That's about it I guess. Good luck! + diff -Nru scheme9-2009.09.06/contrib/arse.scm scheme9-2010.11.13/contrib/arse.scm --- scheme9-2009.09.06/contrib/arse.scm 1970-01-01 00:00:00.000000000 +0000 +++ scheme9-2010.11.13/contrib/arse.scm 2010-10-13 06:30:11.000000000 +0000 @@ -0,0 +1,4290 @@ +; +; ARSE is a Recursive Scheme Editor +; by Nils M Holm, 2010 +; See the LICENSE file of the S9fES package for terms of use +; +; (arse string) ==> unspecific +; (arse) ==> unspecific +; +; The ARSE procedure implements a vi-style editor. If specified, +; it loads the file STRING into an editing buffer. +; +; (Example): (arse "foo.scm") + +; Todo: +; ^C interrupt +; ? long line editor + +(require-extension sys-unix curses) + +(load-from-library "syntax-rules.scm") +(load-from-library "define-structure.scm") +(load-from-library "sort.scm") +(load-from-library "hash-table.scm") +(load-from-library "list-to-set.scm") +(load-from-library "remove.scm") +(load-from-library "split.scm") +(load-from-library "string-case.scm") +(load-from-library "string-expand.scm") +(load-from-library "string-scan.scm") +(load-from-library "string-split.scm") +(load-from-library "string-unsplit.scm") +(load-from-library "string-parse.scm") +(load-from-library "string-locate.scm") +(load-from-library "string-find.scm") +(load-from-library "string-find-last.scm") +(load-from-library "string-position.scm") +(load-from-library "string-last-position.scm") +(load-from-library "read-line.scm") +(load-from-library "read-file.scm") +(load-from-library "format.scm") +(load-from-library "regex.scm") +(load-from-library "basename.scm") +(load-from-library "dirname.scm") +(load-from-library "search-path.scm") +(load-from-library "spawn-command.scm") +(load-from-library "spawn-shell-command.scm") +(load-from-library "flush-output-port.scm") +(load-from-library "find-help-path.scm") +(load-from-library "name-to-file-name.scm") +(load-from-library "mode-to-string.scm") +(load-from-library "format-time.scm") +(load-from-library "unix-time-to-time.scm") +(load-from-library "pretty-print.scm") + +; ----- Curses abstraction layer ----- + +(define addch curs:addch) +(define addstr curs:addstr) +(define attrset curs:attrset) +(define beep curs:beep) +(define cbreak curs:cbreak) +(define clear curs:clear) +(define clrtoeol curs:clrtoeol) +(define cols curs:cols) +(define deleteln curs:deleteln) +(define echo curs:echo) +(define endwin curs:endwin) +(define flash curs:flash) +(define getch curs:getch) +(define idlok curs:idlok) +(define initscr curs:initscr) +(define insertln curs:insertln) +(define keypad curs:keypad) +(define lines curs:lines) +(define move curs:move) +(define mvaddstr curs:mvaddstr) +(define nl curs:nl) +(define noecho curs:noecho) +(define nodelay curs:nodelay) +(define nonl curs:nonl) +(define noraw curs:noraw) +(define raw curs:raw) +(define refresh curs:refresh) +(define scrollok curs:scrollok) +(define standend curs:standend) +(define standout curs:standout) +(define unctrl curs:unctrl) +(define ungetch curs:ungetch) + +(define (attr-underline) + (attrset curs:attr-underline)) + +(define (attr-bold) + (attrset curs:attr-bold)) + +(define (attr-normal) + (attrset curs:attr-normal)) + +(define *key-up* curs:key-up) +(define *key-down* curs:key-down) +(define *key-left* curs:key-left) +(define *key-right* curs:key-right) +(define *key-ppage* curs:key-ppage) +(define *key-npage* curs:key-npage) +(define *key-home* curs:key-home) +(define *key-backspace* curs:key-backspace) + +; ----- System abstraction layer ----- + +(define catch-errors sys:catch-errors) +(define chmod sys:chmod) +(define directory? sys:stat-directory?) +(define make-output-port sys:make-output-port) +(define fd-creat sys:creat) +(define fd-read sys:read) +(define fd-select sys:select) +(define errno sys:errno) +(define errno->string sys:strerror) +(define getcwd sys:getcwd) +(define getenv sys:getenv) +(define getpid sys:getpid) +(define read-directory sys:readdir) +(define remove-file sys:unlink) +(define rename-file sys:rename) +(define run-shell-command sys:system) +(define send-signal sys:notify) +(define stat-file sys:stat) +(define unix-time sys:time) +(define wait-for-process sys:wait) + +(define (file-exists? path) + (sys:access path sys:access-f-ok)) + +(define (file-readable? path) + (sys:access path sys:access-r-ok)) + +(define (file-writable? path) + (sys:access path sys:access-w-ok)) + +; ----- Main program ----- + +(define *Mode* "command") +(define *Message* #f) +(define *Update* #t) +(define *Repeat* #f) + +(define *Buffers* '()) +(define *Help-Stack* '()) +(define *Session* #f) + +(define *Completion-symbols* '()) + +(define *Chunksize* 1000) + +(define bp-autocenter 'bp-autocenter) +(define bp-autoindent 'bp-autoindent) +(define bp-autoload 'bp-autoload) +(define bp-crlfmode 'bp-crlfmode) +(define bp-errorbells 'bp-errorbells) +(define bp-ignorecase 'bp-ignorecase) +(define bp-modified 'bp-modified) +(define bp-readonly 'bp-readonly) +(define bp-regex 'bp-regex) +(define bp-saveintbuf 'bp-saveintbuf) +(define bp-sharebuffers 'bp-sharebuffers) +(define bp-showmatch 'bp-showmatch) +(define bp-showmode 'bp-showmode) +(define bp-standout 'bp-standout) +(define bp-unexpand 'bp-unexpand) +(define bp-tag-help 'bp-tag-help) +(define bp-tag-scmint 'bp-tag-scmint) +(define bp-tag-scmhelp 'bp-tag-scmhelp) +(define bp-transient 'bp-transient) + +(define *prop-table* + `((,bp-autocenter boolean ("autocenter" "ac")) + (,bp-autoindent boolean ("autoindent" "ai")) + (,bp-autoload boolean ("autoload" "al")) + (,bp-crlfmode boolean ("crlfmode" "cr")) + (,bp-errorbells boolean ("errorbells" "eb")) + (,bp-ignorecase boolean ("ignorecase" "ic")) + (,bp-regex boolean ("regex" "re")) + (,bp-readonly boolean ("readonly" "ro")) + (,bp-saveintbuf boolean ("saveintbuf" "sib")) + (,bp-sharebuffers boolean ("sharebuffers" "sb")) + (,bp-showmatch boolean ("showmatch" "sm")) + (,bp-showmode boolean ("showmode" "smd")) + (,bp-standout boolean ("standout" "so")) + (,bp-unexpand boolean ("unexpand" "ue")))) + +(define pt-prop car) +(define pt-type cadr) +(define pt-names caddr) + +(define *default-prop* + (list bp-autoindent + bp-errorbells + bp-regex + bp-saveintbuf + bp-sharebuffers + bp-showmatch + bp-showmode + bp-standout)) + +(define bv-code-marker 'bv-code-marker) +(define bv-indent 'bv-indent) +(define bv-scheme-init 'bv-scheme-init) +(define bv-scheme-repl 'bv-scheme-repl) +(define bv-repl-timeout 'bv-repl-timeout) +(define bv-scroll 'bv-scroll) +(define bv-wordset 'bv-wordset) + +(define *val-table* + `((,bv-code-marker string ("code-marker" "cm")) + (,bv-indent integer ("indent" "in")) + (,bv-repl-timeout integer ("repl-timeout" "rt")) + (,bv-scheme-init string ("scheme-init" "si")) + (,bv-scheme-repl string ("scheme-repl" "sr")) + (,bv-scroll integer ("scroll" "sc")) + (,bv-wordset integer ("wordset" "ws")))) + +(define (default-values) + (list (cons bv-code-marker "") + (cons bv-indent 2) + (cons bv-repl-timeout 2) + (cons bv-scheme-init "") + (cons bv-scheme-repl "s9 -q") + (cons bv-scroll (quotient (text-lines) 2)) + (cons bv-wordset 2))) + +(define-structure buf + (name #f) + (length 0) + (prop *default-prop*) + (values (default-values)) + (y 0) + (x 0) + (top 0) + (mark #f) + (yanked '()) + (searchbuf "") + (revsearch #f) + (lastcmd #f) + (scanchr #f) + (revscan #f) + (scan-onto #f) + (log (list 'undo '() '())) + (buffer (make-vector *Chunksize* ""))) + +(define (fresh-buffer . prop) + (let ((buf (make-buf))) + (if (not (null? prop)) + (buf-set-prop! buf (car prop))) + (if (and (not (null? prop)) + (not (null? (cdr prop)))) + (buf-set-values! buf (cadr prop))) + buf)) + +(define (new-buffer . prop) + (set! *Buffers* (cons (apply fresh-buffer prop) *Buffers*)) + (car *Buffers*)) + +(define (delete-buffer buf) + (set! *Buffers* (remq buf *Buffers*)) + (car *Buffers*)) + +(define (rotate-buffers!) + (set! *Buffers* (append (cdr *Buffers*) + (list (car *Buffers*)))) + (car *Buffers*)) + +(define (swap-buffers!) + (set! *Buffers* (append (list (cadr *Buffers*)) + (list (car *Buffers*)) + (cddr *Buffers*))) + (car *Buffers*)) + +(define (buf-log-dir buf) (car (buf-log buf))) +(define (buf-undo-log buf) (cadr (buf-log buf))) +(define (buf-redo-log buf) (caddr (buf-log buf))) + +(define (buf-set-log-dir! buf log) (set-car! (buf-log buf) log)) +(define (buf-set-undo-log! buf log) (set-car! (cdr (buf-log buf)) log)) +(define (buf-set-redo-log! buf log) (set-car! (cddr (buf-log buf)) log)) + +(define (buf-line buf n) + (vector-ref (buf-buffer buf) n)) + +(define (buf-cur-line buf) + (vector-ref (buf-buffer buf) (buf-y buf))) + +(define (buf-cur-length buf) + (string-length (buf-cur-line buf))) + +(define (buf-set-line! buf n line) + (vector-set! (buf-buffer buf) n line)) + +(define (buf-set-cur-line! buf line) + (vector-set! (buf-buffer buf) (buf-y buf) line)) + +(define (buf-char buf i) + (let ((line (buf-cur-line buf))) + (if (< -1 i (string-length line)) + (string-ref line i) + #f))) + +(define (buf-cur-char buf) + (buf-char buf (buf-x buf))) + +(define (buf-next-char buf) + (and (buf-cur-char buf) + (buf-char buf (+ 1 (buf-x buf))))) + +(define (buf-prev-char buf) + (and (positive? (buf-x buf)) + (buf-char buf (- (buf-x buf) 1)))) + +(define (buf-size buf) + (vector-length (buf-buffer buf))) + +(define (buf-prop? buf prop) + (and (memq prop (buf-prop buf)) + #t)) + +(define (buf-val buf val) + (cdr (assq val (buf-values buf)))) + +(define (buf-set-val! buf prop val) + (set-cdr! (assq prop (buf-values buf)) val)) + +(define (buf-transient? buf) (buf-prop? buf bp-transient)) +(define (buf-modified? buf) (and (buf-prop? buf bp-modified) + (not (buf-transient? buf)))) +(define (buf-readonly? buf) (buf-prop? buf bp-readonly)) + +(define (buf-add-prop! buf prop) + (if (not (buf-prop? buf prop)) + (buf-set-prop! buf (cons prop (buf-prop buf))))) + +(define (buf-rem-prop! buf prop) + (buf-set-prop! buf (remq prop (buf-prop buf)))) + +(define (clean-up-props buf) + (let loop ((b (buf-prop buf)) + (p (list bp-modified + bp-readonly + bp-autoload + bp-transient + bp-tag-scmint + bp-tag-help + bp-tag-scmhelp))) + (if (null? p) + b + (loop (remq (car p) b) + (cdr p))))) + +(define (buf-modified! buf) + (buf-add-prop! buf bp-modified) + (buf-set-mark! buf #f) + (buf-set-log-dir! buf 'undo)) + +(define (buf-add-yanked! buf x) + (buf-set-yanked! buf (cons x (buf-yanked buf)))) + +(define (buf-clear-yanked! buf) + (buf-set-yanked! buf '())) + +(define make-pos list) + +(define (save-pos buf) + (make-pos (buf-y buf) (buf-x buf) (buf-top buf))) + +(define (saved-y s) + (car s)) + +(define (saved-x s) + (cadr s)) + +(define (saved-top s) + (caddr s)) + +(define (reset-pos buf saved) + (buf-set-y! buf (saved-y saved)) + (buf-set-x! buf (saved-x saved)) + (buf-set-top! buf (saved-top saved))) + +(define (restore-pos buf saved) + (if (< (saved-y saved) (buf-length buf)) + (begin (reset-pos buf saved) + (buf-display buf)))) + +(define (log-entry op where what) + (vector op where what)) + +(define (log-op log) (vector-ref log 0)) +(define (log-where log) (vector-ref log 1)) +(define (log-what log) (vector-ref log 2)) + +(define (add-to-log buf act) + (buf-set-undo-log! buf (cons act (buf-undo-log buf))) + (buf-set-redo-log! buf '())) + +(define here save-pos) + +(define (log-new buf) + (if (or (null? (buf-undo-log buf)) + (not (eq? 'NEXT (log-op (car (buf-undo-log buf)))))) + (add-to-log buf (log-entry 'NEXT (here buf) #f)))) + +(define (log-del-chars buf what) + (add-to-log buf (log-entry 'DELC (here buf) what))) + +(define (log-insert buf what) + (add-to-log buf (log-entry 'INSC (here buf) what))) + +(define (log-join buf log) + (add-to-log buf (log-entry 'JOIN (here buf) log))) + +(define (log-break buf what) + (add-to-log buf (log-entry 'BRKL (here buf) what))) + +(define (log-replace buf what) + (add-to-log buf (log-entry 'REPC (here buf) what))) + +(define (log-del-lines buf what) + (add-to-log buf (log-entry 'DELN (here buf) what))) + +(define-syntax ctl + (syntax-rules () + ((_ c) + (integer->char (- (char->integer c) + (char->integer #\@)))))) + +(define ^A (ctl #\A)) +(define ^B (ctl #\B)) +(define ^C (ctl #\C)) +(define ^D (ctl #\D)) +(define ^F (ctl #\F)) +(define ^G (ctl #\G)) +(define ^H (ctl #\H)) +(define TAB (ctl #\I)) +(define ^J (ctl #\J)) +(define ^L (ctl #\L)) +(define CR (ctl #\M)) +(define ^N (ctl #\N)) +(define ^R (ctl #\R)) +(define ^T (ctl #\T)) +(define ^U (ctl #\U)) +(define ^V (ctl #\V)) +(define ^X (ctl #\X)) +(define ESC (ctl #\[)) +(define ^^ (ctl #\^)) +(define LP #\() +(define RP #\)) +(define SP #\space) + +(define (text-lines) + (- (lines) 1)) + +(define (screen-line buf) + (- (buf-y buf) (buf-top buf))) + +(define (clip-right s lim) + (if (> (string-length s) lim) + (substring s 0 lim) + s)) + +(define (clip-left s lim) + (let ((k (string-length s))) + (if (> k lim) + (substring s (- k lim) k) + s))) + +(define (last-line buf) + (max 0 (- (buf-length buf) 1))) + +(define (at-last-line? buf) + (>= (buf-y buf) (- (buf-length buf) 1))) + +(define (at-eof? buf) + (and (at-last-line? buf) + (not (buf-cur-char buf)))) + +(define (char-symbolic? c) + (or (char-alphabetic? c) + (char-numeric? c) + (and (memv c '(#\! #\@ #\$ #\% #\^ #\& #\* #\- #\/ + #\_ #\+ #\= #\~ #\. #\? #\< #\> #\:)) + #t))) + +(define (char-non-whitespace? c) + (not (char-whitespace? c))) + +(define (char-alphanumeric? c) + (or (char-alphabetic? c) + (char-numeric? c))) + +(define (insert-into-buf! buf pos line) + (if (>= pos (buf-size buf)) + (let ((src-lines (buf-buffer buf)) + (src-length (buf-size buf))) + (buf-set-buffer! buf (make-vector + (* (quotient (+ pos *Chunksize*) + *Chunksize*) + *Chunksize*))) + (let loop ((i 0)) + (if (< i src-length) + (begin (vector-set! (buf-buffer buf) + i + (vector-ref src-lines i)) + (loop (+ 1 i))) + (let loop ((i i)) + (if (< i (buf-size buf)) + (begin (vector-set! (buf-buffer buf) i "") + (loop (+ 1 i))))))))) + (vector-set! (buf-buffer buf) pos line)) + +(define (info buf msg) + (set! *Message* msg) + (buf-status buf) + (refresh)) + +(define (mode buf m) + (set! *Mode* m) + (buf-status buf) + (refresh)) + +(define (command-mode buf) + (mode buf "command")) + +(define *got-cr* #f) + +(define (expand-tabs s) + (if (not (string-scan TAB s)) + s + (string-expand s))) + +(define (read-line/expand) + (letrec + ((collect-chars + (lambda (c s) + (cond ((eof-object? c) + (if (null? s) + c + (expand-tabs (list->string (reverse! s))))) + ((char=? c #\newline) + (expand-tabs (list->string (reverse! s)))) + ((char=? c CR) + (set! *got-cr* #t) + (collect-chars (read-char) s)) + (else + (collect-chars (read-char) + (cons c s))))))) + (collect-chars (read-char) '()))) + +(define (buf-load! buf path) + (and (file-readable? path) + (with-input-from-file + path + (lambda () + (set! *got-cr* #f) + (buf-set-log! buf (list 'undo '() '())) + (let loop ((line (read-line/expand)) + (pos 0)) + (cond ((eof-object? line) + (buf-set-length! buf pos) + (buf-set-name! buf path) + (if (not (file-writable? path)) + (buf-add-prop! buf bp-readonly)) + (info buf (format #f "~D line~:P~A" + (buf-length buf) + (if (buf-prop? buf bp-readonly) + ", read-only" + ""))) + (if *got-cr* + (buf-add-prop! buf bp-crlfmode) + (buf-rem-prop! buf bp-crlfmode)) + #t) + (else + (if (zero? (remainder pos 100)) + (info buf (format #f "loading: ~D" pos))) + (insert-into-buf! buf pos line) + (loop (read-line/expand) (+ 1 pos))))))))) + +(define (end-of-buffer buf) + (max 0 (- (buf-length buf) 1))) + +(define (unexpand-tabs s) + (let* ((k (string-length s)) + (n (make-string k))) + (let loop ((i 0) + (j 0) + (c 0)) + (cond ((>= i k) + (substring n 0 j)) + ((and c (char=? #\space (string-ref s i))) + (string-set! n j #\space) + (if (= c 7) + (begin (string-set! n (- j 7) TAB) + (loop (+ 1 i) (- j 6) 0)) + (loop (+ 1 i) (+ 1 j) (+ 1 c)))) + (else + (string-set! n j (string-ref s i)) + (loop (+ 1 i) (+ 1 j) #f)))))) + +(define (buf-write! buf path . range) + (catch-errors #t) + (let* ((tmpname (string-append path + "." + (number->string (getpid)) + ".tmp"))) + (if (file-exists? tmpname) + (remove-file tmpname)) + (if (not (fd-creat tmpname)) + (err buf (format #f "error writing file: ~A" + (errno->string (errno)))) + (let ((from (if (null? range) + 0 + (car range))) + (to (if (null? range) + (end-of-buffer buf) + (cadr range)))) + (remove-file tmpname) + (with-output-to-file + tmpname + (lambda () + (let loop ((i from)) + (if (<= i to) + (begin (if (zero? (remainder i 100)) + (info buf (format #f "saving: ~D" i))) + (if (buf-prop? buf bp-unexpand) + (display (unexpand-tabs (buf-line buf i))) + (display (buf-line buf i))) + (if (buf-prop? buf bp-crlfmode) + (write-char CR)) + (newline) + (loop (+ 1 i))))))) + (let ((mode (cond ((stat-file path) + => (lambda (x) (cdr (assq 'mode x)))) + (else + (errno) + #f)))) + (if (file-exists? path) + (remove-file path)) + (rename-file tmpname path) + (if mode + (chmod path mode)) + (catch-errors #f) + (let ((e (errno))) + (if (not (zero? e)) + (err buf (format #f "error writing file: ~A" + (errno->string e))) + (info buf + (format #f "~D lines written" + (+ 1 (- to from))))))))))) + +(define (buf-save! buf yes!) + (cond ((buf-transient? buf) + (err "buffer is transient!")) + ((buf-readonly? buf) + (if yes! + (begin (buf-write! buf (buf-name buf)) + (buf-rem-prop! buf bp-modified) + 'ok) + (err buf + "buffer is read-only! use :w! or :x! to write anyway."))) + ((not (buf-name buf)) + (err buf "buffer has no name! use \":w name\" to supply one")) + (else + (buf-write! buf (buf-name buf)) + (buf-rem-prop! buf bp-modified) + 'ok))) + +(define (fast-mode buf) + (mode buf "busy") + (set! *Update* #f)) + +(define (slow-mode buf) + (set! *Update* #t) + (buf-display buf) + (command-mode buf)) + +(define (underline on) + (if on + (attr-underline) + (attr-normal))) + +(define (so buf) + (if (buf-prop? buf bp-standout) + (standout))) + +(define (se buf) + (if (buf-prop? buf bp-standout) + (standend))) + +(define (advance buf) + (buf-set-x! buf (+ 1 (buf-x buf))) + (cond ((buf-cur-char buf) + => (lambda (x) x)) + ((at-last-line? buf) + #f) + (else + (buf-set-y! buf (+ 1 (buf-y buf))) + (buf-set-x! buf -1) + #\space))) + +(define (backup buf) + (buf-set-x! buf (- (buf-x buf) 1)) + (cond ((buf-cur-char buf) + => (lambda (x) x)) + ((zero? (buf-y buf)) + #f) + (else + (buf-set-y! buf (- (buf-y buf) 1)) + (move-to-eol buf) + (buf-set-x! buf (+ 1 (buf-x buf))) + #\space))) + +(define (adjust-screen-top buf) + (cond ((>= (screen-line buf) + (text-lines)) + (buf-set-top! buf (- (buf-y buf) + (text-lines) + -1))) + ((< (buf-y buf) (buf-top buf)) + (buf-set-top! buf (buf-y buf))))) + +(define (buf-display buf) + (adjust-screen-top buf) + (cond (*Update* + (let loop ((i (buf-top buf)) + (y 0)) + (if (< y (text-lines)) + (begin (move y 0) + (clrtoeol) + (if (< i (buf-length buf)) + (addstr (clip-right (buf-line buf i) (cols))) + (addstr "~")) + (loop (+ 1 i) (+ 1 y))) + (refresh)))))) + +(define (buf-status buf) + (let ((lim (- (cols) 42)) + (lb #\[) + (rb #\]) + (name (if (buf-name buf) + (buf-name buf) + " *anonymous* "))) + (move (- (lines) 1) 0) + (so buf) + (cond (*Message* + (addstr (make-string (cols) #\space)) + (mvaddstr (- (lines) 1) 0 *Message*)) + ((not (buf-prop? buf bp-showmode)) + (clrtoeol) + 'ok) + (else + (addstr (make-string (cols) #\=)) + (let* ((name-len (string-length name)) + (base-len (string-length (basename name))) + (name (cond ((> base-len lim) + (set! rb #\>) + (if (string-find "/" name) + (set! lb #\<)) + (clip-right (basename name) lim)) + ((> name-len lim) + (set! lb #\<) + (clip-left name lim)) + (else + name)))) + (mvaddstr (- (lines) 1) + 5 + (format #f " L~A/~A C~A ~C~C ~C~@A~C (~A) " + (+ 1 (buf-y buf)) + (buf-length buf) + (+ 1 (buf-x buf)) + (cond ((buf-modified? buf) #\M) + ((buf-transient? buf) #\T) + (else #\-)) + (if (buf-readonly? buf) #\R #\-) + lb + name + rb + *Mode*))))) + (se buf))) + +(define (set-cursor buf) + (let ((x (max (min (- (buf-cur-length buf) 1) + (buf-x buf)) + 0))) + (move (screen-line buf) x))) + +(define (hl-matching-rp buf on) + (let ((here (save-pos buf)) + (lim (+ (text-lines) (buf-top buf)))) + (let loop ((ch (advance buf)) + (n 0)) + (cond ((or (not ch) (>= (buf-y buf) lim)) + (restore-pos buf here) + #f) + ((char=? ch LP) + (loop (advance buf) (+ 1 n))) + ((char=? ch RP) + (cond ((zero? n) + (set-cursor buf) + (if on (underline #t)) + (addch RP) + (if on (underline #f)) + (reset-pos buf here) + #t) + (else + (loop (advance buf) (- n 1))))) + (else + (loop (advance buf) n)))))) + +(define (hl-matching-lp buf on) + (let ((here (save-pos buf)) + (lim (buf-top buf))) + (let loop ((ch (backup buf)) + (n 0)) + (cond ((or (not ch) (< (buf-y buf) lim)) + (restore-pos buf here) + #f) + ((char=? ch RP) + (loop (backup buf) (+ 1 n))) + ((char=? ch LP) + (cond ((zero? n) + (set-cursor buf) + (if on (underline #t)) + (addch LP) + (if on (underline #f)) + (reset-pos buf here) + #t) + (else + (loop (backup buf) (- n 1))))) + (else + (loop (backup buf) n)))))) + +(define (sync buf on) + (if (>= (buf-x buf) (cols)) + (buf-set-x! buf (- (cols) 1))) + (let ((hl (if (buf-prop? buf bp-showmatch) + (case (buf-cur-char buf) + ((#\() (hl-matching-rp buf on)) + ((#\)) (hl-matching-lp buf on)))))) + (set-cursor buf) + hl)) + +(define (key-pending?) + (nodelay #t) + (let ((k (getch))) + (nodelay #f) + (if k + (begin (ungetch k) + #t) + #f))) + +(define (get-key buf do-sync) + (let ((hl (and (not (key-pending?)) + do-sync + (sync buf #t)))) + (let ((k (getch))) + (if hl (sync buf #f)) + (set! *Message* #f) + (cond ((= k *key-up*) #\k) + ((= k *key-down*) #\j) + ((= k *key-left*) #\h) + ((= k *key-right*) #\l) + ((= k *key-ppage*) ^B) + ((= k *key-npage*) ^F) + ((= k *key-home*) #\^) + ((= k *key-backspace*) ^H) + ((> k 126) (integer->char 0)) + (else (integer->char k)))))) + +(define (get-arg buf k) + (let loop ((k k) + (s '())) + (if (and (char-numeric? k) + (or (not (char=? #\0 k)) + (not (null? s)))) + (loop (get-key buf #f) (cons k s)) + (list k (string->number (list->string (reverse! s))))))) + +(define (get-cmd buf) + (get-arg buf (get-key buf #t))) + +(define (get-line y buf prompt repc) + (let* ((lim 256) + (rk (if repc + (string-length repc) + 0)) + (s "") + (o (string-length prompt)) + (t 0) + (i 0) + (z 0)) + (move y 0) + (clrtoeol) + (so buf) + (addstr prompt) + (se buf) + (let loop () + (if (> (- i t) (- (cols) o 2)) + (set! t (- i (- (cols) o 2)))) + (if (< i t) + (set! t i)) + (mvaddstr y o (substring s t (+ t (min (- z t) + (- (cols) o 2))))) + (clrtoeol) + (if (and repc (< z rk)) + (addstr (substring repc z rk))) + (move y (+ o (- i t))) + (let ((k (getch))) + (cond ((= k 27) + (info buf #f) + s) + ((and (not repc) + (= k 13)) + (info buf #f) + s) + ((and (<= 32 k 126) + (< z (- lim 1))) + (set! s (string-append (substring s 0 i) + (string (integer->char k)) + (substring s i z))) + (set! i (+ 1 i)) + (set! z (+ 1 z)) + (loop)) + ((= k *key-backspace*) + (cond ((zero? i) + (cond ((zero? z) + #f) + (else + (ring-bell buf) + (loop)))) + (else + (set! i (- i 1)) + (set! s (string-append (substring s 0 i) + (substring s (+ 1 i) z))) + (set! z (- z 1)) + (loop)))) + ((= k 4) + (cond ((>= i z) + (ring-bell buf) + (loop)) + (else + (set! s (string-append (substring s 0 i) + (substring s (+ 1 i) z))) + (set! z (- z 1)) + (loop)))) + ((and (not repc) + (= k 1)) + (set! i 0) + (loop)) + ((and (not repc) + (= k 5)) + (set! i z) + (loop)) + ((= k 21) + (set! i 0) + (set! z 0) + (set! s "") + (loop)) + ((and (not repc) + (< i z) + (or (= k *key-right*) + (= k 6))) + (set! i (+ 1 i)) + (loop)) + ((and (not repc) + (positive? i) + (or (= k *key-left*) + (= k 2))) + (set! i (- i 1)) + (loop)) + (else + (beep) + (loop))))))) + +(define (ok? x) + (eq? x 'ok)) + +(define (failed? x) + (eq? x 'failed)) + +(define (ring-bell buf) + (if (buf-prop? buf 'bp-errorbells) + (beep))) + +(define (err buf . args) + (ring-bell buf) + (if (not (null? args)) + (set! *Message* (apply format #f args))) + 'failed) + +(define (goto-line buf n) + (if (< n (buf-length buf)) + (begin (buf-set-y! buf n) + (buf-set-x! buf 0) + (buf-display buf) + 'ok) + (err buf "~D: no such line" (+ 1 n)))) + +(define (move-to-line buf n) + (let ((n (if (not n) + (last-line buf) + (- n 1)))) + (goto-line buf n))) + +(define (goto-col buf n) + (if (or (zero? n) + (< n (min (cols) (buf-cur-length buf)))) + (begin (buf-set-x! buf n) + 'ok) + (err buf "~D: no such column" (+ 1 n)))) + +(define (move-to-col buf n) + (goto-col buf (- n 1))) + +(define (move-to-eol buf) + (buf-set-x! buf (max 0 (- (min (cols) (buf-cur-length buf)) 1))) + (if (buf-next-char buf) + 'failed + 'ok)) + +(define (real-pos! buf) + (if (not (buf-cur-char buf)) + (begin (move-to-eol buf) + (buf-status buf)))) + +(define (move-right buf c) + (real-pos! buf) + (let* ((lim (string-length (buf-cur-line buf))) + (lim (min lim (cols)))) + (if (>= (+ c (buf-x buf)) lim) + (err buf) + (begin (buf-set-x! buf (+ c (buf-x buf))) + 'ok)))) + +(define (move-left buf c) + (real-pos! buf) + (if (negative? (- (buf-x buf) c)) + (err buf) + (begin (buf-set-x! buf (- (buf-x buf) c)) + 'ok))) + +(define (move-down buf c) + (if (>= (+ c (buf-y buf)) + (buf-length buf)) + (err buf) + (begin (buf-set-y! buf (+ c (buf-y buf))) + (buf-display buf) + 'ok))) + +(define (move-up buf c) + (if (negative? (- (buf-y buf) c)) + (err buf) + (begin (buf-set-y! buf (- (buf-y buf) c)) + (buf-display buf) + 'ok))) + +(define (move-bottom buf c) + (if (> c (text-lines)) + (err buf) + (let ((bot (+ (buf-top buf) + (text-lines) + (- c)))) + (goto-line buf (min bot (last-line buf)))))) + +(define (move-top buf c) + (if (> c (text-lines)) + (err buf) + (let ((top (+ (buf-top buf) (- c 1)))) + (if (>= top (buf-length buf)) + (err buf) + (goto-line buf top))))) + +(define (move-middle buf) + (move-top buf (quotient (text-lines) 2))) + +(define (move-next-word buf c big half) + (real-pos! buf) + (let ((word? (if big + (case (buf-val buf bv-wordset) + ((1) char-symbolic?) + ((2) char-non-whitespace?) + ((3) char-non-whitespace?) + (else char-non-whitespace?)) + (case (buf-val buf bv-wordset) + ((1) char-alphanumeric?) + ((2) char-alphanumeric?) + ((3) char-symbolic?) + (else char-alphanumeric?)))) + (pos (save-pos buf))) + (let c-loop ((c (- c 1))) + (let* ((ch (if (buf-cur-char buf) + (buf-cur-char buf) + #\space)) + (skip? (cond ((word? ch) + word?) + ((char-whitespace? ch) + (lambda (x) #f)) + (else + (lambda (x) + (and (not (char-whitespace? x)) + (not (word? x)))))))) + (let loop ((ch (advance buf))) + (cond ((not ch) + (restore-pos buf pos) + (err buf)) + ((skip? ch) + (loop (advance buf))) + (half + (cond ((positive? (buf-x buf)) + (buf-set-x! buf (- (buf-x buf) 1))) + ((negative? (buf-x buf)) + (backup buf) + (if (and (positive? (buf-x buf)) + (not (buf-cur-char buf))) + (buf-set-x! buf (- (buf-x buf) 1))))) + (buf-display buf) + 'ok) + (else + (let loop ((ch ch)) + (cond ((not ch) + (restore-pos buf pos) + (err buf)) + ((char-whitespace? ch) + (loop (advance buf))) + ((positive? c) + (c-loop (- c 1))) + (else + (buf-display buf) + 'ok)))))))))) + +(define (move-end-of-word buf c big) + (move-next-word buf (- c 1) big #f) + (move-next-word buf 1 big #t)) + +(define (move-prev-word buf c big) + (real-pos! buf) + (let ((word? (if big + (case (buf-val buf bv-wordset) + ((1) char-symbolic?) + ((2) char-non-whitespace?) + ((3) char-non-whitespace?) + (else char-non-whitespace?)) + (case (buf-val buf bv-wordset) + ((1) char-alphanumeric?) + ((2) char-alphanumeric?) + ((3) char-symbolic?) + (else char-alphanumeric?)))) + (pos (save-pos buf))) + (let c-loop ((c (- c 1))) + (let loop ((ch (backup buf))) + (cond ((not ch) + (restore-pos buf pos) + (err buf)) + ((char-whitespace? ch) + (loop (backup buf))) + (else + (let ((skip? (if (word? ch) + word? + (lambda (x) + (and (not (char-whitespace? x)) + (not (word? x))))))) + (let loop ((ch ch)) + (cond ((and ch (skip? ch)) + (loop (backup buf))) + ((positive? c) + (c-loop (- c 1))) + (else + (advance buf) + (if (negative? (buf-x buf)) + (buf-set-x! buf 0)) + (buf-display buf) + 'ok)))))))))) + +(define (center-line buf c mode) + (let ((s (if c + (goto-line buf c) + 'ok))) + (if (not (failed? s)) + (let* ((d (case mode + ((#\.) (quotient (text-lines) 2)) + ((#\-) (- (text-lines) 1)) + (else 0))) + (z (if (negative? (- c d)) + 0 + (- c d)))) + (buf-set-top! buf z) + (buf-display buf) + 'ok) + 'failed))) + +(define (goto-mark buf also-col) + (let ((m (buf-mark buf))) + (if (not m) + (err buf "mark not set") + (begin (center-line buf (car m) #\.) + (if also-col + (goto-col buf (cadr m))) + 'ok)))) + +(define (move-to-mark buf also-col) + (sync buf #f) + (if (not (char=? (get-key buf #f) #\m)) + (if also-col + (err buf "usage: [`][m]") + (err buf "usage: ['][m]")) + (goto-mark buf also-col))) + +(define (move-to-first buf) + (buf-set-x! buf 0) + (let loop ((ch (buf-cur-char buf))) + (if (and ch (char-whitespace? ch)) + (begin (buf-set-x! buf (+ 1 (buf-x buf))) + (loop (buf-cur-char buf))) + 'ok))) + +(define (move-down-first buf c) + (move-down buf c) + (move-to-first buf)) + +(define (move-up-first buf c) + (move-up buf c) + (move-to-first buf)) + +(define (match-rp buf visual) + (let ((here (save-pos buf)) + (lim (+ (text-lines) (buf-top buf)))) + (let loop ((ch (advance buf)) + (n 0)) + (cond ((not ch) + (restore-pos buf here) + (err buf)) + ((char=? ch LP) + (loop (advance buf) (+ 1 n))) + ((char=? ch RP) + (cond ((zero? n) + (cond ((and visual + (> (buf-x buf) (- (cols) 1))) + (restore-pos buf here) + (err buf)) + (else + (if (>= (buf-y buf) lim) + (let ((x (buf-x buf))) + (center-line buf (buf-y buf) #\-) + (buf-set-x! buf x))) + 'ok))) + (else + (loop (advance buf) (- n 1))))) + (else + (loop (advance buf) n)))))) + +(define (match-lp buf visual) + (let ((here (save-pos buf)) + (lim (buf-top buf))) + (let loop ((ch (backup buf)) + (n 0)) + (cond ((not ch) + (restore-pos buf here) + (err buf)) + ((char=? ch RP) + (loop (backup buf) (+ 1 n))) + ((char=? ch LP) + (cond ((zero? n) + (cond ((and visual + (> (buf-x buf) (- (cols) 1))) + (restore-pos buf here) + (err buf)) + (else + (if (< (buf-y buf) lim) + (let ((x (buf-x buf))) + (center-line buf (buf-y buf) CR) + (buf-set-x! buf x))) + 'ok))) + (else + (loop (backup buf) (- n 1))))) + (else + (loop (backup buf) n)))))) + +(define (match-paren buf visual) + (real-pos! buf) + (cond ((not (char? (buf-cur-char buf))) (err buf)) + ((char=? LP (buf-cur-char buf)) (match-rp buf visual)) + ((char=? RP (buf-cur-char buf)) (match-lp buf visual)) + (else (err buf)))) + +(define (string-pos buf u s) + (cond ((buf-prop? buf bp-regex) + (let ((r (re-match (re-comp u) s))) + (and r + (not (null? r)) + (caar r)))) + ((buf-prop? buf bp-ignorecase) + (string-ci-position u s)) + (else + (string-locate u s)))) + +(define (find-next buf text) + (real-pos! buf) + (let ((text (if (string=? "" text) + (buf-searchbuf buf) + text))) + (buf-set-searchbuf! buf text) + (cond ((string=? "" text) + (err buf "no previous search text")) + ((zero? (buf-length buf)) + 'failed) + ((and (> (buf-cur-length buf) (buf-x buf)) + (string-pos buf text (substring (buf-cur-line buf) + (+ 1 (buf-x buf)) + (buf-cur-length buf)))) + => (lambda (col) + (goto-col buf (+ 1 (buf-x buf) col)) + 'ok)) + (else + (info buf "searching...") + (let loop ((y (+ 1 (buf-y buf)))) + (cond ((>= y (buf-length buf)) + (err buf "string not found")) + ((string-pos buf text (buf-line buf y)) + => (lambda (col) + (if (buf-prop? buf bp-autocenter) + (center-line buf y #\.) + (goto-line buf y)) + (goto-col buf col) + (info buf #f) + 'ok)) + (else + (loop (+ 1 y))))))))) + +(define (search-forward buf) + (buf-set-revsearch! buf #f) + (let ((text (get-line (text-lines) buf "/" #f))) + (if (not text) + 'failed + (find-next buf text)))) + +(define (string-last-pos buf u s) + (cond ((buf-prop? buf bp-regex) + (let ((r (re-match (re-comp u) s 'all))) + (and r + (not (null? r)) + (caaar (reverse! r))))) + ((buf-prop? buf bp-ignorecase) + (string-ci-last-position u s)) + (else + (string-last-position u s)))) + +(define (find-previous buf text) + (real-pos! buf) + (let ((text (if (string=? "" text) + (buf-searchbuf buf) + text))) + (buf-set-searchbuf! buf text) + (cond ((string=? "" text) + (err buf "no previous search text")) + ((zero? (buf-length buf)) + 'failed) + ((string-last-pos buf text (substring (buf-cur-line buf) + 0 + (buf-x buf))) + => (lambda (col) + (goto-col buf col) + 'ok)) + (else + (info buf "searching...") + (let loop ((y (- (buf-y buf) 1))) + (cond ((negative? y) + (err buf "string not found")) + ((string-last-pos buf text (buf-line buf y)) + => (lambda (col) + (if (buf-prop? buf bp-autocenter) + (center-line buf y #\.) + (goto-line buf y)) + (goto-col buf col) + (info buf #f) + 'ok)) + (else + (loop (- y 1))))))))) + +(define (search-backward buf) + (buf-set-revsearch! buf #t) + (let ((text (get-line (text-lines) buf "?" #f))) + (if (not text) + 'failed + (find-previous buf text)))) + +(define (search-again buf rev) + (if (eq? (buf-revsearch buf) rev) + (find-next buf "") + (find-previous buf ""))) + +(define (move-prev-expr buf c) + (real-pos! buf) + (let ((pos (save-pos buf))) + (let c-loop ((c (- c 1))) + (let loop ((ch (backup buf))) + (cond ((not ch) + (restore-pos buf pos) + (err buf)) + ((not (char=? ch LP)) + (loop (backup buf))) + (else + (let loop ((ch ch)) + (cond ((and ch (char=? LP ch)) + (loop (backup buf))) + ((positive? c) + (c-loop (- c 1))) + (else + (advance buf) + (if (negative? (buf-x buf)) + (buf-set-x! buf 0)) + (buf-display buf) + 'ok))))))))) + +(define (move-next-expr buf c) + (real-pos! buf) + (let ((pos (save-pos buf))) + (let c-loop ((c (- c 1))) + (let* ((ch (if (buf-cur-char buf) + (buf-cur-char buf) + #\space)) + (skip? (lambda (x) + (not (char=? RP x))))) + (let loop ((ch (advance buf))) + (cond ((not ch) + (restore-pos buf pos) + (err buf)) + ((skip? ch) + (loop (advance buf))) + (else + (let loop ((ch ch)) + (cond ((not ch) + (restore-pos buf pos) + (err buf)) + ((and #f(char=? RP ch)) + (loop (advance buf))) + ((positive? c) + (c-loop (- c 1))) + (else + (buf-display buf) + 'ok)))))))))) + +(define (move-end-of-para buf c) + (let ((org (save-pos buf))) + (buf-set-x! buf 0) + (let c-loop ((i (- c 1))) + (let loop () + (if (and (< (buf-y buf) (buf-length buf)) + (zero? (buf-cur-length buf))) + (begin (buf-set-y! buf (+ 1 (buf-y buf))) + (loop)) + (let loop () + (if (and (< (buf-y buf) (buf-length buf)) + (not (zero? (buf-cur-length buf)))) + (begin (buf-set-y! buf (+ 1 (buf-y buf))) + (loop)) + (cond ((= (buf-y buf) (buf-length buf)) + (restore-pos buf org) + (err buf)) + ((zero? i) + (buf-display buf) + 'ok) + (else + (c-loop (- i 1))))))))))) + +(define (move-top-of-para buf c) + (let ((org (save-pos buf))) + (buf-set-x! buf 0) + (let c-loop ((i (- c 1))) + (let loop () + (if (and (positive? (buf-y buf)) + (zero? (buf-cur-length buf))) + (begin (buf-set-y! buf (- (buf-y buf) 1)) + (loop)) + (let loop () + (if (and (positive? (buf-y buf)) + (not (zero? (buf-cur-length buf)))) + (begin (buf-set-y! buf (- (buf-y buf) 1)) + (loop)) + (cond ((positive? (buf-cur-length buf)) + (restore-pos buf org) + (err buf)) + ((zero? i) + (buf-display buf) + 'ok) + (else + (c-loop (- i 1))))))))))) + +(define (find-next-char buf c onto prompt) + (let ((ch (if prompt + (get-key buf #f) + (buf-scanchr buf)))) + (buf-set-scanchr! buf ch) + (buf-set-revscan! buf #f) + (buf-set-scan-onto! buf onto) + (if (not ch) + (err buf) + (let c-loop ((x (+ 1 (buf-x buf))) + (i (- c 1))) + (let loop ((x x)) + (cond ((or (and onto (not (buf-char buf x))) + (and (not onto) (not (buf-char buf (+ 1 x))))) + (err buf)) + ((or (and onto (char=? ch (buf-char buf x))) + (and (not onto) (char=? ch (buf-char buf (+ 1 x))))) + (if (zero? i) + (begin (goto-col buf x) + 'ok) + (c-loop (+ 1 x) (- i 1)))) + (else + (loop (+ 1 x))))))))) + +(define (find-prev-char buf c onto prompt) + (let ((ch (if prompt + (get-key buf #f) + (buf-scanchr buf)))) + (buf-set-scanchr! buf ch) + (buf-set-revscan! buf #t) + (buf-set-scan-onto! buf onto) + (if (not ch) + (err buf) + (let c-loop ((x (- (buf-x buf) 1)) + (i (- c 1))) + (let loop ((x x)) + (cond ((or (and onto (not (buf-char buf x))) + (and (not onto) (not (buf-char buf (- x 1))))) + (err buf)) + ((or (and onto (char=? ch (buf-char buf x))) + (and (not onto) (char=? ch (buf-char buf (- x 1))))) + (if (zero? i) + (begin (goto-col buf x) + 'ok) + (c-loop (- x 1) (- i 1)))) + (else + (loop (- x 1))))))))) + +(define (repeat-find-char buf nc) + (if (buf-revscan buf) + (find-prev-char buf nc (buf-scan-onto buf) #f) + (find-next-char buf nc (buf-scan-onto buf) #f))) + +(define (reverse-find-char buf nc) + (if (buf-revscan buf) + (find-next-char buf nc (buf-scan-onto buf) #f) + (find-prev-char buf nc (buf-scan-onto buf) #f)) + (buf-set-revscan! buf (not (buf-revscan buf)))) + +(define (extract-ident buf) + (if (or (not (buf-cur-char buf)) + (not (char-symbolic? (buf-cur-char buf)))) + #f + (let loop ((i0 (buf-x buf))) + (if (or (zero? i0) + (not (char-symbolic? (buf-char buf (- i0 1))))) + (let loop ((iN (buf-x buf))) + (if (or (not (buf-char buf iN)) + (not (char-symbolic? (buf-char buf iN)))) + (list i0 iN) + (loop (+ 1 iN)))) + (loop (- i0 1)))))) + +(define (search-ident buf) + (let ((pos2 (extract-ident buf))) + (if (not pos2) + (err buf) + (find-next buf (apply substring (buf-cur-line buf) pos2))))) + +(define (motion-command buf k c) + (let ((nc (if c c 1))) + (cond ((char=? k ^A) (search-ident buf)) + ((char=? k ^H) (move-left buf nc)) + ((char=? k ^J) (move-down buf nc)) + ((char=? k CR) (move-down-first buf nc)) + ((char=? k ^N) (move-down buf nc)) + ((char=? k SP) (move-right buf nc)) + ((char=? k #\0) (buf-set-x! buf 0) 'ok) + ((char=? k #\$) (move-to-eol buf)) + ((char=? k #\b) (move-prev-word buf nc #f)) + ((char=? k #\e) (move-end-of-word buf nc #f)) + ((char=? k #\f) (find-next-char buf nc #t #t)) + ((char=? k #\h) (move-left buf nc)) + ((char=? k #\j) (move-down buf nc)) + ((char=? k #\k) (move-up buf nc)) + ((char=? k #\l) (move-right buf nc)) + ((char=? k #\n) (search-again buf #f)) + ((char=? k #\t) (find-next-char buf nc #f #t)) + ((char=? k #\w) (move-next-word buf nc #f #f)) + ((char=? k #\B) (move-prev-word buf nc #t)) + ((char=? k #\E) (move-end-of-word buf nc #t)) + ((char=? k #\F) (find-prev-char buf nc #t #t)) + ((char=? k #\G) (move-to-line buf c)) + ((char=? k #\H) (move-top buf nc)) + ((char=? k #\L) (move-bottom buf nc)) + ((char=? k #\M) (move-middle buf)) + ((char=? k #\N) (search-again buf #t)) + ((char=? k #\T) (find-prev-char buf nc #f #t)) + ((char=? k #\W) (move-next-word buf nc #t #f)) + ((char=? k #\%) (match-paren buf #t)) + ((char=? k #\') (move-to-mark buf #f)) + ((char=? k LP) (move-prev-expr buf nc)) + ((char=? k RP) (move-next-expr buf nc)) + ((char=? k #\+) (move-down-first buf nc)) + ((char=? k #\,) (reverse-find-char buf nc)) + ((char=? k #\-) (move-up-first buf nc)) + ((char=? k #\/) (search-forward buf)) + ((char=? k #\?) (search-backward buf)) + ((char=? k #\;) (repeat-find-char buf nc)) + ((char=? k #\^) (move-to-first buf)) + ((char=? k #\`) (move-to-mark buf #t)) + ((char=? k #\{) (move-top-of-para buf nc)) + ((char=? k #\|) (move-to-col buf nc)) + ((char=? k #\}) (move-end-of-para buf nc)) + (else 'no)))) + +(define (delete-by-col buf from to) + (let ((line (buf-cur-line buf))) + (let ((left (substring line 0 from)) + (middle (substring line from to)) + (right (substring line to (string-length line)))) + (log-del-chars buf middle) + (buf-set-cur-line! buf (string-append left right))))) + +(define (delete-char-forw buf c) + (real-pos! buf) + (if (> (+ c (buf-x buf)) (buf-cur-length buf)) + (err buf) + (begin (log-new buf) + (buf-clear-yanked! buf) + (yank-by-col buf (buf-x buf) (+ (buf-x buf) c)) + (buf-add-yanked! buf 'col) + (delete-by-col buf (buf-x buf) (+ (buf-x buf) c)) + (buf-modified! buf) + (buf-display buf) + 'ok))) + +(define (delete-char-backw buf c) + (real-pos! buf) + (if (< (buf-x buf) c) + (err buf) + (begin (buf-set-x! buf (- (buf-x buf) c)) + (delete-char-forw buf c)))) + +(define (insert-char ch tail) + (addch ch) + (addstr tail) + ch) + +(define (display-newline y o tail) + (let ((y (+ y 1))) + (cond ((> y (- (text-lines) 1)) + (clrtoeol) + (move 0 0) + (deleteln) + (move (- (text-lines) 1) 0) + (clrtoeol) + (addstr (make-string o #\space)) + (addstr tail)) + (else + (clrtoeol) + (move y 0) + (insertln) + (addstr (make-string o #\space)) + (addstr tail))))) + +(define (offset s) + (let ((k (string-length s))) + (let loop ((i 0)) + (if (or (>= i k) + (not (char=? #\space (string-ref s i)))) + i + (loop (+ 1 i)))))) + +(define (add-offset n a) + (if (zero? n) + a + (cons #\space (add-offset (- n 1) a)))) + +(define (new-offset s old) + (let loop ((s s) + (n 0)) + (cond ((null? s) + old) + ((char=? #\newline (car s)) + n) + ((char=? #\space (car s)) + (loop (cdr s) (+ 1 n))) + (else + (loop (cdr s) 0))))) + +(define (trim-blank-lines text tail) + (letrec + ((trim + (lambda (ln) + (let loop ((x ln)) + (cond ((null? x) + '()) + ((not (memv (car x) '(#\space #\newline))) + ln) + (else + (loop (cdr x)))))))) + (let loop ((in text) + (ln '()) + (out '())) + (cond ((null? in) + (if (string=? "" tail) + (append out (trim (reverse! ln))) + (append out (reverse! ln)))) + ((char=? #\newline (car in)) + (let* ((ln (trim (reverse! ln))) + (out (append out ln '(#\newline)))) + (loop (cdr in) '() out))) + (else + (loop (cdr in) (cons (car in) ln) out)))))) + +(define (find-prefix s words) + (let ((k (string-length s))) + (let loop ((w words) + (r '())) + (cond ((null? w) + (let ((lim (if (null? r) + 0 + (apply min (map string-length r))))) + (let loop ((i k)) + (cond ((>= i lim) + (if (zero? lim) + "" + (substring (car r) 0 i))) + ((let ((c* (map (lambda (x) + (string-ref x i)) + r))) + (and (> (length c*) 1) + (not (apply char-ci=? c*)))) + (substring (car r) 0 i)) + (else + (loop (+ 1 i))))))) + ((and (<= k (string-length (car w))) + (string-ci=? (substring (car w) 0 k) s)) + (loop (cdr w) (cons (car w) r))) + (else + (loop (cdr w) r)))))) + +(define (extract-last-symbol s) + (do ((y '() (cons (car s) y)) + (s s (cdr s))) + ((or (null? s) + (not (char-symbolic? (car s)))) + (list->string y)))) + +(define (insert-mode buf tail init-ch init-off) + (mode buf "insert") + (let loop ((y (screen-line buf)) + (x (if init-off + (+ init-off (buf-x buf)) + (buf-x buf))) + (s (if init-off + (string->list (make-string init-off #\space)) + '())) + (o (if (buf-prop? buf bp-autoindent) + (if init-off + init-off + (offset (buf-cur-line buf))) + 0))) + (move y x) + (let ((k (if (null? init-ch) + (if *Repeat* + 'ignore + (get-key buf #f)) + (car init-ch)))) + (if (not (null? init-ch)) + (set! init-ch (cdr init-ch))) + (cond (*Repeat* + (command-mode buf) + (cadr (buf-lastcmd buf))) + ((char=? k ESC) + (command-mode buf) + (let ((text (list->string + (trim-blank-lines (reverse! s) tail)))) + (if (not *Repeat*) + (buf-set-lastcmd! buf (list (car (buf-lastcmd buf)) + text))) + text)) + ((char=? k ^H) + (cond ((or (null? s) + (char=? #\newline (car s))) + (err buf) + (loop y x s o)) + (else + (mvaddstr y (- x 1) tail) + (addch #\space) + (loop y (- x 1) (cdr s) o)))) + ((char=? k CR) + (let ((o (if (buf-prop? buf bp-autoindent) + (new-offset s o) + 0))) + (display-newline y o tail) + (buf-status buf) + (loop (min (- (text-lines) 1) (+ y 1)) + o + (add-offset o (cons #\newline s)) + o))) + ((char=? k TAB) + (let* ((symb (extract-last-symbol s)) + (kt (string-length symb)) + (prefix (if (zero? kt) + "" + (find-prefix symb *Completion-symbols*))) + (kp (and (not (zero? kt)) + (string-length prefix)))) + (if (and kp (> kp kt)) + (set! init-ch (string->list (substring prefix kt kp))) + (if (and (zero? kt) + (< x (- (cols) 8))) + (set! init-ch (list ^T)))) + (loop y x s o))) + ((and (< x (- (cols) 1)) + (<= 32 (char->integer k) 126)) + (loop y (+ x 1) (cons (insert-char k tail) s) o)) + ((and (< x (- (cols) 8)) + (char=? ^T k)) + (let tab-loop ((i 0) + (n (- 8 (remainder x 8))) + (s s)) + (if (= i n) + (loop y (+ x n) s o) + (begin (move y (+ i x)) + (tab-loop (+ 1 i) + n + (cons (insert-char #\space tail) + s)))))) + (else + (err buf) + (loop y x s o)))))) + +(define (insert-lines buf y n) + (if (>= (+ n (buf-length buf)) + (buf-size buf)) + (insert-into-buf! buf (+ (buf-size buf) n) "")) + (let loop ((i (buf-length buf))) + (if (>= i y) + (begin (buf-set-line! buf + (+ n i) + (buf-line buf i)) + (loop (- i 1))))) + (buf-set-length! buf (+ (buf-length buf) n)) + (buf-set-line! buf y "")) + +(define (insert-text buf s) + (if (zero? (buf-length buf)) + (buf-set-length! buf 1)) + (log-insert buf s) + (let ((text* (if (string? s) + (string-split #\newline s) + s))) + (if (> (length text*) 1) + (insert-lines buf + (+ 1 (buf-y buf)) + (- (length text*) 1))) + (let loop ((text* text*)) + (cond ((null? text*) + (if (>= (buf-y buf) + (+ (text-lines) (buf-top buf))) + (buf-set-top! buf (+ 1 (- (buf-y buf) + (text-lines))))) + (buf-display buf)) + (else + (let* ((pre (substring (buf-cur-line buf) + 0 + (buf-x buf))) + (suf (substring (buf-cur-line buf) + (buf-x buf) + (buf-cur-length buf))) + (new (string-append pre + (car text*) + (if (null? (cdr text*)) + suf + "")))) + (buf-set-cur-line! buf new) + (buf-set-x! buf (+ (string-length (car text*)) + (buf-x buf))) + (if (not (null? (cdr text*))) + (begin (buf-set-y! buf (+ 1 (buf-y buf))) + (buf-set-x! buf 0) + (buf-set-cur-line! buf suf))) + (loop (cdr text*)))))))) + +(define (insert-at-point buf c init-ch) + (buf-modified! buf) + (let ((tail (substring (buf-cur-line buf) + (buf-x buf) + (buf-cur-length buf)))) + (let ((s (insert-mode buf tail init-ch #f))) + (log-new buf) + (let loop ((c c)) + (cond ((not (zero? c)) + (insert-text buf s) + (loop (- c 1))) + (else + (if (positive? (buf-x buf)) + (buf-set-x! buf (- (buf-x buf) 1))) + 'ok)))))) + +(define (insert-at-bol buf c) + (move-to-first buf) + (insert-at-point buf c '())) + +(define (append-at-point buf c) + (cond ((>= (buf-x buf) (- (cols) 1)) + (err buf)) + (else + (if (buf-cur-char buf) + (buf-set-x! buf (+ 1 (buf-x buf)))) + (insert-at-point buf c '())))) + +(define (append-at-eol buf c init-ch) + (cond ((failed? (move-to-eol buf)) + (err buf)) + (else + (if (buf-cur-char buf) + (buf-set-x! buf (+ 1 (buf-x buf)))) + (insert-at-point buf c init-ch)))) + +(define (open-line buf c above) + (if above + (begin (buf-set-x! buf 0) + (move (screen-line buf) 0) + (if (= (screen-line buf) (- (text-lines) 1)) + (begin (move (- (text-lines) 1) 0) + (clrtoeol)) + (display-newline (screen-line buf) + 0 + (buf-cur-line buf))) + (buf-modified! buf) + (buf-status buf) + (let ((s (insert-mode buf "" '() (offset (buf-cur-line buf))))) + (log-new buf) + (fast-mode buf) + (let loop ((c c)) + (cond ((not (zero? c)) + (insert-text buf (string-append + s + (string #\newline))) + (loop (- c 1))) + (else + (move-up buf 1) + (move-to-eol buf) + (slow-mode buf) + 'ok))))) + (begin (log-new buf) + (append-at-eol buf c (list CR))))) + +(define (delete-lines buf y n) + (let ((k (buf-length buf))) + (let loop ((i (+ n y))) + (if (< i k) + (begin (buf-set-line! buf + (- i n) + (buf-line buf i)) + (loop (+ 1 i))))) + (buf-set-length! buf (- (buf-length buf) n)) + (if (zero? (buf-length buf)) + (begin (buf-set-line! buf 0 "") + (buf-set-length! buf 1))))) + +(define (trim-left s) + (let ((k (string-length s))) + (let loop ((i 0)) + (cond ((>= i k) + "") + ((char-whitespace? (string-ref s i)) + (loop (+ 1 i))) + (else + (substring s i k)))))) + +(define (join-lines buf c trim) + (if (>= (+ (buf-y buf) c) (buf-length buf)) + (err buf) + (let loop ((i c) + (y (+ 1 (buf-y buf))) + (log '())) + (cond ((zero? i) + (delete-lines buf (+ 1 (buf-y buf)) c) + (let* ((x (buf-cur-length buf)) + (new (cons (buf-cur-line buf) + (reverse! (map trim-left log)))) + (log (cons (buf-cur-line buf) + (reverse! log))) + (new (if trim + (string-unsplit #\space new) + (apply string-append log)))) + (log-join buf (cons trim log)) + (buf-set-cur-line! buf new) + (buf-set-x! buf x)) + (buf-display buf) + 'ok) + (else + (loop (- i 1) + (+ y 1) + (cons (buf-line buf y) log))))))) + +(define (join-command buf c) + (buf-modified! buf) + (log-new buf) + (join-lines buf c #t)) + +(define (break-line buf) + (let* ((line (buf-cur-line buf)) + (upper (substring line 0 (buf-x buf))) + (lower (substring line (+ 1 (buf-x buf)) (buf-cur-length buf))) + (lower (trim-left lower)) + (indent (if (buf-prop? buf bp-autoindent) + (offset (buf-cur-line buf)) + 0)) + (lower (string-append (make-string indent #\space) lower))) + (buf-modified! buf) + (log-new buf) + (log-break buf line) + (insert-lines buf (+ 1 (buf-y buf)) 1) + (buf-set-cur-line! buf upper) + (buf-set-line! buf (+ 1 (buf-y buf)) lower) + (move-down buf 1) + (move-to-first buf) + (buf-display buf) + 'ok)) + +(define (replace-cols buf new) + (let* ((line (buf-cur-line buf)) + (x (buf-x buf)) + (k (string-length new)) + (left (substring line 0 x)) + (right (if (>= (+ x k) (buf-cur-length buf)) + "" + (substring line (+ x k) (buf-cur-length buf))))) + (log-new buf) + (log-replace buf (list (buf-cur-line buf) new)) + (buf-set-line! buf + (buf-y buf) + (string-append left new right)) + (if (> k 1) + (move-right buf (- k 1))))) + +(define (replace-char buf c) + (real-pos! buf) + (if (> (+ (buf-x buf) c) (buf-cur-length buf)) + (err buf) + (let ((k (begin (mode buf "replace char") + (if *Repeat* + (cadr (buf-lastcmd buf)) + (get-key buf #t))))) + (if (not *Repeat*) + (buf-set-lastcmd! buf (list (car (buf-lastcmd buf)) k))) + (buf-modified! buf) + (command-mode buf) + (cond ((char=? k CR) + (break-line buf)) + ((<= 32 (char->integer k) 126) + (replace-cols buf (make-string c k)) + (buf-display buf) + 'ok) + (else + (err buf)))))) + +(define (replace-text buf c) + (real-pos! buf) + (if c + (err buf "#R: not supported") + (let ((new (if *Repeat* + (cadr (buf-lastcmd buf)) + (get-line (screen-line buf) + buf + (substring (buf-cur-line buf) + 0 + (buf-x buf)) + (substring (buf-cur-line buf) + (buf-x buf) + (buf-cur-length buf)))))) + (buf-set-lastcmd! buf (list (car (buf-lastcmd buf)) new)) + (replace-cols buf new) + (buf-display buf) + 'ok))) + +(define (delete-to-eol buf) + (real-pos! buf) + (if (zero? (buf-cur-length buf)) + (err buf) + (begin (log-new buf) + (buf-modified! buf) + (buf-clear-yanked! buf) + (yank-by-col buf (buf-x buf) (buf-cur-length buf)) + (buf-add-yanked! buf 'col) + (delete-by-col buf (buf-x buf) (buf-cur-length buf)) + (if (positive? (buf-x buf)) + (buf-set-x! buf (- (buf-x buf) 1))) + (buf-display buf) + 'ok))) + +(define (delete-by-line buf c) + (if (> (+ c (buf-y buf)) (buf-length buf)) + (err buf) + (let loop ((i c) + (y (buf-y buf)) + (log '())) + (cond ((zero? i) + (buf-set-x! buf 0) + (log-del-lines buf log) + (delete-lines buf (buf-y buf) c) + (cond ((>= (buf-y buf) (buf-length buf)) + (buf-set-y! buf (max 0 (- (buf-length buf) 1)))) + ((and (positive? (buf-y buf)) + (>= (buf-y buf) (buf-length buf))) + (move-up buf 1))) + (buf-display buf) + 'ok) + (else + (loop (- i 1) + (+ y 1) + (cons (buf-line buf y) log))))))) + +(define-syntax swap! + (syntax-rules () + ((_ a b) + (let ((t a)) + (set! a b) + (set! b t))))) + +(define (line-motion? x k) + (or (and (zero? x) + (memv k '(#\{ #\})) + #t) + (and (memv k '(#\' #\j #\k #\H #\L #\M #\G)) + #t))) + +(define (one-more-char? k) + (or (and (memv k '(#\% #\f #\t)) + #t) + (and (not *Repeat*) + (memv k '(#\; #\,)) + #t))) + +(define (delete-region k buf origin) + (fast-mode buf) + (let ((pos (save-pos buf))) + (yank-region k buf origin) + (reset-pos buf pos) + (buf-modified! buf) + (let ((y0 (saved-y origin)) + (x0 (saved-x origin)) + (dy (buf-y buf)) + (dx (buf-x buf))) + (if (> y0 dy) + (begin (swap! y0 dy) + (swap! x0 dx))) + (if (and (= y0 dy) + (> x0 dx)) + (swap! x0 dx)) + (let ((dx (if (one-more-char? k) + (+ 1 dx) + dx))) + (cond ((line-motion? x0 k) + (goto-line buf y0) + (log-new buf) + (delete-by-line buf (+ 1 (- dy y0))) + (if (< (saved-y origin) (saved-y pos)) + (restore-pos buf origin)) + (slow-mode buf) + 'ok) + ((= y0 dy) + (goto-col buf x0) + (delete-char-forw buf (- dx x0)) + (slow-mode buf) + 'ok) + (else + (goto-line buf y0) + (goto-col buf x0) + (log-new buf) + (delete-by-col buf (buf-x buf) (buf-cur-length buf)) + (buf-set-y! buf (+ 1 (buf-y buf))) + (delete-by-line buf (- dy y0 1)) + (delete-by-col buf 0 dx) + (buf-set-y! buf (- (buf-y buf) 1)) + (join-lines buf 1 #f) + (if (< (saved-y origin) (saved-y pos)) + (restore-pos buf origin)) + (slow-mode buf) + 'ok)))))) + +(define (delete-from-here buf c) + (real-pos! buf) + (mode buf "delete") + (let* ((kc (if *Repeat* + (cadr (buf-lastcmd buf)) + (get-cmd buf))) + (k (car kc)) + (c (if (cadr kc) + (cadr kc) + (if (char=? k #\G) + #f + c))) + (p (save-pos buf))) + (let ((saved-kc (case (car kc) + ((#\/ #\?) `(#\n #f)) + ((#\f #\F #\t #\T) `(#\; #f)) + (else kc)))) + (if (not *Repeat*) + (buf-set-lastcmd! buf (list (car (buf-lastcmd buf)) + saved-kc)))) + (command-mode buf) + (cond ((char=? k #\d) + (log-new buf) + (buf-clear-yanked! buf) + (yank-by-line buf c) + (buf-modified! buf) + (delete-by-line buf c)) + ((char=? k ESC)) + (else + (case (motion-command buf k c) + ((no) (err buf "usage: #[d]{[d]|}")) + ((ok) (delete-region k buf p)) + (else 'failed)))))) + +(define (middle x) + (cdr (reverse! (cdr (reverse x))))) + +(define (last x) + (car (reverse x))) + +(define (paste-text buf yy c before) + (log-new buf) + (fast-mode buf) + (let ((here (save-pos buf))) + (let loop ((i c)) + (cond ((zero? i) + (reset-pos buf here) + (slow-mode buf)) + ((eq? 'col (car yy)) + (if (and (buf-cur-char buf) + (not before)) + (buf-set-x! buf (+ 1 (buf-x buf)))) + (insert-text buf (cadr yy)) + (if (>= (length yy) 4) + (insert-text buf + (string-unsplit + #\newline + (cons "" (middle (cdr yy)))))) + (if (>= (length yy) 3) + (insert-text buf (string-append (string #\newline) + (last yy)))) + (loop (- i 1))) + (else + (if (not before) + (begin (buf-set-x! buf (buf-cur-length buf)) + (insert-text buf + (string-unsplit #\newline + (append '("") yy)))) + (insert-text buf + (string-unsplit #\newline (append yy '(""))))) + (reset-pos buf here) + (if (not before) + (if (eq? 'col (car yy)) + (move-right buf 1) + (begin (move-down buf 1) + (buf-set-x! buf 0)))) + (set! here (save-pos buf)) + (loop (- i 1))))))) + +(define (paste-command buf c before) + (let ((yy (buf-yanked buf))) + (if (null? yy) + (err buf "nothing yanked yet") + (begin (buf-modified! buf) + (real-pos! buf) + (paste-text buf yy c before))))) + +(define (insdel-command buf k c) + (let ((pos (save-pos buf)) + (last (buf-lastcmd buf))) + (real-pos! buf) + (if (not *Repeat*) + (buf-set-lastcmd! buf (list (list k c)))) + (let ((nc (if c c 1))) + (cond ((char=? k #\a) (append-at-point buf nc)) + ((char=? k #\d) (delete-from-here buf nc)) + ((char=? k #\i) (insert-at-point buf nc '())) + ((char=? k #\o) (open-line buf nc #f)) + ((char=? k #\p) (paste-command buf nc #f)) + ((char=? k #\r) (replace-char buf nc)) + ((char=? k #\x) (delete-char-forw buf nc)) + ((char=? k #\A) (append-at-eol buf nc '())) + ((char=? k #\D) (delete-to-eol buf)) + ((char=? k #\I) (insert-at-bol buf nc)) + ((char=? k #\J) (join-command buf nc)) + ((char=? k #\O) (open-line buf nc #t)) + ((char=? k #\P) (paste-command buf nc #t)) + ((char=? k #\R) (replace-text buf c)) + ((char=? k #\X) (delete-char-backw buf nc)) + (else (reset-pos buf pos) + (buf-set-lastcmd! buf last) + 'no))))) + +(define (go-backward buf c) + (let ((here (save-pos buf))) + (if (zero? (buf-y buf)) + (err buf) + (begin (move-top buf 1) + (cond ((negative? (- (buf-y buf) c)) + (goto-line buf 0) + (if (= (saved-top here) (buf-top buf)) + 'failed + 'ok)) + (else + (move-up buf c) + 'ok)))))) + +(define (move-ppage buf c) + (if (ok? (go-backward buf (* c (- (text-lines) 1)))) + (move-bottom buf 1)) + 'ok) + +(define (go-forward buf c) + (let ((here (save-pos buf))) + (if (>= (buf-y buf) (- (buf-length buf) 1)) + (err buf) + (begin (move-bottom buf 1) + (cond ((>= (+ c (buf-y buf)) + (buf-length buf)) + (goto-line buf (- (buf-length buf) 1)) + (if (= (saved-top here) (buf-top buf)) + 'failed + 'ok)) + (else + (move-down buf c) + 'ok)))))) + +(define (move-npage buf c) + (if (ok? (go-forward buf (* c (- (text-lines) 1)))) + (move-top buf 1)) + 'ok) + +(define (repaint buf) + (clear) + (buf-status buf) + (buf-display buf) + 'ok) + +(define (scroll-down buf c) + (let ((y (screen-line buf))) + (if (ok? (go-forward buf (if c c (buf-val buf bv-scroll)))) + (move-top buf (+ 1 y))))) + +(define (scroll-up buf c) + (let ((y (screen-line buf))) + (if (ok? (go-backward buf (if c c (buf-val buf bv-scroll)))) + (move-top buf (+ 1 y))))) + +(define (set-mark buf) + (real-pos! buf) + (if (not (char=? (get-key buf #f) #\m)) + (err buf "usage: [m][m]") + (begin (buf-set-mark! buf (list (buf-y buf) (buf-x buf))) + 'ok))) + +(define (center-command buf c) + (let ((mode (get-key buf #f)) + (c (if c + (- c 1) + (buf-y buf)))) + (if (not (memv mode (list #\. #\- CR))) + (err buf "usage: #[z]{[.]|[-]|[CR]}") + (center-line buf c mode)))) + +(define (yank-by-col buf from to) + (buf-add-yanked! buf (substring (buf-cur-line buf) from to))) + +(define (yank-to-eol buf) + (real-pos! buf) + (if (zero? (buf-cur-length buf)) + (err buf) + (begin (buf-clear-yanked! buf) + (yank-by-col buf (buf-x buf) (buf-cur-length buf)) + (buf-add-yanked! buf 'col) + 'ok))) + +(define (yank-by-line buf c) + (if (> (+ c (buf-y buf)) (buf-length buf)) + (err buf) + (let loop ((i c) + (y (buf-y buf)) + (lns '())) + (cond ((zero? i) + (for-each (lambda (x) + (buf-add-yanked! buf x)) + lns) + 'ok) + (else + (loop (- i 1) + (+ y 1) + (cons (buf-line buf y) lns))))))) + +(define (yank-region k buf origin) + (let ((y0 (saved-y origin)) + (x0 (saved-x origin)) + (dy (buf-y buf)) + (dx (buf-x buf)) + (pos (save-pos buf))) + (if (> y0 dy) + (begin (swap! y0 dy) + (swap! x0 dx))) + (if (and (= y0 dy) + (> x0 dx)) + (swap! x0 dx)) + (let ((dx (if (one-more-char? k) + (+ 1 dx) + dx))) + (cond ((line-motion? x0 k) + (goto-line buf y0) + (buf-clear-yanked! buf) + (yank-by-line buf (+ 1 (- dy y0))) + (restore-pos buf origin)) + ((= y0 dy) + (goto-col buf x0) + (buf-clear-yanked! buf) + (yank-by-col buf x0 dx) + (buf-add-yanked! buf 'col) + (restore-pos buf origin)) + (else + (buf-clear-yanked! buf) + (buf-set-y! buf dy) + (yank-by-col buf 0 dx) + (buf-set-y! buf (+ 1 y0)) + (yank-by-line buf (- dy y0 1)) + (goto-line buf y0) + (goto-col buf x0) + (yank-by-col buf (buf-x buf) (buf-cur-length buf)) + (buf-add-yanked! buf 'col) + (restore-pos buf origin) + (buf-display buf) + 'ok))))) + +(define (yank-from-here buf c) + (real-pos! buf) + (mode buf "yank") + (let* ((kc (get-cmd buf)) + (k (car kc)) + (c (if (cadr kc) + (cadr kc) + (if (char=? k #\G) + #f + c))) + (p (save-pos buf))) + (command-mode buf) + (cond ((char=? k #\y) + (buf-clear-yanked! buf) + (yank-by-line buf c)) + ((char=? k ESC)) + (else + (case (motion-command buf k c) + ((no) (err buf "usage: #[y]{[y]|}")) + ((ok) (yank-region k buf p)) + (else 'failed)))))) + +(define (unsaved-buffers? buf) + (and (memq #t (map buf-modified? (remq buf *Buffers*))) + #t)) + +(define (disconnect!) + (close-output-port (cadr *Session*)) + (catch-errors #t) + (send-signal (caddr *Session*)) + (wait-for-process) + (catch-errors #f) + (set! *Session* #f)) + +(define (find-transient-buffer prop) + (let loop ((b *Buffers*)) + (cond ((null? b) + #f) + ((buf-prop? (car b) prop) + (car b)) + (else + (loop (cdr b)))))) + +(define (open-transient-buffer buf title prop init-new) + (let ((tb (find-transient-buffer prop))) + (if tb + tb + (let ((new (new-buffer `(,prop + ,bp-transient + ,bp-readonly + ,@(clean-up-props buf)) + (buf-values buf)))) + (swap-buffers!) + (init-new new) + (if title + (buf-set-name! new title)) + new)))) + +(define (goto-transient-buffer buf title prop init-new) + (let ((tb (open-transient-buffer buf title prop init-new))) + (delete-buffer tb) + (set! *Buffers* (cons tb *Buffers*)) + tb)) + +(define (open-scheme-buffer buf) + (open-transient-buffer buf + " *Scheme* " + bp-tag-scmint + (lambda (ignore) + (load-scheme-buffer)))) + +(define (goto-scheme-buffer buf) + (goto-transient-buffer buf + " *Scheme* " + bp-tag-scmint + (lambda (ignore) + (load-scheme-buffer)))) + +(define (save-scheme-buffer) + (let* ((home (getenv "HOME")) + (path (if home + (string-append home "/.arse.int"))) + (intbuf (if home + (find-transient-buffer bp-tag-scmint)))) + (if (and home + intbuf + (buf-prop? intbuf bp-saveintbuf)) + (buf-write! intbuf path)))) + +(define (load-scheme-buffer) + (let* ((home (getenv "HOME")) + (path (if home + (string-append home "/.arse.int"))) + (intbuf (if home + (open-scheme-buffer (car *Buffers*))))) + (if (and home + (buf-prop? intbuf bp-saveintbuf)) + (buf-load! intbuf path)))) + +(define (quit) + (save-scheme-buffer) + (move (- (lines) 1) 0) + (clrtoeol) + (refresh) + (endwin) + (if *Session* + (disconnect!)) + 'quit) + +(define (save+exit buf) + (let ((ch (get-key buf #f))) + (cond ((and (unsaved-buffers? buf)) + (err buf "there are unsaved buffers! use :w :q! to discard them")) + ((and (buf-modified? buf) + (not (buf-name buf))) + (err buf "buffer has no name! use \":w name\" to supply one")) + ((char=? ch #\Z) + (if (buf-modified? buf) + (if (eq? 'ok (buf-save! buf #f)) + (quit)) + (quit))) + (else + (err buf "usage: [Z][Z]"))))) + +(define (change-block buf from to proc . args) + (if (positive? (buf-length buf)) + (begin (if (> from to) + (swap! from to)) + (fast-mode buf) + (goto-line buf from) + (log-new buf) + (delete-by-line buf (+ 1 (- to from))) + (let* ((text (reverse (log-what (car (buf-undo-log buf))))) + (text (apply proc buf text args))) + (buf-set-y! buf from) + (if (> (buf-y buf) (buf-length buf)) + (buf-set-y! buf (buf-length buf))) + (insert-text buf (append text (if (zero? (buf-length buf)) + '() + '("")))) + (buf-set-y! buf from) + (slow-mode buf) + 'ok)))) + +(define (run-filter buf text command) + (real-pos! buf) + (let ((s (spawn-shell-command command))) + (for-each (lambda (x) + (display x (cadr s)) + (newline (cadr s))) + text) + (close-output-port (cadr s)) + (map expand-tabs (read-file (car s))))) + +(define (filter-command buf) + (real-pos! buf) + (let* ((y0 (buf-y buf)) + (kc (get-cmd buf)) + (dy (cond ((char=? (car kc) #\!) + y0) + ((char=? (car kc) ESC) + #f) + ((eq? 'ok (apply motion-command buf kc)) + (buf-y buf)) + (else + (err buf "usage: [!]filter command[CR]") + #f)))) + (let ((cmd (and dy (get-line (text-lines) buf "!" #f)))) + (if (and cmd dy (positive? (string-length cmd))) + (begin (buf-modified! buf) + (change-block buf y0 dy run-filter cmd)))))) + +(define (run-indent buf text indent) + (let ((pre (make-string indent #\space))) + (map (lambda (x) + (if (string=? "" x) + x + (string-append pre x))) + text))) + +(define (run-outdent buf text outdent) + (let ((outdent (if outdent outdent 2))) + (let ((pre (make-string outdent #\space))) + (let ((new (map (lambda (x) + (cond ((string=? "" x) + "") + ((< (string-length x) outdent) + #f) + ((not (string=? pre (substring x 0 outdent))) + #f) + (else + (substring x outdent (string-length x))))) + text))) + (if (memq #f new) + (begin (err buf) + text) + new))))) + +(define (in/outdent-command buf c cmd-ch) + (real-pos! buf) + (let ((c (if c c (buf-val buf bv-indent))) + (pos (save-pos buf))) + (let* ((y0 (buf-y buf)) + (kc (get-cmd buf)) + (dy (cond ((char=? (car kc) cmd-ch) + (if (memv (buf-cur-char buf) '(#\( #\))) + (begin (match-paren buf #f) + (buf-y buf)) + y0)) + ((char=? (car kc) ESC) + #f) + ((eq? 'ok (apply motion-command buf kc)) + (buf-y buf)) + (else + (if (char=? cmd-ch #\<) + (err buf "usage: #[<]{[<]|}") + (err buf "usage: #[>]{[>]|}")) + #f)))) + (if dy + (begin (buf-modified! buf) + (change-block buf + y0 + dy + (if (char=? cmd-ch #\>) + run-indent + run-outdent) + c) + (reset-pos buf pos) + (let ((inc (if (char=? cmd-ch #\<) - +))) + (buf-set-x! buf (inc (buf-x buf) c)))))))) + +(define (run-change-case buf text ignore) + (map (lambda (x) + (let* ((k (string-length x)) + (n (make-string k))) + (let loop ((i 0)) + (if (>= i k) + n + (let ((c (string-ref x i))) + (string-set! n i (if (char-upper-case? c) + (char-downcase c) + (char-upcase c))) + (loop (+ 1 i))))))) + text)) + +(define (change-case-command buf c) + (real-pos! buf) + (let* ((y0 (buf-y buf)) + (kc (get-cmd buf)) + (dy (cond ((char=? (car kc) #\~) + y0) + ((char=? (car kc) ESC) + #f) + ((eq? 'ok (apply motion-command buf kc)) + (buf-y buf)) + (else + (err buf "usage: #[~~]{[~~]|}") + #f)))) + (if dy + (begin (buf-modified! buf) + (change-block buf y0 dy run-change-case c))))) + +(define (count-chars buf) + (mode buf "busy") + (let ((chars (apply + + (buf-length buf) + (map string-length + (vector->list (buf-buffer buf)))))) + (command-mode buf) + chars)) + +(define (percent n n100) + (if (or (zero? n100) + (= n n100)) + 100 + (quotient (* n 100) n100))) + +(define (start-info buf) + (if (buf-prop? buf bp-showmode) + (move (text-lines) (- (cols) 1)) + (begin (move (text-lines) 0) + (so buf) + (addstr "-*-*-*-") + (se buf))) + (scrollok #t) + (addstr (string (integer->char 10) (integer->char 13)))) + +(define (crlf) + (addstr (string (integer->char 10) (integer->char 13)))) + +(define (end-info buf) + (addstr "Press ENTER to return to ARSE: ") + (scrollok #f) + (getch) + (buf-display buf) + (buf-status buf) + 'ok) + +(define (long-status buf) + (let ((chars (count-chars buf))) + (start-info buf) + (addstr (format #f "~S~A~A: ~D characters, line ~D of ~D (~D%), col ~D" + (cond ((buf-name buf) + => (lambda (x) x)) + (else + '*anonymous*)) + (cond ((buf-transient? buf) ": transient") + ((buf-modified? buf) ": modified") + (else "")) + (if (buf-readonly? buf) + ": read-only" + "") + chars + (+ 1 (buf-y buf)) + (buf-length buf) + (percent (buf-y buf) + (- (buf-length buf) 1)) + (+ 1 (buf-x buf)))) + (crlf) + (end-info buf))) + +(define (prepare-last-line buf where) + (let loop () + (if (>= (saved-y where) (buf-length buf)) + (begin (buf-set-length! buf (+ 1 (buf-length buf))) + (buf-set-line! buf (last-line buf) "") + (loop))))) + +(define (trim-last-line buf) + (if (zero? (string-length (buf-line buf (last-line buf)))) + (begin (buf-set-length! buf (- (buf-length buf) 1)) + (if (>= (buf-y buf) (buf-length buf)) + (buf-set-y! buf (last-line buf)))))) + +(define (undo-insc buf where what) + (let ((what (if (string? what) + (string-split #\newline what) + what))) + (if (> (length what) 1) + (prepare-last-line buf where)) + (restore-pos buf where) + (delete-by-col buf (saved-x where) + (+ (string-length (car what)) + (saved-x where))) + (if (> (length what) 2) + (begin (buf-set-y! buf (+ 1 (saved-y where))) + (delete-by-line buf (- (length what) 2)))) + (if (> (length what) 1) + (begin (buf-set-y! buf (+ 1 (saved-y where))) + (delete-by-col buf 0 (string-length (last what))) + (goto-line buf (saved-y where)) + (if (< (+ (buf-y buf) 1) (buf-length buf)) + (join-lines buf 1 #f)) + (trim-last-line buf))) + (buf-display buf) + 'ok)) + +(define (undo-delc buf where what) + (reset-pos buf where) + (insert-text buf what) + 'ok) + +(define (undo-deln buf where what) + (prepare-last-line buf where) + (restore-pos buf where) + (insert-text buf (append (reverse what) + (if (zero? (buf-length buf)) + '() + '("")))) + (trim-last-line buf) + (goto-line buf (car where)) + 'ok) + +(define (undo-brkl buf where what) + (reset-pos buf where) + (buf-set-y! buf (+ 1 (saved-y where))) + (delete-by-line buf 1) + (reset-pos buf where) + (buf-set-cur-line! buf what) + (buf-display buf) + 'ok) + +(define (undo-join buf where what) + (reset-pos buf where) + (delete-by-line buf 1) + (restore-pos buf where) + (buf-set-x! buf 0) + (insert-text buf (append (cdr what) '(""))) + (restore-pos buf where)) + +(define (undo-repc buf where what) + (reset-pos buf where) + (buf-set-cur-line! buf (car what)) + (buf-display buf) + 'ok) + +(define (find-NEXT-op log) + (cond ((null? log) + (error "no NEXT op in undo/redo log -- should not happen!")) + ((eq? 'NEXT (log-op (car log))) + (car log)) + (else + (find-NEXT-op (cdr log))))) + +(define (undo buf) + (fast-mode buf) + (let loop ((redo-log (cons (find-NEXT-op (buf-undo-log buf)) + (buf-redo-log buf)))) + (let* ((log (buf-undo-log buf)) + (act (car log))) + (if (not (eq? (log-op act) 'NEXT)) + (begin + (case (log-op act) + ((INSC) (undo-insc buf (log-where act) (log-what act))) + ((DELC) (undo-delc buf (log-where act) (log-what act))) + ((DELN) (undo-deln buf (log-where act) (log-what act))) + ((BRKL) (undo-brkl buf (log-where act) (log-what act))) + ((JOIN) (undo-join buf (log-where act) (log-what act))) + ((REPC) (undo-repc buf (log-where act) (log-what act))) + (else 'failed)) + (buf-set-undo-log! buf log) + (let ((next-act (car (buf-undo-log buf)))) + (buf-set-undo-log! buf (cdr (buf-undo-log buf))) + (loop (cons next-act redo-log)))) + (begin + (reset-pos buf (log-where act)) + (buf-set-undo-log! buf (cdr (buf-undo-log buf))) + (buf-set-redo-log! buf redo-log) + (slow-mode buf)))))) + +(define (redo-insc buf where what) + (prepare-last-line buf where) + (restore-pos buf where) + (insert-text buf what) + (trim-last-line buf) + (buf-display buf) + 'ok) + +(define (redo-delc buf where what) + (restore-pos buf where) + (delete-by-col buf (buf-x buf) + (+ (buf-x buf) + (string-length what))) + (buf-display buf) + 'ok) + +(define (redo-deln buf where what) + (prepare-last-line buf where) + (restore-pos buf where) + (delete-by-line buf (length what)) + (trim-last-line buf) + (buf-display buf) + 'ok) + +(define (redo-brkl buf where what) + (restore-pos buf where) + (break-line buf)) + +(define (redo-join buf where what) + (restore-pos buf where) + (join-lines buf (- (length what) 2) (car what))) + +(define (redo-repc buf where what) + (restore-pos buf where) + (replace-cols buf (cadr what)) + (buf-display buf)) + +(define (redo buf) + (fast-mode buf) + (let loop ((undo-log (cons (find-NEXT-op (buf-redo-log buf)) + (buf-undo-log buf)))) + (let* ((log (buf-redo-log buf)) + (act (car log))) + (if (not (eq? (log-op act) 'NEXT)) + (begin + (case (log-op act) + ((INSC) (redo-insc buf (log-where act) (log-what act))) + ((DELC) (redo-delc buf (log-where act) (log-what act))) + ((DELN) (redo-deln buf (log-where act) (log-what act))) + ((BRKL) (redo-brkl buf (log-where act) (log-what act))) + ((JOIN) (redo-join buf (log-where act) (log-what act))) + ((REPC) (redo-repc buf (log-where act) (log-what act))) + (else 'failed)) + (buf-set-redo-log! buf log) + (let ((next-act (car (buf-redo-log buf)))) + (buf-set-redo-log! buf (cdr (buf-redo-log buf))) + (loop (cons next-act undo-log)))) + (begin + (reset-pos buf (log-where act)) + (buf-set-redo-log! buf (cdr (buf-redo-log buf))) + (buf-set-undo-log! buf undo-log) + (slow-mode buf)))))) + +(define (undo-mode buf dir) + (buf-modified! buf) + (let loop ((k #\.) + (dir dir)) + (cond ((char=? k #\.) + (if (eq? dir 'undo) + (if (null? (buf-undo-log buf)) + (err buf) + (undo buf)) + (if (null? (buf-redo-log buf)) + (err buf) + (redo buf))) + (loop (get-key buf #t) + dir)) + ((char=? k #\u) + (loop #\. + (if (eq? dir 'undo) + 'redo + 'undo))) + (else + (ungetch (char->integer k)) + dir)))) + +(define (undo-command buf) + (if (and (null? (buf-undo-log buf)) + (null? (buf-redo-log buf))) + (err buf "nothing done yet") + (let ((dir (undo-mode buf (buf-log-dir buf)))) + (buf-set-log-dir! buf (if (eq? dir 'undo) + 'redo + 'undo)) + 'ok))) + +(define (repeat-last buf) + (if (not (buf-lastcmd buf)) + (err buf "nothing to repeat") + (begin (set! *Repeat* #t) + (run-command buf (car (buf-lastcmd buf))) + (set! *Repeat* #f) + 'ok))) + +(define (scheme-pretty-print buf . options) + (real-pos! buf) + (if (or (eqv? LP (buf-cur-char buf)) + (and (eqv? RP (buf-cur-char buf)) + (match-lp buf #f))) + (let ((here (save-pos buf)) + (yy (buf-yanked buf))) + (fast-mode buf) + (if (and (ok? (match-paren buf #f)) + (ok? (delete-region #\% buf here))) + (let ((formatted (apply pp-string (cdr (buf-yanked buf)) + 'indent: (buf-x buf) + options))) + (reset-pos buf here) + (buf-set-yanked! buf yy) + (insert-text buf formatted) + (reset-pos buf here) + (slow-mode buf)) + (buf-set-yanked! buf yy))) + (err buf))) + +(define (send-to-repl s) + (catch-errors #t) + (display s (cadr *Session*)) + (newline (cadr *Session*)) + (catch-errors #f)) + +(define (flush-repl) + (let ((done-magic (string-append "(done " + (number->string (unix-time)) + ")"))) + (send-to-repl + (string-append (string #\newline) + "(newline)" + (string #\newline) + "'" + done-magic)) + (catch-errors #t) + (flush-output-port (cadr *Session*)) + (catch-errors #f) + done-magic)) + +(define (make-reader input-fd) + (let ((buffer #f) + (limit 0) + (next 0)) + (lambda chars-left? + (cond ((not (null? chars-left?)) + (< next limit)) + ((>= next limit) + (let* ((next-buffer (fd-read input-fd 10240)) + (k (string-length next-buffer))) + (if (zero? k) + #f + (begin (set! buffer next-buffer) + (set! limit k) + (set! next 1) + (string-ref buffer 0))))) + (else + (let ((c (string-ref buffer next))) + (set! next (+ 1 next)) + c)))))) + +(define (read-line-from-repl reader) + (letrec + ((collect-chars + (lambda (c s) + (cond ((not c) + (if (null? s) + c + (expand-tabs (list->string (reverse! s))))) + ((char=? c #\newline) + (expand-tabs (list->string (reverse! s)))) + (else + (collect-chars (reader) + (cons c s))))))) + (collect-chars (reader) '()))) + +(define (goto-scmhelp-buffer buf) + (goto-transient-buffer buf + " *Scheme Help* " + bp-tag-scmhelp + (lambda (x) x))) + +(define (discard-magic-newline text) + (if (and (not (null? text)) + (string=? "" (car text))) + (cdr text) + text)) + +(define (user-interrupt?) + (nodelay #t) + (let ((k (getch))) + (nodelay #f) + (eqv? 3 k))) + +(define (get-repl-output buf quiet skip-comments) + (let ((done-magic (flush-repl)) + (reader (make-reader (car *Session*)))) + (info buf "waiting for REPL") + (set! *Message* #f) + (let loop ((output '())) + (cond + ((and (not (reader 'check)) + (not (fd-select (list (buf-val buf bv-repl-timeout) 0) + (list (car *Session*)) + '()))) + (disconnect!) + (err buf "REPL stalled")) + ((user-interrupt?) + (disconnect!) + (err buf "interrupted")) + (else + (let ((s (read-line-from-repl reader))) + (cond ((or (not s) + (string=? done-magic s)) + (if (or (> (length output) 1) + (and (= (length output) 1) + (not (string=? "" (car output))))) + (let ((intbuf (open-scheme-buffer buf)) + (output (discard-magic-newline output))) + (buf-set-y! intbuf (max 0 (- (buf-length intbuf) 1))) + (buf-set-x! intbuf (buf-cur-length intbuf)) + (log-new intbuf) + (fast-mode buf) + (insert-text intbuf (append '("") (reverse! output))) + (slow-mode buf) + (if (and (not quiet) + (not (buf-prop? buf bp-tag-scmint))) + (info buf "REPL output received")))) + (if (not s) + (begin (disconnect!) + (err buf "error(s) found")) + (if *Message* + *Message* + 'ok))) + ((and skip-comments + (> (string-length s) 1) + (char=? #\; (string-ref s 0))) + (loop output)) + (else + (loop (cons s output)))))))))) + +(define (hello-scheme?) + (let* ((magic (flush-repl)) + (k (string-length magic)) + (reader (make-reader (car *Session*)))) + (let ((s (begin (read-line-from-repl reader) + (read-line-from-repl reader)))) + (and (string? s) + (>= (string-length s) k) + (string=? magic (substring s 0 k)))))) + +(define (make-conn fd-conn) + (list (car fd-conn) + (make-output-port (cadr fd-conn)) + (caddr fd-conn))) + +(define (run-scheme-command buf) + (let* ((s (string-parse " " (buf-val buf bv-scheme-repl))) + (path (getenv "PATH")) + (cmd (search-path (car s) (if path path ""))) + (args (cdr s))) + (spawn-command/fd cmd args))) + +(define (reconnect-scheme! buf) + (let ((here (save-pos buf))) + (if (not *Session*) + (begin (catch-errors #t) + (let* ((fd-conn (run-scheme-command buf)) + (e (errno))) + (catch-errors #f) + (if fd-conn + (set! *Session* (make-conn fd-conn))) + (cond ((not fd-conn) + (err buf (format #f "failed to start Scheme: ~A" + (errno->string e))) + #f) + ((begin (send-to-repl (buf-val buf bv-scheme-init)) + (hello-scheme?)) + (let ((r (scheme-autoload buf))) + (restore-pos buf here) + (ok? r))) + (else + (disconnect!) + (err buf (string-append + "failed to start Scheme" + " (check \"scheme-repl\" option)")) + #f)))) + #t))) + +(define (scheme-reload buf) + (let* ((code-marker (buf-val buf bv-code-marker)) + (cm-re (or (re-comp code-marker) + (begin (err "bad RE in \"code-marker\" option") + ""))) + (docmode (not (string=? "" code-marker))) + (send (not docmode))) + (cond ((reconnect-scheme! buf) + (info buf "reloading...") + (let loop ((i 0) + (k (buf-length buf))) + (cond ((and docmode + (< i k) + (re-match cm-re (buf-line buf i))) + (set! send (not send)) + (loop (+ 1 i) k)) + ((< i k) + (if send + (send-to-repl (buf-line buf i))) + (loop (+ 1 i) k)) + ((ok? (get-repl-output buf #t #t)) + (info buf "reloaded") + 'ok) + (else + 'failed)))) + (else + 'failed)))) + +(define (scheme-autoload buf) + (let loop ((b* *Buffers*)) + (cond ((null? b*) + 'ok) + ((and (not (eq? buf (car b*))) + (buf-prop? (car b*) bp-autoload)) + (info buf (format #f "auto-loading ~A" (buf-name buf))) + (if (ok? (scheme-reload (car b*))) + (loop (cdr b*)) + (err buf *Message*))) + (else + (loop (cdr b*)))))) + +(define (find-definition buf) + (let ((here (save-pos buf))) + (let loop () + (cond ((and (>= (- (buf-cur-length buf) (buf-x buf)) 8) + (string=? "(define " (substring (buf-cur-line buf) ; #\) + (buf-x buf) + (+ (buf-x buf) 8)))) + (let ((defn (save-pos buf))) + (if (ok? (match-rp buf #f)) + (begin (restore-pos buf defn) + #t) + (begin (restore-pos buf here) + #f)))) + ((ok? (move-prev-expr buf 1)) + (loop)) + (else + (restore-pos buf here) + #f))))) + +(define (pass-to-scheme buf begin-msg end-msg) + (info buf begin-msg) + (if (char=? RP (buf-cur-char buf)) + (match-lp buf #f)) + (let ((origin (save-pos buf)) + (yy (buf-yanked buf))) + (match-rp buf #f) + (yank-region #\% buf origin) + (for-each send-to-repl + (cdr (buf-yanked buf))) + (if (ok? (get-repl-output buf #f #f)) + (info buf end-msg)) + (buf-set-yanked! buf yy))) + +(define (scheme-recompile buf) + (let ((here (save-pos buf)) + (res 'ok)) + (fast-mode buf) + (cond ((and (reconnect-scheme! buf) + (find-definition buf)) + (pass-to-scheme buf "compiling..." "compiled")) + (else + (set! res 'failed))) + (restore-pos buf here) + (slow-mode buf) + res)) + +(define (scheme-eval buf) + (let ((here (save-pos buf)) + (res 'ok)) + (fast-mode buf) + (cond ((and (reconnect-scheme! buf) + (buf-cur-char buf) + (memv (buf-cur-char buf) (list LP RP))) + (pass-to-scheme buf "eval..." "done")) + (else + (set! res 'failed))) + (restore-pos buf here) + (slow-mode buf) + res)) + +(define (scheme-help buf) + (let ((help-path (find-help-path))) + (if (not help-path) + (err buf "help pages not found") + (let ((pos2 (extract-ident buf))) + (if (not pos2) + (err buf) + (let* ((topic (apply substring (buf-cur-line buf) pos2)) + (path (string-append help-path + "/" + (string-downcase + (name->file-name topic))))) + (if (not (file-exists? path)) + (err buf (format #f "~A: no help page found" topic)) + (let ((helpbuf (goto-scmhelp-buffer buf))) + (buf-load! helpbuf path) + (buf-set-name! helpbuf " *Scheme Help* ") + (set! *Help-Stack* (cons (cons path (save-pos helpbuf)) + *Help-Stack*)) + (goto-line helpbuf 0) + helpbuf)))))))) + +(define (scheme-prev-help buf) + (cond ((or (null? *Help-Stack*) + (null? (cdr *Help-Stack*))) + (err buf "no previous topic")) + ((not (buf-prop? buf bp-tag-scmhelp)) + (err buf "not in Scheme help buffer")) + (else + (buf-load! buf (car (cadr *Help-Stack*))) + (buf-set-name! buf " *Scheme Help* ") + (restore-pos buf (cdr (car *Help-Stack*))) + (set! *Help-Stack* (cdr *Help-Stack*)) + (buf-display buf) + 'ok))) + +(define (scheme-new-repl buf) + (if *Session* + (disconnect!)) + (if (reconnect-scheme! buf) + (info buf "new REPL"))) + +(define (scheme-add-completion-symbol buf) + (let ((pos2 (extract-ident buf))) + (if (not pos2) + (err buf) + (set! *Completion-symbols* + (sort string-ciinteger k))))))) + +(define (visual-expression buf) + (real-pos! buf) + (let ((parens (make-hash-table)) + (pos (save-pos buf))) + (buf-set-x! buf 0) + (buf-set-y! buf (buf-top buf)) + (let loop ((level 0)) + (cond ((or (> (buf-y buf) (saved-y pos)) + (and (= (buf-y buf) (saved-y pos)) + (> (buf-x buf) (saved-x pos)))) + (reset-pos buf pos) + (highlight-expr buf (hash-table-ref parens (- level 1)))) + ((eqv? LP (buf-cur-char buf)) + (hash-table-set! parens level (save-pos buf)) + (advance buf) + (loop (+ 1 level))) + ((eqv? RP (buf-cur-char buf)) + (advance buf) + (loop (- level 1))) + (else + (advance buf) + (loop level)))))) + +(define (test buf) + (clear) + (mvaddstr 0 0 (format #f "~S" (buf-lastcmd buf))) + (getch) + (clear) + (buf-display buf) + (buf-status buf)) + +(define (other-command buf k c) + (let ((nc (if c c 1))) + (cond ((char=? k ^B) (move-ppage buf nc)) + ((char=? k ^D) (scroll-down buf c)) + ((char=? k ^F) (move-npage buf nc)) + ((char=? k ^G) (long-status buf)) + ((char=? k ^L) (repaint buf)) + ((char=? k ^R) (repaint buf)) + ((char=? k ^T) (test buf)) + ((char=? k ^U) (scroll-up buf c)) + ((char=? k ESC) (err buf)) + ((char=? k #\!) (filter-command buf)) + ((char=? k #\.) (repeat-last buf)) + ((char=? k #\<) (in/outdent-command buf c #\<)) + ((char=? k #\>) (in/outdent-command buf c #\>)) + ((char=? k #\~) (change-case-command buf c)) + ((char=? k #\m) (set-mark buf)) + ((char=? k #\u) (undo-command buf)) + ((char=? k #\v) (visual-expression buf)) + ((char=? k #\y) (yank-from-here buf nc)) + ((char=? k #\z) (center-command buf c)) + ((char=? k #\Y) (yank-to-eol buf)) + (else 'no)))) + +(define (in? x set) + (and (not (null? x)) + (memv (car x) set) + #t)) + +(define digits '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\. #\' #\$)) +(define pos-set (append digits '(#\' #\$))) + +(define (parse-pos buf in) + (cond ((in? in '(#\')) + (if (and (buf-mark buf) + (in? (cdr in) '(#\m))) + (list (car (buf-mark buf)) (cddr in)) + (list #f #f))) + ((in? in '(#\$)) + (list (end-of-buffer buf) (cdr in))) + ((in? in '(#\.)) + (list (buf-y buf) (cdr in))) + (else + (let loop ((in in) + (out '())) + (if (in? in digits) + (loop (cdr in) + (cons (car in) out)) + (list (let ((n (string->number + (list->string (reverse! out))))) + (if n (- n 1) n)) + in)))))) + +(define (parse-op buf in) + (let loop ((in in) + (out '())) + (cond ((and (not (null? in)) + (char-alphabetic? (car in))) + (loop (cdr in) (cons (car in) out))) + ((and (not (null? in)) + (char=? #\space (car in))) + (list (list->string (reverse! out)) + (cdr in))) + ((not (null? in)) + (list (list->string (reverse! (cons (car in) out))) + (cdr in))) + (else + (list (list->string (reverse! out)) + in))))) + +(define (colon-quit buf yes!) + (cond ((and (buf-modified? buf) + (not yes!)) + (err buf (string-append "buffer modified but not saved!" + " :w = write, :q! = quit anyway"))) + ((and (unsaved-buffers? buf) + (not yes!)) + (err buf (string-append "there are unsaved buffers!" + " :wall = write all, :q! = quit anyway"))) + (else + (quit)))) + +(define (colon-write buf yes! from to file) + (cond ((null? file) + (cond ((not (buf-name buf)) + (err buf + "buffer has no name! use \":w name\" to supply one")) + ((buf-transient? buf) + (err buf "buffer is transient!")) + ((and (zero? from) + (= to (end-of-buffer buf))) + (buf-save! buf yes!) + 'ok) + (yes! + (buf-write! buf (buf-name buf) from to) + 'ok) + (else + (err buf (string-append "partial file not written! use :w!" + " if you are sure"))))) + ((> (length file) 1) + (err buf "too many file names")) + ((and (not yes!) + (file-exists? (car file))) + (err buf "file exists! use :w! to overwrite")) + (else + (buf-write! buf (car file) from to) + (if (and (not (buf-name buf)) + (zero? from) + (= to (- (buf-length buf) 1))) + (begin (buf-set-name! buf (car file)) + (buf-rem-prop! buf bp-modified))) + 'ok))) + +(define (colon-write-all buf yes!) + (let ((failed #f) + (written 0)) + (for-each (lambda (x) + (if (and (not failed) + (buf-modified? x)) + (case (buf-save! x yes!) + ((failed) (set! failed #t)) + ((ok) (set! written (+ 1 written)))))) + *Buffers*) + (info buf (format #f "~D buffer~:P written" written)) + buf)) + +(define (colon-read buf file) + (real-pos! buf) + (cond ((null? file) + (err buf "missing file name")) + ((> (length file) 1) + (err buf "too many file names")) + ((not (file-exists? (car file))) + (err buf (string-append (car file) ": cannot open file"))) + (else + (buf-modified! buf) + (let ((text (map expand-tabs + (with-input-from-file + (car file) + read-file)))) + (buf-set-y! buf (+ 1 (buf-y buf))) + (log-new buf) + (let ((pos (save-pos buf))) + (insert-text buf (append text '(""))) + (restore-pos buf pos) + 'ok))))) + +(define (timestamp time) + (if (> (- (unix-time) time) 86400) + (format-time "~4y-~2:m-~2d" + (unix-time->time time)) + (format-time " ~2h:~2m:~2s" + (unix-time->time time)))) + +(define (fill-dir-buffer dir path) + (catch-errors #t) + (let* ((files (read-directory path)) + (files (and files + (cons ".." (sort stringstring (errno)))) + (let loop ((y 0) + (files files)) + (if (null? files) + (begin (buf-set-length! dir y) + (info dir #f) + 'ok) + (let* ((file (string-append path "/" (car files))) + (stat (stat-file file)) + (desc (format #f "~C~A ~A ~8D ~A" + (if (directory? file) + #\d + #\-) + (mode->string (cdr (assq 'mode stat))) + (timestamp (cdr (assq 'mtime stat))) + (cdr (assq 'size stat)) + (basename file)))) + (if (zero? (remainder y 10)) + (info dir (format #f "loading: ~D" y))) + (insert-into-buf! dir y desc) + (loop (+ 1 y) (cdr files)))))))) + +(define (dir-browser buf path) + (let ((res #f) + (dir (new-buffer (append (clean-up-props buf) + (list bp-transient + bp-readonly)) + (buf-values buf)))) + (mode dir "directory browser") + (let loop ((refill path)) + (if refill + (if (ok? (fill-dir-buffer dir refill)) + (begin (set! path refill) + (buf-set-y! dir 0) + (buf-set-top! dir 0) + (buf-display dir)))) + (buf-set-name! dir path) + (buf-status dir) + (sync dir #f) + (so dir) + (mvaddstr (screen-line dir) + 0 + (clip-right (buf-cur-line dir) (cols))) + (let ((kc (get-cmd dir))) + (sync dir #f) + (se dir) + (mvaddstr (screen-line dir) + 0 + (clip-right (buf-cur-line dir) (cols))) + (cond ((or (char=? (car kc) ESC) + (char=? (car kc) #\q)) + (set! res #f)) + ((char=? (car kc) CR) + (let ((d (buf-char dir 0)) + (name (last (string-parse " " (buf-cur-line dir))))) + (cond ((string=? ".." name) + (loop (dirname path))) + ((char=? d #\d) + (loop (string-append path "/" name))) + (else + (set! res (string-append path "/" name)))))) + ((char=? (car kc) ^F) + (move-npage dir 1) + (loop #f)) + ((char=? (car kc) ^B) + (move-ppage dir 1) + (loop #f)) + ((char=? (car kc) ^L) + (clear) + (buf-display dir) + (loop #f)) + ((char=? (car kc) ^G) + (long-status dir) + (buf-display dir) + (loop #f)) + ((not (eq? 'no (apply motion-command dir kc))) + (loop #f)) + (else + (err dir + (string-append + "usage: = move cursor" + " CR = select ESC,q = quit")) + (loop #f))))) + (delete-buffer dir) + (command-mode buf) + (buf-display buf) + (buf-status buf) + res)) + +(define (colon-edit buf yes! file) + (cond ((null? file) + (if (and (buf-modified? buf) + (not yes!)) + (err buf "buffer is modified! save with :w or discard with :e!") + (let ((file (dir-browser buf (getcwd)))) + (if file + (colon-edit buf yes! (list file)) + 'failed)))) + ((> (length file) 1) + (err buf "too many file names")) + ((and (buf-modified? buf) + (not yes!)) + (err buf "buffer is modified! save with :w or discard with :e!")) + (else + (buf-set-x! buf 0) + (buf-set-y! buf 0) + (buf-set-length! buf 0) + (vector-fill! (buf-buffer buf) "") + (cond ((file-exists? (car file)) + (buf-rem-prop! buf bp-transient) + (buf-rem-prop! buf bp-readonly) + (buf-load! buf (car file))) + (else + (info buf (format #f "~A: new file" (car file))))) + (buf-rem-prop! buf bp-modified) + (buf-display buf) + 'ok))) + +(define (colon-shell buf cmd) + (move 0 0) + (deleteln) + (move (text-lines) 0) + (refresh) + (endwin) + (catch-errors #t) + (run-shell-command cmd) + (catch-errors #f) + (display "Press ENTER to return to ARSE: ") + (flush-output-port) + (read-line) + (initscr) + (raw) + (noecho) + (nonl) + (buf-status buf) + (buf-display buf) + 'ok) + +(define (colon-exit buf yes!) + (if (buf-modified? buf) + (buf-save! buf yes!)) + (if (not (buf-modified? buf)) + (quit) + 'failed)) + +(define (colon-help buf) + (let ((helpfile (locate-file "arse.help"))) + (if (not helpfile) + (err buf "could not locate help file") + (goto-transient-buffer buf + #f + bp-tag-help + (lambda (new) + (buf-load! new helpfile) + (buf-set-name! new " *Help* ")))))) + +(define (list-buffers buf) + (let ((n 1)) + (start-info buf) + (for-each (lambda (x) + (addstr (format #f "~D: ~5D ~C ~S" + n + (buf-length x) + (cond ((buf-modified? x) #\M) + ((buf-transient? x) #\T) + (else #\space)) + (if (buf-name x) + (buf-name x) + '*anonymous*))) + (crlf) + (set! n (+ 1 n))) + *Buffers*) + (end-info buf))) + +(define (buffer-open buf args) + (if (not (= (length args) 2)) + (err buf "usage: buffer open #") + (let ((n (string->number (cadr args)))) + (if (and n (<= 1 n (length *Buffers*))) + (let* ((nb (list-ref *Buffers* (- n 1))) + (b (cons nb (remq nb *Buffers*)))) + (set! *Buffers* b) + nb) + (err buf "~A: no such buffer" (cadr args)))))) + +(define (small-buffers buf) + (list (buf-yanked buf) + (buf-searchbuf buf) + (buf-revsearch buf))) + +(define (set-small-buffers! buf sb) + (buf-set-yanked! buf (car sb)) + (buf-set-searchbuf! buf (cadr sb)) + (buf-set-revsearch! buf (caddr sb))) + +(define (copy-globals src dest) + (for-each (lambda (prop) + (if (buf-prop? src prop) + (buf-add-prop! dest prop) + (buf-rem-prop! dest prop))) + (list bp-saveintbuf + bp-sharebuffers))) + +(define (buffer-switch how buf) + (let ((sb (small-buffers buf))) + (if (null? (cdr *Buffers*)) + (err buf "there is only one buffer!") + (let ((new (how))) + (copy-globals buf new) + (if (buf-prop? buf bp-sharebuffers) + (set-small-buffers! new sb)) + new)))) + +(define (buffer-rotate buf) + (buffer-switch rotate-buffers! buf)) + +(define (buffer-swap buf) + (buffer-switch swap-buffers! buf)) + +(define (colon-buffer buf args) + (if (null? args) + (err buf "usage: buffer command ...") + (cond ((member (car args) '("c" "close")) + (cond ((null? (cdr *Buffers*)) + (err buf "there is only one buffer!")) + ((buf-modified? buf) + (err buf + (string-append "buffer is unsaved! use :w to save" + "it or :bc! to close it anyway"))) + (else + (delete-buffer buf)))) + ((member (car args) '("c!" "close!")) + (cond ((null? (cdr *Buffers*)) + (err buf "there is only one buffer!")) + (else + (delete-buffer buf)))) + ((member (car args) '("l" "list")) + (list-buffers buf)) + ((member (car args) '("n" "new")) + (new-buffer (clean-up-props buf) (buf-values buf))) + ((member (car args) '("o" "open")) + (buffer-open buf args)) + ((member (car args) '("r" "rotate")) + (buffer-rotate buf)) + ((member (car args) '("s" "swap")) + (buffer-swap buf)) + (else + (err buf "~A: buffer: unknown sub-command" (car args)))))) + +(define (string-subst buf s p0 old new flags) + (let* ((ko (string-length old)) + (kn (string-length new)) + (ks (string-length s)) + (u (and (< (+ p0 ko) ks) + (string-pos buf old (substring s p0 ks))))) + (if u + (let* ((u (+ p0 u)) + (n (string-append (substring s 0 u) + new + (substring s (+ u ko) ks)))) + (if (memv #\g (string->list flags)) + (string-subst buf n (- (+ 1 u kn) ko) old new flags) + n)) + s))) + +(define (regex-subst buf s cre new flags) + (let ((new (apply re-subst cre s new flags))) + (if new new s))) + +(define (subst-block buf text old new flags) + (let ((cre (if (buf-prop? buf bp-regex) + (re-comp old) + #t)) + (opts (if (memv #\g (string->list flags)) + '(all) + '()))) + (if (not cre) + (begin (err buf "invalid regular expression") + text) + (map (lambda (x) + (if (buf-prop? buf bp-regex) + (regex-subst buf x cre new opts) + (string-subst buf x 0 old new flags))) + text)))) + +(define (substitute buf from to op args) + (real-pos! buf) + (buf-modified! buf) + (let* ((flag-ch* '(#\g)) + (dlm (string-ref op (- (string-length op) 1))) + (args (string-split dlm args)) + (old (if (null? args) + #f + (car args))) + (new (if (< (length args) 2) + "" + (cadr args))) + (flags (if (< (length args) 3) + "" + (caddr args))) + (flags-ok (not (memq #f (map (lambda (x) + (memv x flag-ch*)) + (string->list flags)))))) + (if (or (not old) + (not flags-ok) + (string=? "" old) + (> (length args) 3)) + (err buf "usage: []s//[/][g]") + (change-block buf from to subst-block old new flags)))) + +(define (colon-version buf) + (start-info buf) + (addstr "ARSE is a Recursive Scheme Editor") + (addstr " (beta version, expect bugs!)") + (crlf) + (end-info buf)) + +(define (set-boolean-option buf opt args) + (if (not (= 1 (length args))) + (err buf (format #f "usage: :set [no]~A" (car (pt-names opt)))) + (let* ((no (and (= (length args) 1) + (>= (string-length (car args)) 2) + (string=? "no" (substring (car args) 0 2)))) + (setr (if no + buf-rem-prop! + buf-add-prop!)) + (args (cdr args))) + (setr buf (pt-prop opt))))) + +(define (extract-string-arg s) + (let* ((s (substring s + (+ 1 (string-position "=" s)) + (string-length s))) + (k (string-length s)) + (s (if (and (positive? k) + (char=? #\" (string-ref s 0)) + (char=? #\" (string-ref s (- k 1)))) + (substring s 1 (- k 1)) + s))) + s)) + +(define (set-option-value buf opt args s-arg) + (if (not (= 2 (length args))) + (err buf (format #f "usage: :set ~A=value" (car (pt-names opt)))) + (let ((val (case (pt-type opt) + ((integer) + (cond ((string->number (cadr args)) + => (lambda (x) x)) + (else + (err buf (format #f "~A: number expected" + (car (pt-names opt))))))) + (else + (extract-string-arg s-arg))))) + (if (failed? val) + val + (begin (buf-set-val! buf (pt-prop opt) val) + (if (eq? 'string (pt-type opt)) + 'done + 'ok)))))) + +(define (set-option-2 buf args str-arg) + (let ((name (car args))) + (let loop ((p *val-table*)) + (cond ((null? p) + (err buf "~A: unknown option" name)) + ((member name (pt-names (car p))) + (set-option-value buf (car p) args str-arg)) + (else + (loop (cdr p))))))) + +(define (set-option buf args str-arg) + (let* ((args (string-split #\= args)) + (name (car args))) + (let loop ((p *prop-table*)) + (cond ((null? p) + (set-option-2 buf args str-arg)) + ((or (member name (pt-names (car p))) + (and (> (string-length name) 2) + (string=? "no" (substring name 0 2)) + (member (substring name 2 (string-length name)) + (pt-names (car p))))) + (set-boolean-option buf (car p) args) + 'ok) + (else + (loop (cdr p))))))) + +(define (list-options buf) + (start-info buf) + (let* ((options (split *prop-table*)) + (opts1 (car options)) + (opts2 (if (< (length (cadr options)) + (length (car options))) + (append (cadr options) '(#f)) + (cadr options)))) + (for-each (lambda (x1 x2) + (addstr + (if x2 + (format #f "~A~30A~A~A" + (if (not (buf-prop? buf (pt-prop x1))) + "no" + " ") + (car (pt-names x1)) + (if (not (buf-prop? buf (pt-prop x2))) + "no" + " ") + (car (pt-names x2))) + (format #f "~A~A" + (if (not (buf-prop? buf (pt-prop x1))) + "no" + " ") + (car (pt-names x1))))) + (crlf)) + opts1 + opts2)) + (for-each (lambda (x) + (let ((s (format #f (if (eq? 'integer (pt-type x)) + "~A=~A" + "~A=\"~A\"") + (car (pt-names x)) + (buf-val buf (pt-prop x))))) + (addstr s) + (crlf))) + *val-table*) + (end-info buf) + 'ok) + +(define (colon-set buf all-args) + (if (and (string? all-args) + (string=? "all" all-args)) + (list-options buf) + (let ((args (string-parse " " all-args))) + (let loop ((args args)) + (if (null? args) + 'ok + (case (set-option buf (car args) all-args) + ((ok) (loop (cdr args))) + ((done) 'ok) + ((failed) 'failed))))))) + +(define (extract-symbols-from-file path) + (with-input-from-file + path + (lambda () + (let loop ((line (read-line)) + (syms '())) + (if (or (eof-object? line) + (string=? "" line)) + (if (null? syms) + '() + (reverse! (list->set syms))) + (let* ((s* (string-split LP line)) + (s* (if (> (length s*) 1) + (cadr s*) + "")) + (s* (string-parse (string #\space RP) s*)) + (s* (if (not (null? s*)) + (car s*) + ""))) + (loop (read-line) (cons s* syms)))))))) + +(define (find-completion-symbols) + (let* ((hpath (find-help-path)) + (files (if hpath + (sys:readdir hpath) + '())) + (files (apply append + (map (lambda (x) + (let ((file (string-append hpath "/" x))) + (if (sys:lstat-regular? file) + (list x) + '()))) + files))) + (topics (apply append + (map (lambda (file) + (extract-symbols-from-file + (string-append hpath "/" file))) + files))) + (topics (remove "" (sort string-ci<=? topics)))) + topics)) + +(define (make-completion-symbols) + (let* ((home (getenv "HOME")) + (syms (if home (find-completion-symbols))) + (path (if home (string-append home "/.arse.symbols")))) + (catch-errors #t) + (if home + (begin (if (file-exists? path) + (remove-file path)) + (with-output-to-file + path + (lambda () + (set! *Completion-symbols* syms) + (for-each (lambda (x) + (display x) + (newline)) + *Completion-symbols*))))) + (catch-errors #f))) + +(define (colon-rehash buf) + (info buf "collecting completion symbols...") + (make-completion-symbols) + (info buf (format #f "rehashed ~A symbols" + (length *Completion-symbols*)))) + +(define (colon-command buf) + (let ((cmd (get-line (text-lines) buf ":" #f)) + (s-cmds '("s/" "s|" "s,"))) + (if (not cmd) + buf + (let* ((next (string->list cmd)) + (next (if (in? next pos-set) + (parse-pos buf next) + (list #f next))) + (bgn (if (in? (cadr next) '(#\%)) + 0 + (car next))) + (next (if (in? (cadr next) '(#\,)) + (parse-pos buf (cdadr next)) + (list #f (cadr next)))) + (end (if (in? (cadr next) '(#\%)) + (end-of-buffer buf) + (car next))) + (next (if (in? (cadr next) '(#\%)) + (list #f (cdadr next)) + (list #f (cadr next)))) + (next (parse-op buf (cadr next))) + (op (car next)) + (rarg (if (member op s-cmds) + (list->string (cadr next)) + (trim-left (list->string (cadr next))))) + (args (string-parse " " (list->string (cadr next))))) + (let ((bgn (if bgn + bgn + (if (member op s-cmds) + (buf-y buf) + 0))) + (end (if end + end + (if bgn + bgn + (if (member op s-cmds) + (buf-y buf) + (end-of-buffer buf)))))) + (if (> bgn end) + (swap! bgn end)) + (cond ((string=? op "") + 'ok) + ((member op '("!")) + (colon-shell buf rarg)) + ((member op '("b" "buf" "buffer")) + (colon-buffer buf args)) + ((member op '("bc")) + (colon-buffer buf '("c"))) + ((member op '("bc!")) + (colon-buffer buf '("c!"))) + ((member op '("bl")) + (colon-buffer buf '("l"))) + ((member op '("bn")) + (colon-buffer buf '("n"))) + ((member op '("br")) + (colon-buffer buf '("r"))) + ((member op '("bs")) + (colon-buffer buf '("s"))) + ((member op '("bo")) + (colon-buffer buf (cons "o" args))) + ((member op '("e" "edit")) + (colon-edit buf #f args)) + ((member op '("e!" "edit!")) + (colon-edit buf #t args)) + ((member op '("h" "help")) + (colon-help buf)) + ((member op '("q" "quit")) + (colon-quit buf #f)) + ((member op '("q!" "quit!")) + (colon-quit buf #t)) + ((member op '("r" "read")) + (colon-read buf args)) + ((member op '("rehash")) + (colon-rehash buf)) + ((member op s-cmds) + (substitute buf bgn end op rarg)) + ((member op '("set")) + (colon-set buf rarg)) + ((member op '("ver" "version")) + (colon-version buf)) + ((member op '("wall" "writeall")) + (colon-write-all buf #f)) + ((member op '("wall!" "writeall!")) + (colon-write-all buf #t)) + ((member op '("w" "write")) + (colon-write buf #f bgn end args)) + ((member op '("w!" "write!")) + (colon-write buf #t bgn end args)) + ((member op '("x" "xit")) + (colon-exit buf #f)) + ((member op '("x!" "xit!")) + (colon-exit buf #t)) + (else + (err buf (string-append + ":" + op + ": unknown command" + " -- type :h for help"))))))))) + +(define (buffer-command buf k c) + (let ((nc (if c c 1))) + (cond ((char=? k TAB) (buffer-rotate buf)) + ((char=? k ^^) (buffer-swap buf)) + ((char=? k #\:) (colon-command buf)) + ((char=? k #\=) (scheme-interface buf)) + ((char=? k #\Z) (save+exit buf)) + (else 'no)))) + +(define (run-command buf kc) + (or (not (eq? 'no (apply motion-command buf kc))) + (not (eq? 'no (apply insdel-command buf kc))) + (not (eq? 'no (apply other-command buf kc))) + (let ((retval (apply buffer-command buf kc))) + (and (not (eq? 'no retval)) + retval)) + (err buf "~A: unknown command -- type :h for help" + (unctrl (char->integer (car kc)))))) + +(define (command-loop buf repaint) + (if repaint + (buf-display buf)) + (buf-status buf) + (let ((val (run-command buf (get-cmd buf)))) + (cond ((eq? val 'quit) (if #f #f)) + ((vector? val) (command-loop val #t)) + (else (command-loop buf #f))))) + +(define (edit buf) + (command-loop buf #t)) + +(define (read-config! buf) + (let ((home (getenv "HOME"))) + (if home + (let ((dotfile (string-append home "/.arserc"))) + (if (file-readable? dotfile) + (let loop ((in (with-input-from-file dotfile read-file))) + (cond ((null? in)) + ((string=? "" (car in)) + (loop (cdr in))) + ((char=? #\; (string-ref (car in) 0)) + (loop (cdr in))) + ((eq? 'ok (set-option buf + (car (string-split #\space + (car in))) + (car in))) + (loop (cdr in))) + (else + (buf-status buf) + (getch) + (loop (cdr in)))))))))) + +(define (load-completion-symbols) + (let* ((home (getenv "HOME")) + (path (if home (string-append home "/.arse.symbols")))) + (if (and home (file-exists? path)) + (set! *Completion-symbols* + (with-input-from-file path read-file))))) + +(define (arse . args) + (initscr) + (raw) + (noecho) + (nonl) + (idlok #t) + (scrollok #f) + (keypad #t) + (let* ((name (if (null? args) + #f + (car args))) + (options (if (null? args) + '() + (cdr args)))) + (let ((buf (new-buffer)) + (options (apply append (map string->list options)))) + (buf-add-prop! buf bp-autoload) + (read-config! buf) + (load-completion-symbols) + (set! *default-prop* (buf-prop buf)) + (if (memv #\r options) + (buf-add-prop! buf bp-readonly)) + (if name + (if (not (buf-load! buf name)) + (begin (buf-set-name! buf name) + (info buf "new file"))) + (info buf (string-append "Welcome to ARSE! This is a beta version," + " expect bugs! Type :h for help"))) + (edit buf)))) diff -Nru scheme9-2009.09.06/contrib/c2html.scm scheme9-2010.11.13/contrib/c2html.scm --- scheme9-2009.09.06/contrib/c2html.scm 1970-01-01 00:00:00.000000000 +0000 +++ scheme9-2010.11.13/contrib/c2html.scm 2010-09-11 15:53:18.000000000 +0000 @@ -0,0 +1,483 @@ +; Scheme 9 from Empty Space, Function Library +; By Nils M Holm, 2010 +; See the LICENSE file of the S9fES package for terms of use +; +; (c2html