*COPAC-CLEAN-LIB. Library files for COPAC-CLEAN. *Version 0.8 28.08.2015 *Copyright (C) Guido Milanese * * 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 * compiler * GREGORY WHITE * other functions * GUIDO MILANESE * 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 * * 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 * 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 * 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 * on the Snobol list in March 2003 * Guido Milanese 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 * * 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