wh me=Beginning installation of lib-edit... @prog lib-edit 1 99999 d 1 i ( lib-edit: $Date: 2008/09/25 17:08:03 $ $Revision: 1.21 $ ) ( Purpose: Provides editing routines for stack based string ranges ) ( Author: Unknown ) ( Contributors: Andy, Feaelin ) ( Dependencies: lib-strings, lib-stackrng ) ( --------------------------------------------------------------------------- ) ( Stack Based String Range Editing Routines ) ( 'start', 'end', 'pos' are all relative to the start of the range that is ) ( towards the bottom of the stack. A 1 means the first item of the range; the ) ( the item deepest in the stack. 'offset' is the number of stack items ) ( between the top of the string range and the bottom parameter. ) ( ) ( EDIT-ansi_display: {range} -- ) ( Replicates EDITdisplay except that it displays in color. ) ( ) ( EDIT-ansi_list: {range} ... offset nums? start end -- {range} ... ) ( Replicates the functionality of EDITlist but displays in color. ) ( ) ( EDIT-center: {range} ... offset cols start end -- {range'} ... ) ( Center justify all the given lines within a string range. ) ( ) ( EDIT-color: {range} ... offset cols start end newcol -- {range'} ... ) ( Prepends or replaces previously prepended color code on each line within ) ( a given string range. ) ( ) ( EDIT-copy: {range} ... offset dest start end -- {range'} ... ) ( Copies text within a string range from one line to another, inserting it ) ( in the new location. ) ( ) ( EDIT-display: {range} -- ) ( displays the range of strings on the stack to the user. ) ( ) ( EDIT-fmt_rng: {range} ... offset cols start end -- {range'} ... ) ( Formats the given subrange in the string range to COLS columns. This is ) ( is similar to the UNIX format command, in that it splits long lines and ) ( joins short lines. A line that contains only spaces is considered a ) ( paragraph delimiter, and is not joined. ) ( ) ( EDIT-format: {range} splitchars rmargin wrapmargin -- {range'} ) ( Takes a range and formats it similarly to the way that the UNIX fmt ) ( command would, splitting long lines, and joining short ones. ) ( ) ( EDIT-indent: {range} ... offset cols start end -- {range'} ... ) ( Indents all the given lines in a string range by COLS spaces. if COLS is ) ( a negative integer, it undents by that many spaces. It will never undent ) ( past left justification. ) ( ) ( EDIT-join: {range} -- string ) ( Join a range of strings on the stack into one string. ) ( ) ( EDIT-join_rng: {range} ... offset start end -- {range'} ... ) ( Joins all the given lines in the string range together, and returns the ) ( string range that results. ) ( ) ( EDIT-left: {range} ... offset start end -- {range'} ... ) ( Left justify all the given lines within a string range. ) ( ) ( EDIT-list: {range} ... offset nums? start end -- {range} ... ) ( Lists the given set of lines within a string range, with an int telling ) ( it to prepending each line with a number and a colon. For example: ) ( "8: line eight." ) ( ) ( EDIT-move: {range} ... offset dest start end -- {range'} ... ) ( Moves text within a string range from one line to another location, ) ( deleting the original. ) ( ) ( EDIT-replace: {range} ... offset oldstr newstr start end -- {range'} ... ) ( Searches the range of strings for all occurences of a case sensitive ) ( substring, and replaces them with new text. ) ( ) ( EDIT-right: {range} ... offset cols start end -- {range'} ... ) ( Right justify all the given lines within a string range. ) ( ) ( EDIT-search: {range} ... offset string start -- {range} ... pos ) ( Searches a range of strings for the first occurence of a substring. This ) ( is case sensitive, and returns the line number of the first occurence ) ( ) ( EDIT-shuffle: {range} -- {range'} ) ( Take a range of items on the stack and randomize their order. ) ( ) ( EDIT-sort: {range} ascending? CaseSensitive? -- {range'} ) ( Alphabetically sorts strings with integers telling it whether to sort in ) ( ascending or decending order, and if it should be case sensitive. ) ( ) ( EDIT-split: string splitchars rmargin wrapmargin -- {range} ) ( splits a string up into several lines in a range. The criterion for where ) ( to split each line are as follows: It splits at the last split character ) ( it can find between the rmargin and the wrapmargin. If it cannot find one,) ( then it splits at the rmargin. ) ( --------------------------------------------------------------------------- ) ( $Log: lib-edit,v $ Revision 1.21 2008/09/25 17:08:03 feaelin Bad indentation. Revision 1.20 2006/07/24 13:36:07 feaelin Missing 'then' in EDITdisplay Revision 1.19 2006/07/17 17:49:43 feaelin Better error checking for EDITdisplay Revision 1.18 2006/07/10 03:21:17 feaelin Fine tuned the error-checking EDIT-ansi_display. Revision 1.17 2006/07/10 03:06:51 feaelin Added error checking for EDIT-ansi_display Revision 1.16 2005/09/25 13:31:43 feaelin Documentation update. Revision 1.15 2005/04/07 21:19:48 feaelin Added Library Symbols Revision 1.14 2005/04/05 21:01:48 feaelin Corrected misspelled library calls Revision 1.13 2005/04/05 16:22:57 feaelin Fixed library calls to lib-strings and lib-stackrng Revision 1.12 2005/04/05 15:51:48 feaelin Added word aliases for library words to fit the new standard. Revision 1.11 2005/04/04 14:11:51 feaelin Documentation updated. Removed extraneous whitespace. Removed unnecessary call to lib-glow-standard Revision 1.10 2005/03/21 01:31:42 feaelin General maintenance and documentation updates Revision 1.9 2005/01/18 16:23:46 feaelin Corrected problem that would crash the editor when formatting lines with ANSI codes in them. Revision 1.8 2004/04/03 05:09:00 feaelin Fixed .split and .format so that they preserve color on lines that they split Revision 1.7 2004/04/01 05:39:12 feaelin Added feature which allows the user to prepend each line in a range with a color code. Updated documentation for recent changes. Revision 1.6 2004/02/27 17:36:40 feaelin Fixed format and right justify to be ansi_aware. Revision 1.5 2004/02/20 17:08:44 feaelin Added ansi versions of EDITdisplay and EDITlist, EDITansi_display and EIDTansi_list respectively. Revision 1.4 2000/01/10 20:54:44 feaelin Minor documentation fixes. Revision 1.3 1998/07/29 17:24:16 feaelin Put back in a missing 'swap' in EDITjoin. Revision 1.2 1998/07/29 16:47:50 feaelin Cleaned up documentation. ) ( --------------------------------------------------------------------------- ) ( Previous change by Andy from FB's version is a $ifdef to check to see if ) ( inserver prim 'sort' is available. If you're installing this lib on a ) ( server that does not have a 'sort' prim, uncomment the next line. ) ( $def NOSORTPRIM ) $include $lib/strings $include $lib/stackrng : EDITforeach ( {str_rng} ... offset 'function data start end -- {str_rng'} ) ( 'function must be addr of a [string data -- string] function) 5 pick 6 + pick dup 4 pick < 4 pick 4 pick > or if pop pop pop pop pop pop exit then 6 pick + 7 + 3 pick - dup 1 + rotate 5 pick 7 pick execute swap -1 * rotate swap 1 + swap EDITforeach ; : EDITcolor-func ( s newcol -- s ) swap dup ( preserve the string ) striplead "^" instr 1 = if dup "^" instr strcut swap dup strlen 1 - dup 0 = if pop pop "" else strcut pop then swap dup "^" instr strcut swap pop rot swap strcat strcat else strcat then ; : EDITcolor ( {strrng} ... offset start end newcol -- {strrng'} ... ) 'EDITcolor-func -4 rotate EDITforeach ; : EDITsearch ( {rng} ... offset string start -- {rng} pos ) dup 4 pick 5 + pick > if pop pop pop 0 exit then 3 pick 5 + dup pick + over - pick 3 pick instr if rot rot pop pop exit then 1 + EDITsearch ; : EDITreplace ( {rng} ... offset oldstr newstr start end -- {rng'} ) over 6 pick 7 + pick > 3 pick 3 pick > or if pop pop pop pop pop exit then 5 pick 7 + dup pick + 3 pick - dup 1 + rotate 5 pick 7 pick subst swap -1 * rotate swap 1 + swap EDITreplace ; : EDITmove ( {rng} ... offset dest start end -- {rng'} ) 3 pick over > if rot over 4 pick - 1 + - rot rot else 3 pick 3 pick >= if pop pop pop pop exit then then over - 1 + swap 4 pick 2 + rot rot SRNG-extractrng ( {rng'} ... offset dest {subrng} ) dup 3 + rotate over 3 + rotate ( {rng'} ... {rng2} offset dest ) SRNG-insertrng ; : EDITcopy ( {rng} ... offset dest start end -- {rng'} ) over - 1 + swap 4 pick 2 + rot rot SRNG-copyrng dup 3 + rotate over 3 + rotate SRNG-insertrng ; ( Shell Sort This particular implementation is based on the version in AHU's Data Structures and Algorithms, p.290 Takes [ x1 x2 x3 ... xn n asc? insens? -- x1' x2' x3' ... xn' n ] Requires tinyMUCK 2.2 or later Stolen directly from Gazer's code, with a few mods. Baseline version 1.0 04-Oct-90 Gazer [dbriggs@nrao.edu] ) $ifdef NOSORTPRIM ( These functions return a true flag when the data items ) ( should be swapped. ) : EDITsortCaseInsensAsc stringcmp 0 > ; : EDITsortCaseSensAsc strcmp 0 > ; : EDITsortCaseInsensDesc stringcmp 0 < ; : EDITsortCaseSensDesc strcmp 0 < ; : EDITsortJLoop ( n cmp inc i j -- n cmp inc i ) dup 0 <= if pop exit then ( while j > 0 ) dup 5 + pick ( get A[j] ) over 5 pick + 6 + pick ( get A[j+inc] ) 6 pick execute if ( do comparison ) dup 5 + pick ( swap: get A[j] ) over 5 pick + 6 + pick ( get A[j+inc] ) 3 pick 6 + put ( put into A[j] ) over 5 pick + 5 + put ( put into A[j+inc] ) 3 pick - ( j := j - inc ) else pop exit then ( break out if we don't swap ) EDITsortJLoop ; : EDITsortILoop ( n cmp inc i -- n cmp inc) dup 5 pick > if pop exit then ( for i := inc + 1 to n ) over over swap - EDITsortJLoop ( j := i - inc ) 1 + EDITsortILoop ( while j > 0 ) ; : EDITsortIncLoop ( n cmp inc --- n ) dup 0 <= if pop pop exit then ( while inc > 0) dup 1 + EDITsortILoop ( for i := inc + 1 to n ) 2 / EDITsortIncLoop ; $endif : EDITsort ( {rng} ascending? CaseSensitive? -- {rng'} ) $ifdef NOSORTPRIM if if 'EDITsortCaseSensAsc else 'EDITsortCaseSensDesc then else if 'EDITsortCaseInsensAsc else 'EDITsortCaseInsensDesc then then over 2 / EDITsortIncLoop $else 2 * + sort $endif ; : EDITjoin ( {rng} -- string ) dup 2 < if pop exit then rot striptail rot striplead over if over dup strlen 1 - strcut swap pop ".!?" swap instr if " " else " " then swap strcat then strcat swap 1 - EDITjoin ; : check_ansi ( {rng} excess splitchars rmargin wrapmargin string -- {rng} excess splitchars rmargin wrapmargin string ) dup "^" rinstr dup if 1 - over swap strcut pop dup "^" rinstr dup if strcut swap pop toupper dup "REDBLACKCRIMSONFORESTBROWNNAVYVIOLETAQUAGRAYGLOOMBLUEPURPLEGREENCYANYELLOWWHITEBBLACKBBLUEBREDBPURPLEBGREENBCYANBBROWNBGRAYNORMALFLASHINVERT" swap dup "" strcmp if instr if "^" swap strcat "^" strcat 6 pick strcat 5 put else pop then else pop pop pop then else pop pop then else pop then ; : EDITsplit-splitloop (string splitchars last -- string string) over not if swap pop dup not if pop dup ansi_strlen then ansi_strcut exit then swap 1 ansi_strcut rot rot 4 pick dup rot rinstr 0 ansi_offset over over < if swap then pop EDITsplit-splitloop ; : EDITsplit-split (string splitchars rmargin wrapmargin -- excess splitchars rmargin wrapmargin string) 4 rotate 3 pick ansi_strcut swap 3 pick ansi_strcut (splitchars rmargin wrapmargin excess str wrap) 6 pick 0 EDITsplit-splitloop rot rot strcat rot rot swap strcat (splitchars rmargin wrapmargin str excess) -5 rotate ; : EDITsplit-loop ({rng} string splitchars rmargin wrapwargin -- {rng}) 4 pick ansi_strlen 3 pick < if pop pop pop dup if swap 1 + else pop then exit then EDITsplit-split check_ansi -6 rotate 5 rotate 1 + -5 rotate EDITsplit-loop ; : EDITsplit ( string splitchars rmargin wrapmargin -- {rng} ) 0 -5 rotate EDITsplit-loop ; : EDITformat-loop ( {rng} splitchars rmargin wrapmargin {rng2} -- {rng'} ) dup 5 + pick not if dup 3 + dup rotate pop dup rotate pop dup rotate pop dup rotate pop pop exit then dup 4 + 1 1 SRNG-extractrng pop ( {rng} splitchars rmargin wrapmargin {rng2} string ) dup STR-blank? not if over 6 + dup pick swap dup pick swap 1 - pick EDITsplit dup 2 + rotate + 1 - swap ( {rng} splitchars rmargin wrapmargin {rng2} string ) over 6 + pick dup if 3 pick + 6 + pick dup STR-blank? else pop "" 1 then ( {rng} splitchars rmargin wrapmargin {rng2} string nocat? ) if pop swap 1 + else 2 EDITjoin over 6 + pick 3 pick + 5 + put then ( {rng} splitchars rmargin wrapmargin {rng2} ) else pop " " swap 1 + then EDITformat-loop ; : EDITformat ( {rng} splitchars rmargin wrapmargin -- {rng'} ) 0 EDITformat-loop ; : EDITfmt_rng ( {str_rng} ... offset cols start end -- {str_rng'} ... ) over - 1 + over swap ({rng} ... off cols start start cnt ) 5 pick 3 + swap rot SRNG-extractrng ({rng'} ... off cols start {srng}) "- " over 4 + rotate dup 20 - EDITformat ({rng'} ... off start {srng}) dup 3 + rotate over 3 + rotate SRNG-insertrng ; : EDITshuffle-innerloop ( {rng} shuffles loop -- {rng'} ) dup not if pop exit then 4 rotate 4 pick ( {rng} shuffles loop item cnt ) random 256 / swap % ( {rng} shuffles loop item rnd ) 4 + -1 * rotate ( {rng} shuffles loop ) 1 - EDITshuffle-innerloop ; : EDITshuffle-outerloop ( {rng} shuffles -- {rng'} ) dup not if pop exit then over EDITshuffle-innerloop 1 - EDITshuffle-outerloop ; : EDITshuffle ( {rng} -- {rng'} ) 8 EDITshuffle-outerloop ; : EDITlist ( {rng} ... offset nums? start end -- {rng} ... ) over over > 3 pick 6 pick 7 + pick > or if pop pop pop pop exit then 4 pick 6 + dup pick + 3 pick - pick 4 pick if " " 4 pick intostr strcat dup strlen 3 - strcut swap pop ": " strcat swap strcat then dup not if pop " " then me @ swap notify swap 1 + swap EDITlist ; : EDITansi_list ( {rng} ... offset nums? start end -- {rng} ... ) over over > 3 pick 6 pick 7 + pick > or if pop pop pop pop exit then 4 pick 6 + dup pick + 3 pick - pick 4 pick if " " 4 pick intostr strcat dup strlen 3 - strcut swap pop ": " strcat swap strcat then dup not if pop " " then me @ swap ansi_notify swap 1 + swap EDITansi_list ; : EDITdisplay ( {str_rng} -- ) dup int? not if "lib-edit: EDIT-display called without an integer on top of the stack." abort then dup if dup intostr "s" swap strcat " i" strcat checkargs dup if dup 1 + rotate me @ swap notify 1 - EDITdisplay exit then pop then ; : EDITansi_display ( {str_rng} -- ) dup int? not if "lib-edit: EDIT-ansi_display called without an integer on top of the stack." abort then dup if dup intostr "s" swap strcat " i" strcat checkargs dup 1 + rotate me @ swap ansi_notify 1 - EDITansi_display exit then pop ; : EDIT-ansi_display_r ( {str_rng} -- ) dup int? not if "lib-edit: EDIT-ansi_display called without an integer on top of the stack." abort then dup if dup intostr "s" swap strcat " i" strcat checkargs dup 1 + rotate me @ swap ansi_notify 1 - EDITansi_display exit then pop ; public EDIT-ansi_display_r : EDITleft-func (string null -- string ) pop striplead ; : EDITleft ( {strrng} ... offset start end -- {strrng'} ... ) 'EDITleft-func "" -4 rotate -4 rotate EDITforeach ; : EDITcenter-func (string cols -- string ) swap strip dup ansi_strlen dup 4 pick >= if pop swap pop exit then rot swap - 2 / " " dup strcat dup strcat swap strcut pop swap strcat ; : EDITcenter ( {strrng} ... offset cols start end -- {strrng'} ... ) 'EDITcenter-func -4 rotate EDITforeach ; : EDITright-func (string cols -- string ) swap strip dup ansi_strlen dup 4 pick >= if pop swap pop exit then rot swap - " " dup strcat dup strcat swap strcut pop swap strcat ; : EDITright ( {strrng} ... offset cols start end -- {strrng'} ... ) 'EDITright-func -4 rotate EDITforeach ; : EDITindent-func (str cols -- str) swap dup strlen swap striplead dup strlen rot swap - rot + dup 1 < if pop exit then " " dup strcat dup strcat swap strcut pop swap strcat ; : EDITindent ( {str_rng} ... offset cols start end -- {str_rng'} ... ) 'EDITindent-func -4 rotate EDITforeach ; : EDITjoin_rng ( {str_rng} ... offset start end -- {str_rng'} ... ) over - 1 + over ({rng} ... off start cnt start ) 4 pick 2 + rot rot SRNG-extractrng ({rng'} ... off start {srng}) EDITjoin 1 4 rotate 4 rotate SRNG-insertrng ; PUBLIC EDITsearch PUBLIC EDITreplace PUBLIC EDITmove PUBLIC EDITcopy PUBLIC EDITlist PUBLIC EDITansi_list PUBLIC EDITleft PUBLIC EDITcenter PUBLIC EDITright PUBLIC EDITindent PUBLIC EDITfmt_rng PUBLIC EDITjoin_rng PUBLIC EDITshuffle PUBLIC EDITsort PUBLIC EDITjoin PUBLIC EDITdisplay PUBLIC EDITansi_display PUBLIC EDITsplit PUBLIC EDITformat PUBLIC EDITcolor . c q @register lib-edit=lib/edit @set $lib/edit=L @set $lib/edit=W @set $lib/edit=/_defs/EDITansi_display:"$lib/edit" match "EDITansi_display" call @set $lib/edit=/_defs/EDITansi_list:"$lib/edit" match "EDITansi_list" call @set $lib/edit=/_defs/EDITcenter:"$lib/edit" match "EDITcenter" call @set $lib/edit=/_defs/EDITcopy:"$lib/edit" match "EDITcopy" call @set $lib/edit=/_defs/EDITcolor:"$lib/edit" match "EDITcolor" call @set $lib/edit=/_defs/EDITdisplay:"$lib/edit" match "EDITdisplay" call @set $lib/edit=/_defs/EDITfmt_rng:"$lib/edit" match "EDITfmt_rng" call @set $lib/edit=/_defs/EDITformat:"$lib/edit" match "EDITformat" call @set $lib/edit=/_defs/EDITindent:"$lib/edit" match "EDITindent" call @set $lib/edit=/_defs/EDITjoin:"$lib/edit" match "EDITjoin" call @set $lib/edit=/_defs/EDITjoin_rng:"$lib/edit" match "EDITjoin_rng" call @set $lib/edit=/_defs/EDITleft:"$lib/edit" match "EDITleft" call @set $lib/edit=/_defs/EDITlist:"$lib/edit" match "EDITlist" call @set $lib/edit=/_defs/EDITmove:"$lib/edit" match "EDITmove" call @set $lib/edit=/_defs/EDITreplace:"$lib/edit" match "EDITreplace" call @set $lib/edit=/_defs/EDITright:"$lib/edit" match "EDITright" call @set $lib/edit=/_defs/EDITsearch:"$lib/edit" match "EDITsearch" call @set $lib/edit=/_defs/EDITshuffle:"$lib/edit" match "EDITshuffle" call @set $lib/edit=/_defs/EDITsort:"$lib/edit" match "EDITsort" call @set $lib/edit=/_defs/EDITsplit:"$lib/edit" match "EDITsplit" call @set $lib/edit=/_defs/EDIT-ansi_display:"$lib/edit" match "EDITansi_display" call @set $lib/edit=/_defs/EDIT-ansi_list:"$lib/edit" match "EDITansi_list" call @set $lib/edit=/_defs/EDIT-center:"$lib/edit" match "EDITcenter" call @set $lib/edit=/_defs/EDIT-copy:"$lib/edit" match "EDITcopy" call @set $lib/edit=/_defs/EDIT-color:"$lib/edit" match "EDITcolor" call @set $lib/edit=/_defs/EDIT-display:"$lib/edit" match "EDITdisplay" call @set $lib/edit=/_defs/EDIT-fmt_rng:"$lib/edit" match "EDITfmt_rng" call @set $lib/edit=/_defs/EDIT-format:"$lib/edit" match "EDITformat" call @set $lib/edit=/_defs/EDIT-indent:"$lib/edit" match "EDITindent" call @set $lib/edit=/_defs/EDIT-join:"$lib/edit" match "EDITjoin" call @set $lib/edit=/_defs/EDIT-join_rng:"$lib/edit" match "EDITjoin_rng" call @set $lib/edit=/_defs/EDIT-left:"$lib/edit" match "EDITleft" call @set $lib/edit=/_defs/EDIT-list:"$lib/edit" match "EDITlist" call @set $lib/edit=/_defs/EDIT-move:"$lib/edit" match "EDITmove" call @set $lib/edit=/_defs/EDIT-replace:"$lib/edit" match "EDITreplace" call @set $lib/edit=/_defs/EDIT-right:"$lib/edit" match "EDITright" call @set $lib/edit=/_defs/EDIT-search:"$lib/edit" match "EDITsearch" call @set $lib/edit=/_defs/EDIT-shuffle:"$lib/edit" match "EDITshuffle" call @set $lib/edit=/_defs/EDIT-sort:"$lib/edit" match "EDITsort" call @set $lib/edit=/_defs/EDIT-split:"$lib/edit" match "EDITsplit" call @set $lib/edit=/_docs:@list $lib/edit=1-90 @set $lib/edit=/_/de:lib-edit: List lines 1-90 for documentation. @set $lib/edit=/_lib-version:FM$Revision: 1.21 $ @set $lib/edit=/_lib-symbol:EDIT wh me=Installation of lib-edit complete.