Replace several items in one run + example converters

replace-each.red

Red [
	Description: {Replace several items in one run + example conversions}
	Date: 27-Mar-2020
	Author: "Toomas Vooglaid"
]
context [
	sp:			charset " ^-"
	sp*:		[any sp]
	digit:		charset "0123456789"
	integer:	[some digit]
	hexa:		union charset [#"A" - #"F" #"a" - #"f"] digit
	octal:		charset "01234567"

	int: hx: oc: none
	
	get-hexa: func [hx][
		if odd? length? hx [insert hx #"0"]
		to char! to integer! debase/base hx 16
	]
	get-octal: function [oc][
		b: rejoin collect [
			foreach o oc [
				keep take/last/part enbase/base debase/base append copy "0" o 16 2 3
			]
		] 
		insert/dup b #"0" 8 - ((length? b) % 8) 
		get-hexa enbase/base debase/base b 2 16
	]
	
	set 'replace-each function [
		"Replace each needle in series"
		series [series!]
		needles [series!]
		/with replacements [series!]
	][
		rule: collect [
			forall needles [
				i: index? needles
				replacement: either with [replacements/:i][second needles]
				keep 'change 
				keep/only needles/1
				keep/only append copy quote () replacement
				keep '|
				if not with [needles: next needles]
			]
		] 
		append rule 'skip 
		parse/case series [some rule]
		series
	]

	set 'c-esc func [
		"Replace chars with c-escapes"
		str [string!]
	][
		replace-each/with str 
			"^(07)^(08)^(1B)^(0C)^(0A)^(0D)^(09)^(0B)^(5C)^(27)^(22)^(3F)" 
			["\a" "\b" "\e" "\f" "\n" "\r" "\t" "\v" "\\" "\'" {\"} "\?"]
	]

	set 'c-str func [
		"Replace c-escapes with chars"
		str [string!]
	][
		replace-each str [
			"\a"    #"^(07)" 
			"\b"    #"^(08)" 
			"\e"    #"^(1B)"
			"\f"    #"^(0C)"
			"\n"    #"^(0A)"
			"\r"    #"^(0D)"
			"\t"    #"^(09)"
			"\v"    #"^(0B)"
			"\\"    #"^(5C)"
			"\'"    #"^(27)"
			{\"}    #"^(22)"
			"\?"    #"^(3F)"
			["\U" copy hx 8 hexa] 			[get-hexa hx]
			["\u{" copy hx 1 6 hexa #"}"] 	[get-hexa hx]
			["\u" copy hx 4 hexa]				[get-hexa hx]
			["\x" copy hx some hexa]			[get-hexa hx]
			[#"\" copy oc 1 3 octal]			[get-octal oc]
		]
	]
	
	set 'clean-html func [
		"Clean html source from tags and replace entities"
		src [string!]
	][
		replace-each src [
			["<script" thru "</script>"]	""
			["<style" thru "</style>"] 		""
			[#"<" thru #">"]				""
			["&#"  copy int integer  #";"] 	[to char! int]
			["&#x" copy hx some hexa #";"]	[get-hexa hx]
			"&cent;"    #"¢" 
			"&pound;"   #"£" 
			"&sect;"    #"§" 
			"&copy;"    #"©" 
			"&laquo;"   #"«" 
			"&raquo;"   #"»" 
			"&reg;"     #"®" 
			"&deg;"     #"°" 
			"&plusmn;"  #"±" 
			"&para;"    #"¶" 
			"&middot;"  #"·" 
			"&frac12;"  #"½" 
			"&frac13;"	#"⅓"
			"&frac23;"	#"⅔"
			"&frac15;"	#"⅕"
			"&frac25;"	#"⅖"
			"&frac35;"	#"⅗"
			"&frac45;"	#"⅘"
			"&frac16;"	#"⅙"
			"&frac56;"	#"⅚"
			"&frac18;"	#"⅛"
			"&frac38;"	#"⅜"
			"&frac58;"	#"⅝"
			"&frac78;"	#"⅞"
			"&ndash;"   #"–" 
			"&mdash;"   #"—" 
			"&lsquo;"   #"‘" 
			"&rsquo;"   #"’" 
			"&sbquo;"   #"‚" 
			"&ldquo;"   #"“" 
			"&rdquo;"   #"”" 
			"&bdquo;"   #"„" 
			"&dagger;"  #"†" 
			"&Dagger;"  #"‡" 
			"&bull;"    #"•" 
			"&hellip;"  #"…" 
			"&prime;"   #"′" 
			"&Prime;"   #"″" 
			"&euro;"    #"€" 
			"&trade;"   #"™" 
			"&asymp;"   #"≈" 
			"&nbsp;"    #" "
			"&amp;"     #"&"
			"&quot;"    #"^"" ;"
			"&ne;"      #"≠" 
			"&le;"      #"≤" 
			"&ge;"      #"≥" 
			"&lt;"      #"<" 
			"&gt;"      #">" 
			"&Alpha;"	#"Α"
			"&Beta;"	#"Β"
			"&Gamma;"	#"Γ"
			"&Delta;"	#"Δ"
			"&Epsilon;"	#"Ε"
			"&Zeta;"	#"Ζ"
			"&Eta;"		#"Η"
			"&Theta;"	#"Θ"
			"&Iota;"	#"Ι"
			"&Kappa;"	#"Κ"
			"&Lambda;"	#"Λ"
			"&Mu;"		#"Μ"
			"&Nu;"		#"Ν"
			"&Xi;"		#"Ξ"
			"&Omicron;"	#"Ο"
			"&Pi;"		#"Π"
			"&Rho;"		#"Ρ"
			"&Sigma;"	#"Σ"
			"&Tau;"		#"Τ"
			"&Upsilon;"	#"Υ"
			"&Phi;"		#"Φ"
			"&Chi;"		#"Χ"
			"&Psi;"		#"Ψ"
			"&Omega;"	#"Ω"
			"&alpha;"	#"α"
			"&beta;"	#"β"
			"&gamma;"	#"γ"
			"&delta;"	#"δ"
			"&epsilon;"	#"ε"
			"&zeta;"	#"ζ"
			"&eta;"		#"η"
			"&theta;"	#"θ"
			"&iota;"	#"ι"
			"&kappa;"	#"κ"
			"&lambda;"	#"λ"
			"&mu;"		#"μ"
			"&nu;"		#"ν"
			"&xi;"		#"ξ"
			"&omicron;"	#"ο"
			"&pi;"		#"π"
			"&rho;"		#"ρ"
			"&sigmav;"	#"ς"
			"&sigma;"	#"σ"
			"&tau;"		#"τ"
			"&upsilon;"	#"υ"
			"&phi;"		#"φ" 
			"&chi;"		#"χ"
			"&psi;"		#"ψ"
			"&omega;"	#"ω"
		]
		replace/all src [#"^/" sp* #"^/" some [sp* #"^/"]] "^/^/"
	]
	set 'opf func [str [string!]] [
		replace-each/with str 
			"ABCDEFGHIJKLMOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
			"𝔸𝔹ℂ𝔻𝔼𝔽𝔾ℍ𝕀𝕁𝕂𝕃𝕄𝕆ℙℚℝ𝕊𝕋𝕌𝕍𝕎𝕏𝕐ℤ𝕒𝕓𝕔𝕕𝕖𝕗𝕘𝕙𝕚𝕛𝕜𝕝𝕞𝕟𝕠𝕡𝕢𝕣𝕤𝕥𝕦𝕧𝕨𝕩𝕪𝕫"
	]
	set 'fr func [str [string!]] [
		replace-each/with str 
			"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
			"𝔄𝔅ℭ𝔇𝔈𝔉𝔊ℌℑ𝔍𝔎𝔏𝔐𝔑𝔒𝔓𝔔ℜ𝔖𝔗𝔘𝔙𝔚𝔛𝔜ℨ𝔞𝔟𝔠𝔡𝔢𝔣𝔤𝔥𝔦𝔧𝔨𝔩𝔪𝔫𝔬𝔭𝔮𝔯𝔰𝔱𝔲𝔳𝔴𝔵𝔶𝔷"
	]
	set 'scr func [str [string!]] [
		replace-each/with str
			"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
			"𝒜ℬ𝒞𝒟ℰℱ𝒢ℋℐ𝒥𝒦ℒℳ𝒩𝒪𝒫𝒬ℛ𝒮𝒯𝒰𝒱𝒲𝒳𝒴𝒵𝒶𝒷𝒸𝒹ℯ𝒻ℊ𝒽𝒾𝒿𝓀𝓁𝓂𝓃ℴ𝓅𝓆𝓇𝓈𝓉𝓊𝓋𝓌𝓍𝓎𝓏"
	]
	set 'greek function [str [string!]] [
		replace-each/with str
			["A" "B" "G" "D" "E" "Z" "H" ["TH" | "Th"] "I" "K" "L" "M" "N" "X" "O" "P" "R" "S"     "T" "Y" "F" "C" ["PS" | "Ps"] "O" 
			 "a" "b" "g" "d" "e" "z" "h" "th"          "i" "k" "l" "m" "n" "x" "o" "p" "r" "s" "s" "t" "y" "f" "c" "ps"          "o"]
			["Α" "Β" "Γ" "Δ" "Ε" "Ζ" "Η" "Θ"           "Ι" "Κ" "Λ" "Μ" "Ν" "Ξ" "Ο" "Π" "Ρ" "Σ"     "Τ" "Υ" "Φ" "Χ" "Ψ"           "Ω" 
			 "α" "β" "γ" "δ" "ε" "ζ" "η" "θ"           "ι" "κ" "λ" "μ" "ν" "ξ" "ο" "π" "ρ" "ς" "σ" "τ" "υ" "φ" "χ" "ψ"           "ω"]
	]
]