wh me=Beginning installation of lib-strings...
@prog lib-strings
1 99999 d
1 i
( lib-strings: $Date: 2004/04/22 17:25:53 $ $Revision: 1.12 $                )
( Purpose: Replicate and enhance the inserver look routine                    )
( Author: Unknown                                                             )
( Contributors: Feaelin                                                       )
( Dependencies: None                                                          )
( --------------------------------------------------------------------------- )
( These routines deal with spaces in strings.                                 )
( STRblank?    [       str -- bool          ]  true if str null or only spaces)
( STRsls       [       str -- str'          ]  strip leading spaces           )
( STRsts       [       str -- str'          ]  strip trailing spaces          )
( STRstrip     [       str -- str'          ]  strip lead and trail spaces    )
( STRsms       [       str -- str'          ]  strips mult. internal spaces   )
(                                                                             )
( These two are routines to split a string on a substring, non-inclusively.   )
( STRsplit     [ str delim -- prestr postr  ]  splits str on first delim.     )
( STRrsplit    [ str delim -- prestr postr  ]  splits str on last delim.      )
( STRsplitargs [       str -- str str       ]  split a string at first space  )
(                                              or = sign                      )
(                                                                             )
( The following are useful for formatting strings into fields. As of revision )
( 1.10, they are aware of Glow-ansi-codes, and should pad correctly strings   )
( containing them.                                                            )
( STRfillfield [ str char width -- padstr   ]  return padding string to width )
(                                              chars                          )
( STRcenter    [ str width -- str'          ]  center a string in a field.    )
( STRleft      [ str width -- str'          ]  pad string w/ spaces to width  )
(                                              chars                          )
( STRright     [ str width -- str'          ]  right justify string to width  )
(                                              chars                          )
( These convert between ascii integers and string character.                  )
( STRasc       [      char -- i             ]  convert character to ASCII     )
(                                              number                         )
( STRchar      [         i -- char          ]  convert number to character    )
(                                                                             )
( This routine is useful for parsing command line input:                      )
( STRparse     [      str -- str1 str2 str3 ] " #X Y  y = Z" -> "X" "Y y" " Z")
( --------------------------------------------------------------------------- )
(
  $Log: lib-strings,v $
  Revision 1.12  2004/04/22 17:25:53  feaelin
  Documentation Cleanup

  Revision 1.11  2001/02/22 20:46:31  feaelin
  Documentation correction.
  
  Revision 1.10  2001/02/22 20:39:56  feaelin
  Added support to STRfillfield, STRcenter STRleft, STRright to detect
  and handle correctly strings with ANSI codes in them.  Credit goes to
  Syvel for the original concept for this correction.
  
  Revision 1.8  1999/02/13 19:06:17  feaelin
  Fixed .split2 entry
  
  Revision 1.6  1998/07/30 19:20:41  glow
  Added synonyms of .split: .splitarg, .splitargs, .splitfirst, .strcutat.
  
  Revision 1.4  1998/07/30 19:14:48  glow
  Added STRsplitargs/.splitargs
  
  Revision 1.3  1998/07/30 04:11:20  glow
  Updated STRsplit
  
  Revision 1.2  1998/07/28 03:35:38  glow
  Corrected wiz-level.
  
  Revision 1.1  1998/07/27 21:15:02  glow
  Initial revision
)  
( --------------------------------------------------------------------------- )
: split ( s si -- s s )
   over over instr dup if
      rot swap 1 - strcut rot strlen strcut swap pop
   else pop pop "" then
;

: splitargs ( s -- s s )
  dup " " instr if
    dup "=" instr if
      dup " " instr over "=" instr - 0 < if
        " " split
      else "=" split then
    else " " split then
  else "=" split then
;

: rsplit
    swap over over swap
    rinstr dup not if
        pop swap pop ""
    else
        1 - strcut rot
        strlen strcut
        swap pop
    then
;
  
: sms ( str -- str')
    dup "  " instr if
        " " "  " subst 'sms jmp
    then
;
  
: fillfield (str padchar fieldwidth -- padstr)
  rot ansi_strlen - dup 1 < if pop pop "" exit then
  swap over begin swap dup strcat swap 2 / dup not until pop
  swap ansi_strcut pop
;
  
: left (str fieldwidth -- str')
  over " " rot fillfield strcat
;
  
: right (str fieldwidth -- str')
  over " " rot fillfield swap strcat
;
  
: center (str fieldwidth -- str')
  over " " rot fillfield
  dup ansi_strlen 2 / ansi_strcut
  rot swap strcat strcat
;
  
  
: STRasc ( c -- i )
    " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    "[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" strcat
    swap
    dup not if
	and exit
    then
    instr dup if
        31 +
    then
;
  
: STRchr ( i -- c )
    dup 31 > over 128 < and if
        " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
        "[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" strcat
        swap 32 - strcut swap pop 1 strcut pop
    else
        pop "."
    then
;
  
: STRparse ( s -- s1 s2 s3 ) (
    Before: " #option  tom dick  harry = message "
    After:  "option" "tom dick harry" " message "
    )
    "=" rsplit swap
    striplead dup "#" 1 strncmp not if
        1 strcut swap pop
        " " split
    else
        "" swap
    then
    strip sms rot
;
  
public split
public rsplit
public sms
public fillfield
public left
public right
public center
public STRasc
public STRchr
public STRparse
public splitargs
.
c
q
@register lib-strings=lib/strings
@register #me lib-strings=tmp/prog1
@set $tmp/prog1=L
@set $tmp/prog1=W
@set $tmp/prog1=/_defs/.asc:"$lib/strings" match "STRasc" call
@set $tmp/prog1=/_defs/.blank?:striplead not
@set $tmp/prog1=/_defs/.center:"$lib/strings" match "center" call
@set $tmp/prog1=/_defs/.chr:"$lib/strings" match "STRchr" call
@set $tmp/prog1=/_defs/.command_parse:"$lib/strings" match "STRparse" call
@set $tmp/prog1=/_defs/.fillfield:"$lib/strings" match "fillfield" call
@set $tmp/prog1=/_defs/.left:"$lib/strings" match "left" call
@set $tmp/prog1=/_defs/.right:"$lib/strings" match "right" call
@set $tmp/prog1=/_defs/.rsplit:"$lib/strings" match "rsplit" call
@set $tmp/prog1=/_defs/.singlespace:"$lib/strings" match "sms" call
@set $tmp/prog1=/_defs/.sms:"$lib/strings" match "sms" call
@set $tmp/prog1=/_defs/.split:"$lib/strings" match "split" call
@set $tmp/prog1=/_defs/.split2:"$lib/strings" match "split" call
@set $tmp/prog1=/_defs/.splitarg:"$lib/strings" match "splitargs" call
@set $tmp/prog1=/_defs/.splitargs:"$lib/strings" match "splitargs" call
@set $tmp/prog1=/_defs/.splitfirst:"$lib/strings" match "splitargs" call
@set $tmp/prog1=/_defs/.stripspaces:strip
@set $tmp/prog1=/_defs/.strcutat:"$lib/strings" match "splitargs" call
@set $tmp/prog1=/_defs/STRasc:"$lib/strings" match "STRasc" call
@set $tmp/prog1=/_defs/STRblank?:striplead not
@set $tmp/prog1=/_defs/STRcenter:"$lib/strings" match "center" call
@set $tmp/prog1=/_defs/STRchr:"$lib/strings" match "STRchr" call
@set $tmp/prog1=/_defs/STRfillfield:"$lib/strings" match "fillfield" call
@set $tmp/prog1=/_defs/STRleft:"$lib/strings" match "left" call
@set $tmp/prog1=/_defs/STRparse:"$lib/strings" match "STRparse" call
@set $tmp/prog1=/_defs/STRright:"$lib/strings" match "right" call
@set $tmp/prog1=/_defs/STRrsplit:"$lib/strings" match "rsplit" call
@set $tmp/prog1=/_defs/STRsinglespace:"$lib/strings" match "sms" call
@set $tmp/prog1=/_defs/STRsls:striplead
@set $tmp/prog1=/_defs/STRsms:"$lib/strings" match "sms" call
@set $tmp/prog1=/_defs/STRsplit:"$lib/strings" match "split" call
@set $tmp/prog1=/_defs/STRsplitargs:"$lib/strings" match "splitargs" call
@set $tmp/prog1=/_defs/STRstrip:strip
@set $tmp/prog1=/_defs/STRsts:striptail
@set $tmp/prog1=/_docs:@list $lib/strings=1-37
@set $tmp/prog1=/_/de:lib-strings: List lines 1-37 for documentation.
@set $tmp/prog1=/_lib-version:FM$Revision: 1.12 $
wh me=Installation of lib-strings complete.