summaryrefslogtreecommitdiff
path: root/support/copac-clean/copac-clean-lib.inc
blob: edf2fcc9f1a06e589bdab060f750fa0f7400aa3b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
*COPAC-CLEAN-LIB. Library files for COPAC-CLEAN.
*Version 0.8 28.08.2015
*Copyright (C) Guido Milanese <guido.milanese@unicatt.it>
*
* License: LaTeX Project Public License 1.3c
*
* Library files for copac-clean.sno
* (C) Guido Milanese 2015
* guido.milanese@unicatt.it
* Sources: 
* bq.sno:
*	PHIL BUDNE <phil@ultimate.com>
* compiler
*	GREGORY WHITE <glwhite@netconnect.com.au>
* other functions
*	GUIDO MILANESE <guido.milanese@unicatt.it>
* include files statements are commented to avoid double loading

* $Id: bq.sno,v 1.4 1997/09/14 04:36:57 phil Exp $
*	execute a shell command line and capture stdout
*
*	like shell backquotes (hence the name)
*	p budne, june 20, 1994

*	optional second arg is string to use to seperate lines

	DEFINE("BQ(COMMAND,OFS)UNIT")			:(END_BQ)
BQ	UNIT = IO_FINDUNIT()				:F(FRETURN)
	INPUT(.X,UNIT,,'|' COMMAND)			:F(FRETURN)
	OFS = IDENT(OFS) ' '
	BQ = X						:F(BQF)
BQL	BQ = BQ OFS X					:S(BQL)
	ENDFILE(UNIT)
	DETACH(.X)					:(RETURN)
BQF	ENDFILE(UNIT)
	DETACH(.X)					:(FRETURN)
END_BQ


*-- Function ITRIM
*-- "Initial trim"
*-- guido.milanese@unicatt.it
*-- ven set 9 2005
            define("itrim(Pass)")   :(itrim_end)
itrim
itrim_bg    Pass ? pos(0) ' ' =  :s(itrim_bg)
itrim_rt   itrim   =  pass                :(return)
itrim_end

* ACC.INC
* GM 2003
* <guido.milanese@mclink.it>
* Accents etc. according to different languages
* The returned string must be parsed by the calling program
* Up to '-' : lowercase accents
* After '-' : uppercase accents
* Options:	
*		es = Spanish
*		de = German
*		fr = French
*		it = Italian
*		XX = all accents of table 8859-XX (e.g. 8859-15)
*		en = no accents (English)

	DEFINE("acc(option)")
	digits = '1234567890'
* German	
	acc_de1 =  "äëïöüß" ; acc_de2 = "ÄËÏÖÜß" ; acc_de = acc_de1 '-' acc_de2
* Spanish	
	acc_es1 =  "áéíóúñ" ; acc_es2 = "ÁÉÍÓÚÑ" ; acc_es = acc_es1 '-' acc_es2
* French	
	acc_fr1 = "áàèéíìóòúùâêîôûäëïöüç" 
	acc_fr2 = "ÁÀÈÉÍÌÓÒÚÙÂÊÎÔÛÄËÏÖÜÇ" 
	acc_fr  = acc_fr1 '-' acc_fr2
* Italian	
	acc_it1 = "áàèéíìóòúùâêîôû" 
	acc_it2 = "ÁÀÈÉÍÌÓÒÚÙÂÊÎÔÛ"
	acc_it  = acc_it1 '-' acc_it2
* All
	acc_001 = acc_de1 acc_es1 acc_fr1 acc_it1
	acc_002 = acc_de2 acc_es2 acc_fr2 acc_it2
	acc_00  = acc_001 '-' acc_002

* Complete table (e.g. 8859-15): builds string of chars
	k = 127
	chars8859 = ''	
ACC_DO	(
+	  (lt(k,255))
+	  (k = k + 1)
+	  (chars8859 = chars8859 char(k))
+	)	:s(ACC_DO)
	
								:(ACC_END)
				
ACC
* Trims spaces at begin and end of option
ACC_N	option ? ' ' = 						:s(ACC_N)
* If no option given, sets to all accents (option '00')
**	( ~(option ? any(&lcase digits)) (option = '00') )
* If a number is passed as option, means a complete table (e.g. 8859-1)
**	( (option ? any(digits)) (option = 'TA') )
	(
+		(~(option ? any(&lcase digits)) (option = '00')), 
+		( (option ? any(digits)) (option = 'TA') ),
+		(option = option)
+	)

* Checks option	
	(	
+	~(option  ? ("en" | "es" | "de" | "fr" | "it" | "TA" | "00"))
+	(terminal = 'Please supply a valid language identifier')
+	)			:s(freturn)
       				:($('ACC_' option))

ACC_ES  acc = acc_es						  :(return)
ACC_DE	acc = acc_de               				  :(return)
ACC_FR	acc = acc_fr                                              :(return)
ACC_IT	acc = acc_it                                 		  :(return)
ACC_EN	acc = '' '-' ''						  :(return)
ACC_TA	acc = chars8859 '-' ' '					  :(return)
ACC_00	acc = acc_00                                              :(return)
ACC_  	terminal = "Please supply a valid language identifier"	  :(freturn)
ACC_END

*-- Function MAMI
*-- Uppers to Lowers including accented chars
*-- guido.milanese@unicatt.it
*-- 2007
            define("mami(pass)")   
*-include "acc.inc"
	lang	=	"XX"
   (acc(lang) ? break('-') . acc_mi len(1) rem . acc_ma )
   acc_mm = acc_ma acc_mi          ;* tutti i car. accentati
   ch_ma = &ucase acc_ma           ;* caratteri maiuscoli ridefiniti
   ch_mi = &lcase acc_mi           ;* caratteri minuscoli ridefiniti
   chars = ch_ma ch_mi             ;* caratteri
				:(mami_end)
mami	Pass = replace(Pass,ch_ma,ch_mi)	
mami_rt   mami   =  Pass                :(return)
mami_end


* Compiler.inc
* Gregory White <glwhite@netconnect.com.au>
* Posted to the Snobol list (March 2003)
* and adapted as a function
	DEFINE('COMPILER()')			:(COMPILER_END)
compiler
IDprocessor    :($('COMPILER' SIZE(DATE())))
COMPILER17 compiler 	= 'SPITBOL' 	:(return)
COMPILER19 compiler	= 'CSNOBOL4'	:(return)
COMPILER20 compiler	= 'SNOBOL4+'  	:(return)
compiler_end
* Uses the different size of DATE() to detect the compiler used


* SYSTYPE 
* Sets new_line value according to OS
* Guido Milanese <guido.milanese@unicatt.it>
* March 2003
	DEFINE('SYSTYPE()os')		:(SYSTYPE_END)
SYSTYPE os = replace(host(),&UCASE,&LCASE)
UNIX	os ? ('nix' | 'nux')		:f(DOS)
	systype = char(10)		:(return)		
DOS	systype = char(13) char(10)	:s(return)
SYSTYPE_END
* 'os' is the string returned by host(). 
* The function does not work under snobol4+, requires Spitbol or CSnobol4.

* NEWLINE
* Checks OS and compiler type to set newline
* Part of this function uses a function posted by
* Gregory White <glwhite@netconnect.com.au>
* on the Snobol list in March 2003
* Guido Milanese <guido.milanese@unicatt.it>
	define('newline()compiler_type')	
*-include "compiler.inc"
*-include "systype.inc"
					:(newline_end)
newline					
* Compiler being used. If it is Snobol4+, that does not have
* the HOST() function, assumes that the newline is Dos type
snobol4	(compiler_type = compiler()) ? "SNOBOL4+"   	:f(other)	
	newline	= char(13) char(10)			:(return)
* otherwise finds through HOST the OS type and sets newline
* accordingly
other	newline = systype()  				:(return)
newline_end	

******************************************
* 	NOPAIRS
*	Removes pairs
******************************************
* Guido Milanese 2004
* <guido.milanese@unicatt.it>
* Changes pairs in given string: all sequences of 2 given chars are changed to 1
* If second argument is not given, assumes to remove spaces
* Examples:
* String = nopairs(String,'-') ;* changes any sequence of 2 hyphens to 1 hyphen in String
* String = nopairs(String)     ;* changes any sequence of 2 spaces  to 1 space  in String
        define('nopairs(String,Char)')			:(nopairs_end)
nopairs	
	( ~(String ? Char) (terminal = "'" Char "' not found in '" String "'") )  :s(freturn)
	( (lt(size(Char),1) ) (Char = ' ') ) 
nopairs_loop	String ? (Char Char) = Char    	:s(nopairs_loop)
nopairs_return	nopairs  = String		      	:(return)	
nopairs_end


* REPL.inc - REPL(S1,S2,S3) will do a string-by-string replacement
*	     (as opposed to a character-by-character replacement
*	     ala REPLACE) on the string S1.  The string S1 is scanned
*	     for instances of the string S2  and each is replaced by
*	     S3.  Portions of S1 already scanned and the replaced
*	     string are not reexamined for instances of S2.
*
*-INCLUDE "breakx.inc"
	DEFINE('REPL(S1,S2,S3)C,T,FINDC')	:(REPL_END)
REPL	S2   LEN(1) . C  =			:F(FRETURN)
	FINDC  =  BREAK(C) . T  LEN(1)
	S2  =  POS(0)  S2
REPL_1	S1   FINDC  =				:F(REPL_2)
	S1   S2  =				:F(REPL_3)
	REPL  =  REPL  T  S3			:(REPL_1)
REPL_3	REPL  =  REPL  T  C			:(REPL_1)
REPL_2	REPL  =  REPL  S1			:(RETURN)
REPL_END