#ifndef RR_STRINGS_MBI
#define RR_STRINGS_MBI 1

;############################################################################
; RR_STRINGS_MBI (rr_strings.mbi)
;    written and © by Ralph Reuchlein 1997/98
;
; Additional string manipulation functions
;############################################################################
; HiStory:
;
; Date        MUIbase   What?
; ----        -------   -----
; 28-Mar-97   0.22      · (replaceChar string char pos)
;                       · (lastpos substr str)
;                       · (copies char/string number)
;                       · (indentMemo m indent), only for mb022!
;                       · (chr intval)
; 31-Mar-97   0.22      · correcting (copies): always one char
;                         missing :-)
; 11-Apr-97   0.24      · (indentMemo) obsolete
; 12-Apr-97   0.24      · (isINT string)
;                       · (isREAL string)
;                       · (isTIME string)
;                       · (isDATE string)
; 19-Jul-97   0.27      · (indentMEMO) removed, corrected in 0.23
;                       · (chr) removed, implemented in 0.25
;                       · (reverseStr str)
;                       · (countSubstr string substr)
;                       · updated all variable types
; 07-Apr-98   0.39      · (wrapMemo memo width fill)
;                       · (trimBlankLines memo)
; 08-Apr-98   0.39      · (procBar pos man len)
;                       · (deHTML memo)
; 18-Apr-98   0.39      · (deHTML memo) rewritten using (REPLACESTR)
;                       · (correctName string)
; 19-Apr-98   0.39      · (replaceStrings string list)
;                       · (deHTML memo) rewritten using (replaceStrings)
;## FROM NOW ON MUIBASE IS PUBLIC ###########################################
; 
;############################################################################
; Includes

#ifndef RR_GENERAL_MBI
#include "MUIbase:include/rr_general.mbi"
#endif

;############################################################################





;## Steffen has built in lots of string manipulation functions, but
;## there are some special functions which also will be needed sometimes





;## ----------------------------------------------------------------
;## (replaceChar string char pos)
;## ----------------------------------------------------------------
;## replaces specified char at given position in string
;## NOTE! First position in string is 0, *NOT* 1!
;## This function always return a string. In case of an error
;## or impossible values the origin string will be returned

FUNCTION replaceChar (string:STR char:STR pos:INT)
  (IF (= (LEN char) 1) THEN
    (IF (>= (LEN string) pos) THEN
      (RETURN (CONCAT2 char
                      (LEFTSTR string pos)
                      (RIGHTSTR string (- (LEN string) pos 1))
              )
      )
    )
  )
  (RETURN string)
END





;## ----------------------------------------------------------------
;## (lastpos substr string)
;## ----------------------------------------------------------------
;## looks for the *LAST* appearance of the substring in string
;## adapted from ARexx

FUNCTION lastpos (substr:STR string:STR)
  (LET (i:INT p:INT (l:INT (- (LEN string) (LEN substr))))
    (DOTIMES (i l)
      (SETQ p (- l i))
      (IF (= (MIDSTR string p (LEN substr)) substr) THEN
        (RETURN p)
      )
    )
    (RETURN NIL)
  )
END





;## ----------------------------------------------------------------
;## (copies cs num)
;## ----------------------------------------------------------------
;## creates a string containing given number of char/string
;## concatenated

FUNCTION copies (cs:STR num:INT)
  (LET (i:INT (s:STR ""))
    (DOTIMES (i num)
      (SETQ s (+ s cs))
    )
    (RETURN s)
  )
END





;## ----------------------------------------------------------------
;## (isINT string)
;## ----------------------------------------------------------------
;## returns the string, if it represents a INTEGER value or
;## character

FUNCTION isINT (string:STR)
  (LET (i:INT s:STR)
    (DOTIMES (i (LEN string) string)
      (SETQ s (MIDSTR string i 1))
      (IF (NULL (INDEXBRK* s "1234567890+-")) THEN
        (
          (RETURN NIL)
        )
      )
    )
  )
END





;## ----------------------------------------------------------------
;## (isREAL string)
;## ----------------------------------------------------------------
;## returns the string, if it represents a REAL value or character
;## yes, I know, I could use (REAL string) for testing, but you
;## cannot do (REAL "."), because MUIbase would halt compiling,
;## although the "." is part of a REAL value

FUNCTION isREAL (string:STR)
  (LET (i:INT s:STR)
    (DOTIMES (i (LEN string) string)
      (SETQ s (MIDSTR string i 1))
      (IF (NULL (INDEXBRK* s "1234567890+-.")) THEN
        (
          (RETURN NIL)
        )
      )
    )
  )
END





;## ----------------------------------------------------------------
;## (isTIME string)
;## ----------------------------------------------------------------
;## returns the string, if it represents a TIME value or character

FUNCTION isTIME (string:STR)
  (LET (i:INT s:STR)
    (DOTIMES (i (LEN string) string)
      (SETQ s (MIDSTR string i 1))
      (IF (NULL (INDEXBRK* s "1234567890:")) THEN
        (
          (RETURN NIL)
        )
      )
    )
  )
END





;## ----------------------------------------------------------------
;## (isDATE string)
;## ----------------------------------------------------------------
;## returns the string, if it represents a DATE value or character

FUNCTION isDATE (string:STR)
  (LET (i:INT s:STR)
    (DOTIMES (i (LEN string) string)
      (SETQ s (MIDSTR string i 1))
      (IF (NULL (INDEXBRK* s "1234567890.")) THEN
        (
          (RETURN NIL)
        )
      )
    )
  )
END





;## ----------------------------------------------------------------
;## (reverseStr string)
;## ----------------------------------------------------------------
;## reverses the contents of a string

FUNCTION reverseStr (string:STR)
  (LET (i:INT (s:STR ""))
    (DOTIMES (i 0 (LEN string))
      (SETQ s (+ (MIDSTR string i 1) s))
    )
    (RETURN s)
  )
END





;## ----------------------------------------------------------------
;## (countSubstr string substr)
;## ----------------------------------------------------------------
;## counts how many substrings are in the string

FUNCTION countSubstr (string:STR substr:STR)
  (LET (i:INT (cnt:INT 0))
    (DO ((i 0)) ((>= i (LEN string)) cnt)
      (IF (=* (MIDSTR string i (LEN substr)) substr)
        (
          (SETQ cnt (1+ cnt))
        )
      )
      (SETQ i (+ i (LEN substr)))
    )
  )
END





;## ----------------------------------------------------------------
;## (wrapMemo memo width fill)
;## ----------------------------------------------------------------
;## does the same as (FORMATMEMO), but ONLY wraps lines starting
;## with a non-space and being longer than width

FUNCTION wrapMemo (mlines:MEMO width:INT fill)
  (LET (i:INT s:STR (newmemo:MEMO ""))
    (DOTIMES (i (LINES mlines))
      (SETQ s (LINE mlines i))
      (IF (AND (> (LEN s) width) (NULL (INDEXBRK (LEFTSTR s 1) " \t"))) THEN
        (
          (SETQ s (FORMATMEMO s width fill))
        )
      )
      (SETQ newmemo (+ newmemo s "\n"))
    )
    newmemo                       ;return value
  )
END





;## ----------------------------------------------------------------
;## (trimBlankLines memo)
;## ----------------------------------------------------------------
;## removes trailing and leading empty lines in a memo
;## NOTE: lines only containing blanks were NOT removed !!!

FUNCTION trimBlankLines (mlines:MEMO)
;  (LET ()
    (DOUNTIL ((<> (LEFTSTR mlines 1) "\n"))
      (SETQ mlines (RIGHTSTR mlines (- (LEN mlines) 1)))
    )
    (DOUNTIL ((<> (RIGHTSTR mlines 1) "\n"))
      (SETQ mlines (LEFTSTR mlines (- (LEN mlines) 1)))
    )
    mlines                       ;return value
;  )
END





;## ----------------------------------------------------------------
;## (procBar pos max len)
;## ----------------------------------------------------------------
;## creates a text-based process bar string

FUNCTION procBar (position:INT maximum:INT leng:INT)
  (LET (i:INT)
    (SETQ i (DIV (* leng position) maximum))
    (+ (copies "#" i) (copies "_" (- leng i)))
  )
END





;## ----------------------------------------------------------------
;## (deHTML memo)
;## ----------------------------------------------------------------
;## this nice function replaces every(?) SGML language element in its
;## HTML entity
;## ISO 8879 & Latin1 entities from the book
;## Raggett, D.: Raggett on HTML 4, Addison-Wesley, 1998

FUNCTION deHTML (mlines:MEMO)
;  (LET ()
    (replaceStrings mlines (LIST
      "&"    "&amp;"
      "<"    "&lt;"
      ">"    "&gt;"
      "\x22" "&quot;"   ; the " character
      "©"    "&copy;"
      "­"    "&shy;"    ; the ­ charater (thats ASCII #173, NOT the minus sign -!)
      "ä"    "&auml;"   ; german diaeresis
      "Ä"    "&Auml;"   ; german diaeresis
      "ö"    "&ouml;"   ; german diaeresis
      "Ö"    "&Ouml;"   ; german diaeresis
      "ü"    "&uuml;"   ; german diaeresis
      "Ü"    "&Uuml;"   ; german diaeresis
      "ß"    "&szlig;"  ; german small sharp S (sz ligature)
    ))
;  )
END





;## ----------------------------------------------------------------
;## (correctName string)
;## ----------------------------------------------------------------
;## takes the last word in string, moves it to the start of line
;## and finally inserts a ','

FUNCTION correctName (string:STR)
  (LET (s:STR)
    (SETQ s (WORD string (1- (WORDS string))))
    (+ s ", " (TRIMSTR (LEFTSTR string (- (LEN string) (LEN s)))))
  )
END





;## ----------------------------------------------------------------
;## (replaceStrings string list)
;## ----------------------------------------------------------------
;## replaces each substring in the list by its replacestring
;## 'list' has the format (better to say: is the result of)
;##     (LIST substr replacestr [substr replacestr] ...)
;##
;## Pay attention for the order of the replacements! You may do this:
;##     (LIST "<" "&lt;" "&" "&amp;")
;## This will make "a<2" to "a&amp;lt;2" because at first it will
;## replace the '<' which results to "a&lt;2". After that the '&'
;## will be replaced and leads to "a&amp;lt;2" which is wrong. Change
;## the order to
;##     (LIST "&" "&amp;" "<" "&lt;")
;## to get the correct result "a&lt;2".

FUNCTION replaceStrings (string:STR l:LIST)
  (LET (i:INT substr:STR replstr:STR)
    ; first check the number of pairs (must be even)
    (IF (= 0 (MOD (LENGTH l) 2))
      (
         ; now take pair by pair and do the replacement
         (DO ((i 0 (+ i 2))) ((>= i (LENGTH l)))
            (SETQ substr (NTH i l) replstr (NTH (1+ i) l))
            (SETQ string (REPLACESTR string substr replstr))
         )
      )
      ELSE
      (
         (msg "replaceStrings: Number of LIST elements isn't even!")
      )
    )
    string            ; return value
  )
END




;## ----------------------------------------------------------------
;## ----------------------------------------------------------------



#endif