summaryrefslogtreecommitdiff
path: root/obsolete/indexing/corridx/bin/corridx.pas
diff options
context:
space:
mode:
Diffstat (limited to 'obsolete/indexing/corridx/bin/corridx.pas')
-rw-r--r--obsolete/indexing/corridx/bin/corridx.pas527
1 files changed, 527 insertions, 0 deletions
diff --git a/obsolete/indexing/corridx/bin/corridx.pas b/obsolete/indexing/corridx/bin/corridx.pas
new file mode 100644
index 0000000000..10b30c0be5
--- /dev/null
+++ b/obsolete/indexing/corridx/bin/corridx.pas
@@ -0,0 +1,527 @@
+{$H+}
+Program corridx;
+(*
+This makes corrections in a *.idx
+file created by Latex as a raw index
+
+in Latex we have these commands for making the index:
+
+\begin{verbatim}
+ % acronyms 2 Entries
+ \newcommand{\ia}[2]{#1 (#2)\index{acr #2@#2!#1}}
+ % chemical 1 Entry
+ \newcommand{\ic}[1]{#1\index{chem #1@#1}}
+ % general 1 Entry
+ \newcommand{\ig}[1]{#1\index{gen #1@#1}}
+ Example: \ia{Polyalkylene oxide}{PAO}
+
+\end{verbatim}
+
+
+To start the program
+
+with a command line parameter:
+
+in winedt use as command line
+
+c:\mypathto\corridx.exe "%P\%N.idx"
+ %P Input File's Path
+ %N Input File's Name
+
+
+Better put in your Windet directory and use:
+to be clarified work out how it works really
+
+% Exe('%B\Exec\MiKTeX\corridx.exe');
+%
+% Exe('%B\Exec\MiKTeX\TeX.edt');
+
+*)
+
+
+const
+
+cifn='in.txt';
+cofn='out.txt';
+ctfn='idx.tmp';
+clfn='idx.log';
+
+
+var
+ifn,ofn,tfn,lfn: shortstring;
+s,t,l: text;
+str: string;
+LineNumber : word;
+
+
+Procedure Message(str: shortstring);
+begin
+ if str='' then
+ begin
+ Writeln;
+ Writeln(l, str);
+ end
+ else
+ begin
+ Writeln('[',linenumber,'] ',str);
+ Writeln(l, '[',linenumber,'] ',str);
+ end;
+end;
+
+Procedure copytxt(str, tfn: shortstring);
+var
+ s,t: text;
+ c: char;
+begin
+ Message('Copy '+ str + ' to '+ tfn);
+ Assign(s,str);
+ Assign(t,tfn);
+ reset(s);
+ rewrite(t);
+ while not eof(s) do
+ begin
+ read(s,c);
+ write(t,c);
+ end;
+ close(s);
+ close(t);
+end;
+
+
+
+
+
+Procedure init;
+begin
+ LineNumber:=0; ;
+ ifn:=cifn;
+ ofn:=cofn;
+ tfn:=ctfn;
+ lfn:=clfn;
+if paramcount=1 then
+begin
+ ifn:=paramstr(1);
+ tfn:=paramstr(1)+'.tmp';
+ lfn:=paramstr(1)+'.log';
+ ofn:=ifn;
+end;
+ Assign(l,lfn);
+ rewrite(l);
+ Message('This is corridx');
+ Message('Preprocessor for the Latex File *.idx');
+ Message('');
+ Message('Program Info '+ paramstr(0));
+
+ Message('Input File is '+ ifn);
+ Message('Output File is '+ ofn);
+ Message('Temp File is '+ tfn);
+ Copytxt(ifn,tfn);
+ Assign(s,tfn);
+ Assign(t,ofn);
+ reset(s);
+ rewrite(t);
+end;
+
+Procedure finish;
+begin
+
+ close(s);
+ close(t);
+
+ Message('Finished corridx');
+ close(l);
+ if paramcount <> 1 then readln(input);
+
+end;
+
+
+Procedure Error(str: string);
+begin
+
+ close(s);
+ close(t);
+
+ Message('Error corridx');
+ Message(str);
+ Message('restoring input file');
+ Copytxt(tfn,ifn);
+ close(l);
+ readln(input);
+ halt;
+
+end;
+
+
+Procedure RepAll(var Mainstr: string; Findstr, Replacestr: string);
+var
+p: longint;
+begin
+p:=pos(Findstr,Mainstr);
+while p>0 do
+ begin
+ delete(Mainstr,p,length(findstr));
+ Insert(Replacestr, Mainstr,p);
+ p:=pos(Findstr,Mainstr);
+ end;
+end;
+
+
+
+Function Pagestr(var str: string):string;
+(*
+ Here we extract the page number enclosed in curled brackets
+ \indexentry{acr TDI@TDI!toluene diisocyanate }{49}
+*)
+
+var
+s: string;
+i, p: longint;
+
+begin
+ s:='{0}'; {Makeindex wants a valid pagenumber}
+ if pos('\section',str)>0 then
+ begin
+ Pagestr:=s;
+ Message('an index subheading');
+ exit;
+ end;
+ p:= pos('}{', str);
+ if p>0 then
+ begin
+ s:='';
+ for i:= p+1 to length(str) do s:=s+str[i];
+ end
+ else Error('no page string');
+ if s= '{}' then Error('invalid page string');
+ Pagestr:=s;
+end;
+
+
+Function Sortstr(var str: string):string;
+(*
+ Here we extract what is behind
+ '\indexentry{' up to '@'
+ \indexentry{acr TDI@TDI!toluene diisocyanate }{49}
+*)
+
+var
+s: string;
+i, p,q: longint;
+
+begin
+
+ s:='';
+ p:= length('\indexentry{');
+ q:= pos('@', str);
+ if (p>0) and (q>0) then
+ begin
+ inc(p);
+ dec(q);
+ for i:= p to q do s:=s+str[i];
+ end;
+ Sortstr:=s;
+end;
+
+
+Function BeforeSubentry(var str: string):string;
+(*
+ Here we extract what is behind
+ '\indexentry{' up to '!'
+ \indexentry{acr TDI@TDI!toluene diisocyanate }{49}
+*)
+
+var
+s: string;
+i, p,q: longint;
+
+begin
+ if pos('!',str)=0 then Error('no subindex');
+ s:='';
+
+ p:= length('\indexentry{');
+ q:= pos('!', str);
+ if (p>0) and (q>0) then
+ begin
+ inc(p);
+ dec(q);
+ for i:= p to q do s:=s+str[i];
+ end;
+ BeforeSubentry:=s;
+end;
+
+Function AfterSubentry(var str: string):string;
+(*
+ Here we extract what is behind
+ '!'up to '}{'
+ \indexentry{acr TDI@TDI!toluene diisocyanate }{49}
+*)
+
+var
+s: string;
+i, p,q: longint;
+
+begin
+ if pos('!',str)=0 then Error('no subindex');
+ s:='';
+ p:= pos('!', str);
+ q:= pos('}{', str);
+ if (p>0) and (q>0) then
+ begin
+ inc(p);
+ dec(q);
+ for i:= p to q do s:=s+str[i];
+ end;
+ AfterSubentry:=s;
+end;
+
+
+
+
+Function indexstr(var str: string):string;
+(*
+ Here we extract what is behind
+ '@'up to '}{'
+ \indexentry{acr TDI@TDI!toluene diisocyanate }{49}
+*)
+
+var
+s: string;
+i, p,q: longint;
+
+begin
+ s:='';
+ p:= pos('@', str);
+ q:= pos('}{', str);
+ if (p>0) and (q>0) then
+ begin
+ inc(p);
+ dec(q);
+ for i:= p to q do s:=s+str[i];
+ end;
+ Indexstr:=s;
+end;
+
+
+Function Subheading(var str: string):boolean;
+var
+b: boolean;
+s: string;
+begin
+
+ b:= (pos('\section',str)>0) or
+ (pos('\subsection',str)>0) or
+ (pos('\subsubsection',str)>0) or
+ (pos('\paragraph',str)>0);
+ subheading:=b;
+ if b then
+ begin
+ s:='\indexentry{'+Sortstr(str)+'@'+indexstr(str) +'}'+Pagestr(str);
+ str:=s;
+
+
+ end;
+end;
+
+
+
+
+Procedure CleanMath(var str: string);
+var
+ b: boolean;
+ i: longint;
+begin
+ b:=false;
+ for i:=1 to length(str) do
+ begin
+ if str[i] = '$' then b:= not b; {toggle b if a $ is in str}
+ if b then str[i]:= ' ';
+ end;
+
+end;
+
+Procedure CleanSoftHyphen(var str: string);
+begin
+ RepAll(str,'\-','');
+end;
+
+
+Procedure CleanNonLetter(var str: string);
+var
+ i: longint;
+begin
+ for i:=1 to length(str) do
+ begin
+ if str[i] in ['A'..'Z', 'a'..'z','~'] then else str[i]:= ' ';
+ end;
+
+end;
+
+
+Procedure CleanSingleLetter(var str: string);
+var
+ i: longint;
+begin
+ if str[2]=' ' then str[1]:=' '; {remove a leading non space}
+ for i:=2 to length(str)-1 do
+ begin
+ if (str[i-1] = ' ') and (str[i+1] = ' ') then str[i]:= ' ';
+ end;
+
+end;
+
+Procedure CleanPrefix(var str: string);
+begin
+{I want to clean some prefixes}
+ str:=lowercase(str);
+ Repall(str,
+ 'tert ',
+ ' ');
+
+ Repall(str,
+ 'sec ',
+ ' ');
+
+ Repall(str,
+ 'cis ',
+ ' ');
+
+ Repall(str,
+ 'trans ',
+ ' ');
+ Repall(str,
+ 'syn ',
+ ' ');
+
+ Repall(str,
+ 'anti ',
+ ' ');
+
+
+ Repall(str,
+ 'exo ',
+ ' ');
+
+ Repall(str,
+ 'endo ',
+ ' ');
+
+ Repall(str,
+ 'cyclo ',
+ ' ');
+
+ Repall(str,
+ 'spiro ',
+ ' ');
+
+end;
+
+
+Procedure CleanChem(var str: string);
+begin
+ CleanMath(str);
+ CleanNonLetter(str);
+ CleanSingleLetter(str);
+ CleanPrefix(str);
+end;
+
+
+Procedure SetFirstCap(var istr,sstr: string); {Indexstring and Sortstring}
+var
+s: string;
+i: longint;
+begin
+ s:=istr;
+ CleanChem(s);
+ sstr:=s;
+ repall(sstr,' ','');
+ sstr:=lowercase(sstr);
+ for i:= 1 to length(s) do if s[i] <> ' ' then
+ begin
+ istr[i]:= upcase(istr[i]);
+ exit;
+ end;
+
+end;
+
+Procedure Corracr(var str: string);
+var
+ pstr, istr, sstr: string;
+begin
+ if pos('\indexentry{acr',str)=1 then
+ begin
+ istr:=AfterSubentry(str);
+ pstr:=pagestr(str);
+ Setfirstcap(istr, sstr); {We do not use the sortstring here}
+ sstr:=Beforesubentry(str);
+ str:= '\indexentry{'+sstr+'!' + istr + '}' + pstr;
+
+ end;
+end;
+
+
+Procedure Corrchem(var str: string);
+var
+ pstr, istr, sstr: string;
+begin
+ if pos('\indexentry{chem',str)=1 then
+ begin
+ istr:=Indexstr(str);
+ pstr:=pagestr(str);
+ Setfirstcap(istr, sstr);
+
+ str:= '\indexentry{chem '+sstr+'@' + istr + '}' + pstr;
+
+ end;
+end;
+
+
+Procedure Corrgen(var str: string);
+var
+ i,p: longint;
+begin
+
+ if pos('\indexentry{gen',str)=1 then
+ begin
+ if pos('!',str) >0 then message('A subentry in general index');
+ p:=pos('@',str);
+ if p > 0 then
+ begin
+ {We look only to make small case before '@'}
+ for i:= 13 to p do str[i]:= lowercase(str[i]);
+ {We look only to capitalize the first letter after '@'}
+ for i:= p to length(str) do if str[i] in ['A'..'Z', 'a'..'z'] then
+ begin
+ str[i] :=Upcase(str[i]); exit;
+ end;
+ end;
+ end;
+end;
+
+
+
+begin
+
+ init;
+ Message('start processing');
+ Message('from '+tfn+' into '+ofn);
+ while not eof(s)
+ do
+ begin
+ readln(s,str);
+ inc(LineNumber);
+ if pos('}{',str)=0 then Error('no pagestring');
+ if pos('@',str)=0 then Error('no sortstring');
+ CleanSoftHyphen(str);
+ if not subheading(str) then
+ begin
+ corracr(str);
+ corrchem(str);
+ corrgen(str);
+ end;
+ writeln(t,str);
+ end;
+
+ finish;
+
+
+end.