From e0c6872cf40896c7be36b11dcc744620f10adf1d Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 2 Sep 2019 13:46:59 +0900 Subject: Initial commit --- support/copac-clean/copac-clean-lib.inc | 229 ++++++++++++++++++++++++++++++++ 1 file changed, 229 insertions(+) create mode 100644 support/copac-clean/copac-clean-lib.inc (limited to 'support/copac-clean/copac-clean-lib.inc') diff --git a/support/copac-clean/copac-clean-lib.inc b/support/copac-clean/copac-clean-lib.inc new file mode 100644 index 0000000000..edf2fcc9f1 --- /dev/null +++ b/support/copac-clean/copac-clean-lib.inc @@ -0,0 +1,229 @@ +*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 + + -- cgit v1.2.3