Subversion Repositories

?revision_form?Rev ?revision_input??revision_submit??revision_endform?

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 magnus 1
#!/usr/bin/perl
2
# Copyright (c) 2002-2014 Sampo Kellomaki (sampo@iki.fi). All Rights Reserved.
3
# This is free software. You may distribute under GPL. NO WARRANTY.
4
#
5
# PlainDoc to LaTeX, DocBook, and HTML converter
6
# http://zxid.org/plaindoc/pd.html
7
#
8
# $Id: pd2tex,v 1.55 2009-11-10 23:28:31 sampo Exp $
9
# xx.xx.1999, created, Sampo Kellomaki <sampo@iki.fi>
10
# 3.2.2002, complete rewrite --Sampo
11
# (snip -- see ChangeLog)
12
# 10.11.2009, patch from Octavio Alvarez <alvarezp.at.alvarezp.com>
13
# 12.1.2010,  Improvements to the blogging system and multipage HTML --Sampo
14
# 29.1.2011,  Tweaks and minor bug fixes --Sampo
15
# 29.3.2011,  Added a <<csv: >> feature --Sampo
16
# 2.2.2012,   Render Latin1 special chars using math mode --Sampo
17
# 30.1.2013,  Moved .tex and spell.words temp files to tex/ subdirectory --Sampo
18
# 8.2.2013,   Fixed RTF support --Sampo
19
# 27.4.2013,  .nonl support and added <<multicol*: >> construct --Sampo
20
# 21.2.2014,  Added pdseal support --Sampo
21
#
22
# Usage: ./pd2tex foo.pd
23
#
24
# Document contains (document can be considered as a special top level section)
25
#   - <<special: constructs>>
26
#   - anything that a section can contain
27
#
28
# Sections and subsections can contain
29
#   - lower level subsections (identified by underlining)
30
#   - anything that body can contain
31
#   - direct descendants must be top level lists
32
#
33
# List items are identified by level of indent and can contain
34
#   - anything that body can contain
35
#   - list can contain only lower level lists (more indent)
36
#   - list can never contain sections or subsections. Appearence of a section terminates list
37
#   - decrease in level of indent terminates list
38
#   - list items can be single line or multiline, with same indent
39
#
40
# Body text can contain
41
#   - lists (no list can not span (sub)sections)
42
#     - * bulleted lists
43
#     - 1. number lists
44
#     - a. alpha lists
45
#     - definition:: lists (subsequent lines must be indented by 4 chars)
46
#   - <<table: Caption text ...>>
47
#   - <<img: file.eps: Caption text>>
48
#       N.B. The best way to produce diagram drawings is to use dia for drawing
49
#       and export as .eps. Then run `epstopdf file.eps'. Only problem with this
50
#       method is that there is no control of image size. Thus the eps must already
51
#       be the correct size. Apparently the best way to accomplish this is to
52
#       use the dia File->Page Setup->Scale option to reduce the image (e.g. 70%).
53
#   - code, identified by indent
54
#   - para, if nothing special indicates otherwise
55
#   - body terminates if
56
#     - indent level decreases
57
#     - something looking like section is found
58
#
59
# Table contains cells defined by special syntax. Each cell content is treated as a para
60
#
61
# Para can contain
62
#   - *bold*, +italic+, ~code~
63
#   - inline <<image.gif>>
64
#   - www.foo.com and email@foo.com links (autodetected)
65
#   - [references]
66
#   - paragraphs are separated by empty lines (and special constructs?)
67
#
68
# Code section starts at given level of indent and continues until less indented
69
# line. Lines in between may be more indented if needed.
70
#
71
# Lists and indent (| = current indent, : = parent's indent; lesser indent terminates construct)
72
# 1.: parent list
73
#   :a.|same level
74
#   :b.|same level
75
#   :  |* sublist
76
#   :  |* sub
77
#   :c.|same level (terminates sub)
78
#   :  |* sub
79
# 2.: next parent item
80
#
81
# Book printing
82
#  pd2tex r-slim.pd
83
#  pdftops
84
#  psbook r-slim.ps r-slim-book.ps # omit -s for best result
85
#  mpage -o -2 -j1%2 -P r-slim-book.ps  # odd sheets
86
#  # HP4100: rotate output by 180 degrees and put in input tray with image up (p. 1)
87
#  mpage -o -2 -j2%2 -P r-slim-book.ps  # even sheets
88
#  # invert order of output, fold, and staple in middle
89
#
90
# http://www.biblioscape.com/rtf15_spec.htm
91
#
92
# Latex tips
93
# ==========
94
#   Too deeply nested   Apparently this really means what it says. Maybe something not closing?
95
#   Float too large     Picture or table is too large to fit in available space on page. Ignore.
96
#   Overfull \vbox      Means that something didn't really fit. May cause misformatting. Ignore.
97
#   Missing $ inserted  Automatic switch to math mode: char (e.g. under score) only allowed
98
#                       in math mode was seen and LaTeX "helpfully" switches to math mode.
99
# \usepackage{lineno} \linenumbers: Use 'lineno' as moreopt parameter of <<class: >>
100
# \hspace{\fill}  Right align rest of line
101
 
102
$usage = <<USAGE;
103
Usage: pd2tex mydoc.pd  # Generate mydoc.tex, mydoc.pdf, mydoc.dbx, and mydoc.html
104
       pd2tex -acroread mydoc.pd  # Regenerate document and preview it
105
       pd2tex <mydox.pd >mydoc.tex       # filter mode
106
       pd2tex -dbx <mydoc.pd >mydoc.dbx  # filter mode for DocBook
107
       pd2tex -verify <plaintext         # Verify PDSEAL
108
 
109
Options:
110
  -dbx        Invokes DocBook filter mode
111
  -html       Invokes HTML filter mode (must make subdirectory html)
112
  -gensafe    Convert images from ps, eps, dot, or dia to pdf only if no pdf (default)
113
  -gendep     Convert from ps, eps, dot, or dia to pdf based on time stamps
114
  -genforce   Force conversion of images from ps, eps, dot, or dia to pdf
115
  -nogen      Prevent conversion of images from ps, eps, dot, or dia to pdf
116
  -notex      Prevent .tex output in normal mode. Also prevents .pdf output.
117
  -nopdf      Prevent .pdf output in normal mode (.tex is still generated).
118
  -nodbx      Prevent .dbx output in normal mode
119
  -nohtml     Prevent .html output in normal mode
120
  -nohtml2    Prevent multipage .html output in normal mode
121
  -nortf      Prevent .rtf output in normal mode (.rtf is only poorly supported)
122
  -noref      Skip expensive reference resolution pass.
123
  -nohtmlpreamb  Prevent HTML preamble from being added
124
  -nosecnum   Prevent automatic section numbering
125
 
126
  -p          Same as -pdfonly
127
  -pdfonly    Only generate .tex and .pdf output (no .dbx, .html, or .rtf)
128
  -htmlonly   Only generate .html output (no .tex, .dbx, or .rtf)
129
  -html2only  Only generate multipage html (no .tex, .dbx, or .rtf)
130
 
131
  -fn         Omit footnotes.
132
  -FN         Force footnotes even on dbx (some dbx tools are broken wrt footnotes in lists)
133
  -n          Dry run. Do not alter files on disk.
134
  -acroread   Automatically launch acroread after processing the document
135
  -d DIR      Change current working directory to DIR
136
  -o path     Specify output path different from input
137
  -DMACRO=VAL Define a macro to have a value
138
  -verify     Verify a PDSEAL (e.g. paste text from PDF to stdin)
139
  -init       Create typical directory hierarchy used by pd2tex (tex, html, tmp, review)
140
USAGE
141
    ;
142
 
143
### Configure
144
 
145
$trace = 0;
146
$number = 0;  # Should sections and lists be explicitly numbered in dbx
147
$tex_col_wid_factor = 1.8;  # TeX: tweak the table/column width (mm per equals sign in underline)
148
$dbx_col_wid_factor = 0.08;  # DocBook: tweak the table/column width (inches per equals sign)
149
$hbadness = 2000;  # Do not warn for hbadness below this. See also tables which set this to 10000.
150
$imggen = 'safe';
151
$pipemode = 0;
152
$html2_split_threshold = 99;  # 99 = Always split
153
$fn_style = 1;   # 0 = omit (-fn), 1 = tex ok, dbx inline, 3 = both tex and dbx footnotes (-FN)
154
$maxlogline = 77;
155
$htmldir = 'html/';
156
$texdir = 'tex/';
157
$dbxdir = 'tex/';
158
$rtfdir = 'tex/';
159
$pdflag{'autoformat'} = 1;   # <<pdflags: autoformat=0>>
160
$pdflag{'showsgasxsd'} = 0;  # <<pdflags: showsgasxsd=1>>
161
$pdflag{'stripsecnum'} = 1;  # <<pdflags: stripsecnum=0>>
162
$pdflag{'secnum'} = 1;       # <<pdflags: secnum=0>>
163
 
164
### Process command line options
165
 
166
while ($ARGV[0] =~ /^-/) {
167
    $f = $ARGV[0];
168
    if ($f eq '-acroread') { shift; $acroread = 1; next; }
169
    if ($f eq '-dbx')      { shift; $dbx_filter = 1; next; }
170
    if ($f eq '-html')     { shift; $html_filter = 1; next; }
171
    if ($f eq '-gensafe')  { shift; $imggen = 'safe'; next; }
172
    if ($f eq '-gendep')   { shift; $imggen = 'dep'; next; }
173
    if ($f eq '-genforce') { shift; $imggen = 'force'; next; }
174
    if ($f eq '-pdfonly' || $f eq '-p') { shift; $nodbx=$nortf=$nohtml=$nohtml2=1; next; }
175
    if ($f eq '-htmlonly') { shift; $nodbx=$nortf=$notex=$nohtml2=1; next; }
176
    if ($f eq '-html2only'){ shift; $nodbx=$nortf=$nohtml=$notex=1; next; }
177
    if ($f eq '-nogen')    { shift; $imggen = ''; next; }
178
    if ($f eq '-notex')    { shift; $notex = 1; next; }
179
    if ($f eq '-nopdf')    { shift; $nopdf = 1; next; }
180
    if ($f eq '-nodbx')    { shift; $nodbx = 1; next; }
181
    if ($f eq '-nohtml')   { shift; $nohtml = 1; next; }
182
    if ($f eq '-nohtml2')  { shift; $nohtml2 = 1; next; }
183
    if ($f eq '-nortf')    { shift; $nortf = 1; next; }
184
    if ($f eq '-noref')    { shift; $noref = 1; next; }
185
    if ($f eq '-nopipe')   { shift; $pipemode = 0; next; }
186
    if ($f eq '-pipe')     { shift; $pipemode = 1; next; }
187
    if ($f eq '-nosecnum') { shift; $pdflag{'secnum'} = 0; next; }
188
    if ($f eq '-nohtmlpreamb') { shift; $nohtmlpreamb = 1; next; }
189
    if ($f eq '-htmldir')  { shift; $htmldir = shift; next; }
190
    if ($f eq '-epstopng') { shift; epstopng($ARGV[0], $ARGV[1]); exit; }
191
    if ($f eq '-n')        { shift; $dryrun = 1; next; }
192
    if ($f eq '-fn')       { shift; $fn_style = 0; next; }  # omit footnotes
193
    if ($f eq '-FN')       { shift; $fn_style = 3; next; }  # force dbx footnotes
194
    if ($f eq '-t')        { shift; ++$trace; next; }
195
    if ($f eq '-d')        { shift; chdir shift; next; }
196
    if ($f eq '-o')        { shift; $base = shift; next; }
197
    if ($f =~ /^-D(\w+)(?:=(.*))?$/) { $mac{$1} = $cmdline_mac{$1} = $2; shift; next; }
198
    if ($f eq '-init')     {
199
       #mkdir "corners";
200
       mkdir '.pd';    # Private temp files (like tmp, but newer)
201
       mkdir 'tex';
202
       mkdir $htmldir;
203
       mkdir 'review';
204
       mkdir 'tmp';    # See also .pd
205
       exit;
206
    }
207
    if ($f eq '-verify')   {
208
	undef $/;
209
	$x = <STDIN>;
210
	($pdseal,$sha1) = $x =~ /(PDSEAL1([A-Za-z0-9_.-]+))/;
211
	$x =~ s/PDSEAL1[A-Za-z0-9_.-]+//;
212
	die "pdseal($pdseal) is wrong length" if length $pdseal != 7+28;
213
	$x = pdseal1($x);
214
	die "pdseal($pdseal) mismatch($x) normalized_form($pdseal_norm)" if $pdseal ne $x;
215
	warn "OK: pdseal($pdseal) matches.\n";
216
	exit;
217
    }
218
    die "Unknown argument `$f'\n$usage";
219
}
220
 
221
if (@ARGV) {  # Not filter mode: input file name is an argument
222
    $file = shift;
223
    $base ||= $file;
224
    $base =~ s/\.pdf?$//i;
225
    $base =~ s/tex\///i;
226
    open STDIN,"<$file" or die "Cannot read input file $file: $!";
227
    open NONL,">$texdir$base.nonl"; # output where newlines are stripped to ease importing to Word
228
    open PDSEAL,">$texdir$base.seal"; # output in pdseal hashable format
229
    if ($notex || $dryrun) {
230
	open TEX,">/dev/null";
231
	open BIB,">/dev/null";
232
	$nopdf = 1;
233
    } else {
234
	unlink "$texdir$base.tex";  # in case stray pipe was left over from previous iteration
235
	if ($pipemode) {
236
	    # Since LaTeX apparently does not support reading input from stdin, we fool
237
	    # it by creating a named pipe. This allows us to interperse the pd2tex error
238
	    # output with the messages from LaTeX.
239
	    if ($enabib) {
240
		open BIB,">$texdir$base.bib" or die "Cannot write $texdir$base.bib: $!";
241
	    }
242
	    open TEX,">$texdir$base.tex" or die "Cannot write $texdir$base.tex: $!";
243
	    warn "Writing $texdir$base.tex";
244
	    if (-d 'tex') {
245
		select TEX; $| = 1; select STDOUT;
246
		if (!($texpid = fork)) {
247
		    die "fork (for pdflatex) failed: $!" if !defined($texpid);
248
		    chdir $texdir;
249
		    select(undef,undef,undef,0.250);
250
		    warn "pdflatex -file-line-error-style -interaction=errorstopmode $base.tex";
251
		    exec "pdflatex -file-line-error-style -interaction=errorstopmode $base.tex";
252
		    die "exec pdflatex failed: $!";
253
		}
254
	    } else {
255
		warn "WARNING: For pdflatex post processing tex subdirectory is needed. Create using pd2tex -init (or mkdir tex)\n";
256
	    }
257
	    #open TEX,"|pdflatex -file-line-error-style -interaction=errorstopmode - >$base.pdf"
258
	    #	or die "Cannot open pipe to pdflatex: $!";
259
	} else {
260
	    ### This is the normal case when you invoke: pd2text foo.pd
261
	    if ($enabib) {
262
		open BIB,">$texdir$base.bib" or die "Cannot write $texdir$base.bib: $!";
263
	    }
264
	    open TEX,">$texdir$base.tex" or die "Cannot write $texdir$base.tex: $!";
265
	    warn "Writing $texdir$base.tex";
266
	}
267
    }
268
    if ($nohtml || $dryrun) {
269
	open HTML,">/dev/null";
270
    } else {
271
	if (!length($htmldir) || -d $htmldir) {
272
	    $html1 = "$base.html";
273
	    open HTML,">$htmldir$html1" or die "Cannot write $htmldir$html1: $!";
274
	    warn "Writing $htmldir$html1";
275
	} else {
276
	    warn "WARNING: For HTML conversion to work, you must create subdirectory called html. E.g. pd2tex -init (or mkdir html)";
277
	    open HTML,">/dev/null";
278
	    $html1 = undef;
279
	}
280
    }
281
    if ($nohtml2 || $dryrun) {
282
	open HTML2,">/dev/null";
283
	$html2 = undef;
284
    } else {
285
	if (!length($htmldir) || -d $htmldir) {
286
	    $html2 = "$base-front-matter.html";
287
	    open HTML2,">$htmldir$html2" or die "Cannot write $htmldir$html2: $!";
288
	    warn "Writing $htmldir$html2";
289
	} else {
290
	    warn "WARNING: For HTML conversion to work, you must create subdirectory called html. E.g. mkdir html";
291
	    open HTML2,">/dev/null";
292
	    $html2 = undef;
293
	}
294
    }
295
    if ($nodbx || $dryrun) {
296
	open DBX,">/dev/null";
297
    } else {
298
	open DBX,">$dbxdir$base.dbx" or die "Cannot write $dbxdir$base.dbx: $!";
299
	warn "Writing $dbxdir$base.dbx";
300
    }
301
    if ($nortf || $dryrun) {
302
	open RTF,">/dev/null";
303
    } else {
304
	open RTF,">$rtfdir$base.rtf" or die "Cannot write $rtfdir$base.rtf: $!";
305
	warn "Writing $rtfdir$base.rtf";
306
    }
307
} else {
308
    if ($dbx_filter) {
309
	open BIB,">/dev/null";
310
	open TEX,">/dev/null";
311
	open DBX,">&STDOUT";
312
	open RTF,">/dev/null";
313
	open NONL,">/dev/null";
314
	open PDSEAL,">/dev/null";
315
	open HTML,">/dev/null";
316
	open HTML2,">/dev/null";
317
	$html2 = undef;
318
    } elsif ($html_filter) {
319
	open BIB,">/dev/null";
320
	open TEX,">/dev/null";
321
	open DBX,">/dev/null";
322
	open RTF,">/dev/null";
323
	open NONL,">/dev/null";
324
	open PDSEAL,">/dev/null";
325
	open HTML,">&STDOUT";
326
	open HTML2,">/dev/null";
327
	$html2 = undef;
328
    } else {
329
	open BIB,">/dev/null";
330
	open TEX,">&STDOUT";
331
	open DBX,">/dev/null";
332
	open RTF,">/dev/null";
333
	open NONL,">/dev/null";
334
	open PDSEAL,">/dev/null";
335
	open HTML,">/dev/null";
336
	open HTML2,">/dev/null";
337
	$html2 = undef;
338
    }
339
    $nopdf = 1;
340
}
341
 
342
# Exceptions to the two letter country code recognition
343
%not_a_country = ( pl=>'perl', cc=>'c++', hh=>'c++ hdr', sh=>'Shell',
344
		   ds=>'DirectoryScript', pd=>'PlainDoc', so=>'Shared Object' );
345
 
346
# Exceptions to dot designates path rule
347
%not_a_path = ( 'i.e'=>1, 'e.g'=>1, 'p.ex'=>1, 'E.U'=>1, 'U.E'=>1, 'U.S'=>1,
348
		'and/or'=>1, 'AND/OR'=>1, 'e/ou'=>1, 'ja/tai'=>1,
349
		'c.d'=>1, 'n.b' => 1, 'N.B'=>1, 'S.A'=>1, 'n/a'=>1);
350
 
351
$encoding = 'UTF-8';  # only for dbx
352
#$encoding = 'Latin1';
353
#$code_tag = 'literallayout';
354
$code_open_tag = '<programlisting format="non-normative-code"><computeroutput>';   # used for indented code blocks
355
$code_close_tag = '</computeroutput></programlisting>';   # used for indented code blocks
356
$tag_tag = 'command';
357
%dbx_list_open = (
358
'1' => qq(<orderedlist>\n),
359
'a' => qq(<orderedlist numeration="loweralpha">\n),
360
'A' => qq(<orderedlist numeration="upperalpha">\n),
361
'i' => qq(<orderedlist numeration="loweralpha">\n),
362
'I' => qq(<orderedlist numeration="loweralpha">\n),
363
'*' => qq(<itemizedlist mark="bullet">\n),
364
'-' => qq(<itemizedlist mark="hyphen">\n),
365
'+' => qq(<itemizedlist mark="plus">\n),
366
'o' => qq(<itemizedlist mark="opencircle">\n),
367
':' => qq(<variablelist>\n),  #  termlength="20"
368
);
369
%dbx_list_close = (
370
'1' => qq(</orderedlist>\n\n),
371
'a' => qq(</orderedlist>\n\n),  'A' => qq(</orderedlist>\n\n),
372
'i' => qq(</orderedlist>\n\n),  'I' => qq(</orderedlist>\n\n),
373
'*' => qq(</itemizedlist>\n\n), '-' => qq(</itemizedlist>\n\n),
374
'+' => qq(</itemizedlist>\n\n), 'o' => qq(</itemizedlist>\n\n),
375
':' => qq(</variablelist>\n\n),
376
);
377
 
378
# html
379
 
380
%html_list_open = (
381
'1' => qq(<ol>\n),
382
'a' => qq(<ol>\n),    'A' => qq(<ol>\n),
383
'i' => qq(<ol>\n),    'I' => qq(<ol>\n),
384
'*' => qq(<ul>\n),    '-' => qq(<ul>\n),
385
'+' => qq(<ul>\n),    'o' => qq(<ul>\n),
386
':' => qq(<dl>\n),
387
);
388
%html_list_close = (
389
'1' => qq(</ol>\n\n),
390
'a' => qq(</ol>\n\n), 'A' => qq(</ol>\n\n),
391
'i' => qq(</ol>\n\n), 'I' => qq(</ol>\n\n),
392
'*' => qq(</ul>\n\n), '-' => qq(</ul>\n\n),
393
'+' => qq(</ul>\n\n), 'o' => qq(</ul>\n\n),
394
':' => qq(</dl>\n\n),
395
);
396
 
397
# rtf
398
 
399
%ord_mark = (
400
'1' => [ qw(0 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) ],
401
'a' => [ qw(a b c d e f g h i j k l m n o p q r s t u v w x y z) ],
402
'A' => [ qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z) ],
403
'i' => [ qw(i ii iii iv v vi vii viii ix x xi xii xiii xiv xv xvi xvii xviii xix xx) ],
404
'I' => [ qw(I II III IV V VI VII VIII IX X XI XII XIII XIV XV XVI XVII XVIII XIX XX) ],
405
);
406
 
407
$rtf_tabs = '\tx720 \tx1440 \tx2160 \tx2880';
408
 
409
%rtf_styles = (
410
'ds1' => 'SEC1;',
411
'ds2' => 'SEC2;',
412
'ds3' => 'SEC3;',
413
'ds4' => 'SEC4;',
414
'ds5' => 'SEC5;',
415
'ds6' => 'SEC6;',
416
 
417
's1' => '\sa360 \keepn \fs48 \b H1;',
418
's2' => '\sa320 \keepn \fs36 \b H2;',
419
's3' => '\sa280 \keepn \fs30 \b H3;',
420
's4' => '\sa220 \keepn \fs24 \b H4;',
421
's5' => '\sa220 \keepn \fs24 \b H5;',
422
's6' => '\sa220 \keepn \fs24 \b H6;',
423
 
424
's10' => '\sa360 para;',
425
's14' => '\qc \sa360 \fs56 \b Title;',
426
's15' => '\qc \sa360 \i Author;',
427
's16' => '\qj \sa360 \li720 \ri720 \i Abstract;',
428
 
429
's21' => '\sa180 \qj \li360 \ri360 blockquote1;',
430
's22' => '\sa180 \qj \li720 \ri720 blockquote2;',
431
's23' => '\sa180 \qj \li1080 \ri1080 blockquote3;',
432
's24' => '\sa180 \qj \li1440 \ri1440 blockquote4;',
433
 
434
's31' => $rtf_tabs . ' \sa180 \li720 \ri180 \fi-720 list1;',
435
's32' => $rtf_tabs . ' \sa180 \li1440 \ri180 \fi-720 list2;',
436
's33' => $rtf_tabs . ' \sa180 \li2160 \ri180 \fi-720 list3;',
437
's34' => $rtf_tabs . ' \sa180 \li2880 \ri180 \fi-720 list4;',
438
	       );
439
 
440
%rtf_list_item = (
441
'1' => qq({\\pn \\pnlvl!!N !!M. ),
442
'a' => qq({\\pn \\pnlvl!!N !!M. ),    'A' => qq({\\pn \\pnlvl!!N !!M. ),
443
'i' => qq({\\pn \\pnlvl!!N !!M. ),    'I' => qq({\\pn \\pnlvl!!N !!M. ),
444
#'*' => qq({\\par \\pard \\bullet ),   '-' => qq(\\par \\pard - ),
445
'*' => qq({\\pn \\pnlvl!!N \\pnlvlblt {\\pntxtb \\bullet} ),   '-' => qq({\\pn \\pnlvl!!N \\pnlvlblt {\\pntxtb -} ),
446
'+' => qq({\\pn \\pnlvl!!N \\pnlvlblt {\\pntxtb +} ),   'o' => qq({\\pn \\pnlvl!!N \\pnlvlblt {\\pntxtb o} ),
447
) if 0;
448
 
449
%rtf_list_item = (
450
'1'=>"{\\pard !!S \\s3!!N\n!!M.\\tab ",
451
'a'=>"{\\pard !!S \\s3!!N\n!!M.\\tab ",  'A'=>"{\\pard !!S \\s3!!N\n!!M.\\tab ",
452
'i'=>"{\\pard !!S \\s3!!N\n!!M.\\tab ",  'I'=>"{\\pard !!S \\s3!!N\n!!M.\\tab ",
453
'*'=>"{\\pard !!S \\s3!!N\n\\'b7\\tab ", '-'=>"{\\pard !!S \\s3!!N\n-\\tab ",
454
'+'=>"{\\pard !!S \\s3!!N\n+\\tab ",     'o'=>"{\\pard !!S \\s3!!N\no\\tab ",
455
) if 1;
456
 
457
$enum = 'enumerate';
458
#$enum = 'denseenum';
459
$itemize = 'itemize';
460
#$itemize = 'denseitemize';
461
 
462
%tex_list_open = (
463
'1' => qq(\\begin{$enum}[1.]\n),
464
'a' => qq(\\begin{$enum}[a.]\n),  'A' => qq(\\begin{$enum}[A.]\n),
465
'i' => qq(\\begin{$enum}[i.]\n),  'I' => qq(\\begin{$enum}[I.]\n),
466
'*' => qq(\\begin{$itemize}\n),   '-' => qq(\\begin{$itemize}\n),
467
'+' => qq(\\begin{$itemize}\n),   'o' => qq(\\begin{$itemize}\n),
468
':' => qq(\\begin{description}\n),
469
);
470
%tex_list_item = (
471
'1' => qq(\\item ),
472
'a' => qq(\\item ),	      'A' => qq(\\item ),
473
'i' => qq(\\item ),	      'I' => qq(\\item ),
474
'*' => qq(\\item ),	      '-' => qq(\\item[-] ),
475
'+' => qq(\\item[+] ),	      'o' => qq(\\item[o] ),
476
':' => qq(\\item[notused]\n),
477
);
478
%tex_list_close = (
479
'1' => qq(\\end{$enum}\n\n),
480
'a' => qq(\\end{$enum}\n\n),      'A' => qq(\\end{$enum}\n\n),
481
'i' => qq(\\end{$enum}\n\n),      'I' => qq(\\end{$enum}\n\n),
482
'*' => qq(\\end{$itemize}\n\n),   '-' => qq(\\end{$itemize}\n\n),
483
'+' => qq(\\end{$itemize}\n\n),   'o' => qq(\\end{$itemize}\n\n),
484
':' => qq(\\end{description}\n\n),
485
);
486
 
487
%tex_align = ( l => '', r => '\\hfill ', c => '\\centering' ); # , '' => ' \\raggedright'
488
%th_align  = ( l => ' align=left', r => ' align=right', c => '' );
489
%td_align  = ( l => '',            r => ' align=right', c => ' align=center' );
490
 
491
$class = 'article';
492
$tex_doc_class = "\\documentclass[12pt]{article}\n";
493
 
494
# See also <<texsections: ignore section* subsection* subsubsection* subsubsubsection* paragraph*>>
495
# N.B. subsubsubsection does not exist in all LaTeX document styles
496
#                             ====    ----       ~~~~          ^^^^
497
@tex_sec_article = qw( ignore section subsection subsubsection textbf paragraph );
498
@tex_sec_slide = qw( ignore section* subsection* subsubsection* subsubsubsection* paragraph* );
499
@tex_sec_book = qw( ignore chapter section subsection subsubsection subsubsubsection paragraph );
500
@tex_sec = @tex_sec_article;
501
#$tex_flt_place = '!hbp';
502
$tex_flt_place = '!hbt'; #Removed p because you usually do not want all the images in one page at the end of the chapter
503
$includegraphics = '\\includegraphics[width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio]';
504
$maketitle = '\\maketitle';
505
$moretexpreamble = <<LATEX;
506
\\setlength\\parskip{\\medskipamount}
507
\\setlength\\parindent{0pt}
508
\\lfoot{\\today}
509
\\cfoot{!?!AUTHOR}
510
\\rfoot{!?!HEADER_TITLE, p. \\thepage !?!AFTER_PAGE}
511
LATEX
512
    ;
513
$moretexpreamble_empty = <<LATEX;
514
\\setlength\\parskip{\\medskipamount}
515
\\setlength\\parindent{0pt}
516
LATEX
517
    ;
518
#\\lhead{}
519
#\\chead{}
520
#\\rhead{}
521
#\\lfoot{}
522
#\\cfoot{}
523
#\\rfoot{}
524
#LATEX
525
#    ;
526
 
527
$moretexpreamble_clean = <<LATEX;
528
\\setlength\\parskip{\\medskipamount}
529
\\setlength\\parindent{0pt}
530
\\lhead{}
531
\\chead{}
532
\\rhead{}
533
\\lfoot{}
534
\\cfoot{}
535
\\rfoot{}
536
\\pagestyle{empty}
537
LATEX
538
    ;
539
 
540
$moretexpreamble_confidential = <<LATEX;
541
\\setlength\\parskip{\\medskipamount}
542
\\setlength\\parindent{0pt}
543
\\lfoot{\\today\\\\Proprietary and Confidential. May contain privileged information.}
544
\\cfoot{\\copyright !?!COPYRIGHT}
545
\\rfoot{!?!HEADER_TITLE, p. \\thepage !?!AFTER_PAGE}
546
LATEX
547
    ;
548
 
549
$tex_boxed_tab = 1;
550
if ($tex_boxed_tab) {
551
    $tex_tab_hdr_sep = "\\\\\n\\hline\n\\hline\n";
552
    $tex_tab_line_sep = "\\\\\n\\hline\n";
553
    $tex_left_bar = '|';
554
    $tex_top_line = "\\hline\n";
555
    $tex_bot_line = "\\\\\n\\hline\n";
556
} else {
557
    $tex_tab_hdr_sep = "\\\\\n\\hline\n";
558
    $tex_tab_line_sep = "\\\\\n";
559
    $tex_left_bar = '';
560
    $tex_top_line = '';
561
    $tex_bot_line = '';
562
}
563
 
564
$toc_enable = '';
565
 
566
$dbxpreamble = <<DBX;  # <!ENTITY legalnotice SYSTEM "../legal/legalnotice-sg-1.0.dbx">
567
<?xml version="1.0" encoding="$encoding"?>
568
<!DOCTYPE article SYSTEM "../../src/dtd/libdocbook.dtd" [
569
    <!ENTITY % xinclude SYSTEM "../../src/dtd/xinclude.mod">
570
    %xinclude;
571
    <!ENTITY legalnotice SYSTEM "../legal/legalnotice-wsf-2.0.dbx">
572
]>
573
DBX
574
    ;
575
 
576
# N.B. in the following !?! indicates a variable that will be substituted near end of processing
577
 
578
$htmlpreamble2 = <<HTML2;
579
<title>!?!TITLE</title>
580
<link type="text/css" rel="stylesheet" href="!?!BASE.css">
581
<body bgcolor=white>
582
[<a href="!?!PREV">Prev</a>]<hr>
583
HTML2
584
		;
585
$htmlpostamble2 = qq(<hr>[<a href="!?!PREV" class=prevBut>Prev</a> | <a href="!?!NEXT" class=nextBut>Next</a>]<hr>\n);
586
 
587
### End configure
588
 
589
use Data::Dumper;
590
use POSIX qw(strftime);
591
$curdate = strftime "%e %b %Y", gmtime;
592
$yyyy = 1900 + (gmtime)[5];
593
 
594
### Expand all %include_pd() and %include_code() sections
595
 
596
sub readall {
597
    my ($f, $dont_die_on_unfound) = @_;
598
    unless (open X, "<$f") {
599
	if ($dont_die_on_unfound) {
600
	    warn "$i: Missing include file <<$f>>: $!";
601
	    warn `pwd`;
602
	    return "***missing file $f***";
603
	} else {
604
	    die "Cant read($f): $!";
605
	}
606
    }
607
    undef $/;     # warning: global effect
608
    my $x = <X>;
609
    close X;
610
    return $x;
611
}
612
 
613
sub writeall {
614
    my ($f,$x) = @_;
615
    open X, ">$f" or die "Cant write $f: $!";
616
    warn "Writing $f";
617
    print X $x;
618
    close X;
619
}
620
 
621
sub include {
622
    my ($prefix,$path,$ext) = @_;
623
    return "$prefix<<$path$ext>>" if $path =~ /^\w+:/; # Specials
624
    if ($ext =~ /^\.(svg)|(e?ps)|(png)|(gif)|(jpe?g)$/i) {       # Images
625
	warn(('-'x$inc_iter)." image: $path$ext\n");
626
	return "$prefix<<$path$ext>>";
627
    }
628
    #my $x = readall(($path=~m%^/%s) ? "$path$ext":"../$path$ext", 1);
629
    my $x = readall("$path$ext", 1);
630
    warn(('-'x$inc_iter)." <<include: $path$ext>> got ".length($x)." chars\n");
631
    $x =~ s/\r?\n<<EOF: .*?>>.*$//s;
632
    if ($prefix =~ /^\s+$/) {  # Verbatim block?
633
	$x =~ s/\n/\n$prefix/g;
634
	return $prefix . $x;
635
    } else {
636
	return $x;
637
    }
638
}
639
 
640
sub incl_range {
641
    my ($prefix,$path,$ext,$start,$end) = @_;
642
    my $x = readall($path.$ext, 1);
643
    my @lines = split /\r?\n/, $x;
644
    warn(('-'x$inc_iter)." <<includerange:$path$ext: $start-$end>> got ".length($x)." chars, $#lines lines\n");
645
    @lines = splice @lines, $start, $end-$start;
646
    $x = join "\n", @lines;
647
    if ($prefix =~ /^\s+$/) {  # Verbatim block?
648
	$x =~ s/\n/\n$prefix/g;
649
	return $prefix . $x;
650
    } else {
651
	return $x;
652
    }
653
}
654
 
655
sub hexit {
656
    my ($x,$tag) = @_;
657
    $x =~ s/(.)/sprintf("%02x",ord($1))/ges;
658
    return "^^^^^^^^$tag: $x~~~~~~~~" if $tag;
659
    return $x;
660
}
661
 
662
sub unhexit {
663
    my ($x) = @_;
664
    $x =~ s/(..)/chr(hex($1))/gsex;
665
    return $x;
666
}
667
 
668
sub def_macro {
669
    my ($name, $value) = @_;
670
    #die "def_macro($name,$value)";
671
    $mac{$name} = $value unless defined $cmdline_mac{$name};
672
    return '';
673
}
674
 
675
sub def_specific_macro {
676
    my ($name, $tex, $dbx, $htm, $rtfl) = @_;
677
    #warn "SPECIFIC MACRO tex($tex) dbx($dbx) html($html)";
678
    $mac{$name} = '';
679
    $mac{$name} .= hexit($tex, 'RAWTEX') if $tex;
680
    $mac{$name} .= hexit($dbx, 'RAWDBX') if $dbx;
681
    $mac{$name} .= hexit($rtf, 'RAWRTF') if $rtf;
682
    $mac{$name} .= hexit($html,'RAWHTML') if $html;
683
    #$tex_mac{$name} = $tex;
684
    #$dbx_mac{$name} = $dbx;
685
    #$html_mac{$name} = $html;
686
    return '';
687
}
688
 
689
sub extract_macros {
690
    # <<define: MACRO!value>>  <<define: MACRO=value>>
691
    #                      1   1    2     2
692
    $pd =~ s|\n<<define:\s+(\w+)[=!]([^>]+)>>|def_macro($1, $2)|gex;
693
    #$pd =~ s|\n<<define:\s+\w+.*?>>\s*\n|HErE|sg;
694
    #                            1   1    2 tex  2    3 dbx  3    4 html 4
695
    #$pd =~ s/\n<<definespecific: (\w+)(?:!([^!>]+)(?:!([^!>]+)(?:!([^!>]+))?)?)?>>/def_specific_macro($1, $2, $3, $4)/gex;
696
#                              1   1    2 tex 2 3 dbx 3 4 html 4
697
    $pd =~ s/\n<<definespecific:\s+(\w+)[!=]([^!]+)!([^!]+)!([^!]+?)>>/def_specific_macro($1, $2, $3, $4)/gex;
698
    $pd =~ s|\n<<default:\s+(\w+)!([^>]+)>>|def_macro($1, $2) if !defined $mac{$1}|gex;
699
}
700
 
701
###
702
### Read in file, expand includes, process conditionals
703
###
704
 
705
undef $/;
706
$pd = <STDIN>;
707
warn "original input: ".length($pd)." chars\n";
708
$pd =~ s|\n<<define1st:\s+(\w+)[=!]([^>]+)>>|def_macro($1, $2)|gex;
709
#extract_macros();  # First iteration, only -D macros are valid
710
for ($inc_iter = 1; $inc_iter <= 5; ++$inc_iter) { # 5 levels of include nesting
711
    #Remove lines beginning with % (by Fredrik Jonsson 070708)
712
    # Unfortunately this seems to interfere with verbatim includes, esp. sg --Sampo
713
    #$/ = "\n"; # Disable Slurp mode to find beginning of lines
714
    #$pd =~ s/^%.*//gm;  # % means TeX comment
715
    #undef $/;  # Enable Slurp mode again
716
 
717
    #         1   1                2  path   23 ext 3     4   4 5   5
718
    $pd =~ s{^(.*?)<<includerange: ([^\n>:]+?)(\.\w+)?:\s+(\d+)-(\d+)>>}
719
            {incl_range($1,$2,$3,$4,$5)}gem;
720
    $pd =~ s/^(.*?)<<([^\n>]+?)(\.\w+)?>>/include($1,$2,$3)/gem;
721
    $pd =~ s/<<ignore:\s+.*?>>[ \t]*//sg;  # Ignore blocks are omitted (eat trailing spaces, too)
722
 
723
    # Conditional processing (n.b. only macros from -D flags or <<define1st: >> can be tested)
724
    #                1   1  2   2            3   3
725
    $pd =~ s/<<if:\s+(\w+)>>(.*?)<<else:\s+>>(.*?)<<fi:\s+>>/$mac{$1}?$2:$3/gsex;
726
 
727
    extract_macros();
728
}
729
warn "input after includes and conditionals: ".length($pd)." chars\n";
730
 
731
### Figure out document class
732
 
733
$pagestyle = "\\usepackage{fancyhdr}\n\\pagestyle{fancy}\n";
734
 
735
($class,                         $optarg,    $lang,      $header_title, $after_page, $moreopt) =
736
    $pd =~ m/<<class:\s+(\w+)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*))?)?)?)?)?>>/s;
737
if ($class) {
738
    #warn "class($class) optarg($optarg) lang($lang) hdrtit($header_title) after_page($after_page) [$&]";
739
    $pd =~ s/<<class:\s+.*?>>//s;
740
    if ($class eq 'book') {
741
	warn "BOOK";
742
	@tex_sec = @tex_sec_book;
743
    } elsif ($class eq 'empty') {
744
	warn "EMPTY";
745
	$class = 'article';
746
	$moretexpreamble = $moretexpreamble_empty;
747
    } elsif ($class eq 'clean') {
748
	warn "CLEAN";
749
	$class = 'article';
750
	$moretexpreamble = $moretexpreamble_clean;
751
    } elsif ($class eq 'confidential') {
752
	warn "CONFIDENTIAL";
753
	$class = 'article';
754
	$moretexpreamble = $moretexpreamble_confidential;
755
    } elsif ($class eq 'slide') {
756
	warn "SLIDE";
757
	@tex_sec = @tex_sec_slide;
758
	$class = 'article';
759
	$optarg ||= '12pt';
760
	$paper = 'custom';
761
	$wid = '400pt';
762
	$ht = '300pt';
763
	$new_slide = "\n\\newpage\n\n";  # force page break before each section
764
	$lm = '5mm';
765
	$tm = '3mm';
766
	$rm = '5mm';
767
	$bm = '7mm';   # tall enough for 8mm logo art in footer
768
	$hh = '12pt';
769
	$hs = '5pt';
770
	$fh = '12pt';
771
	$fs = '14pt';
772
    }
773
    $tex_doc_class = "\\documentclass[$optarg]{$class}\n";
774
    $tex_doc_class .= "\\usepackage[$lang]{babel}\n\\selectlanguage{$lang}\n" if $lang;
775
}
776
 
777
if ($moreopt eq 'lineno') {
778
    $lineno = "\\usepackage{lineno}\n\\linenumbers";
779
}
780
 
781
### Custom paper size and margins (See LaTeX companion pp.89-90 (vmargin replaces vpage))
782
# <<papersize: empty!a4!landsacpe>>
783
# <<papersize: fancy!a4>>
784
# <<papersize: fancy!custom!dummy!WIDTHpt!HEIGHTpt!LM!TM!RM!BM!HEAD-HEIGHT!HEAD-SKIP!FOOT-HEIGHT!FOOT-SKIP>>
785
# <<papersize: fancy!custom!dummy!210mm!297mm!25mm!10mm!25mm!10mm!7mm!5mm!7mm!5mm>>
786
 
787
($headfootstyle,                     $paper2,    $orient,    $wid2,      $ht2,       $lm2,       $tm2,       $rm2,       $bm2,       $hh2,       $hs2,       $fh2,       $fs2) =
788
    $pd =~ m/<<papersize:\s+(\w+)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*))?)?)?)?)?)?)?)?)?)?)?)?>>/s;
789
$pd =~ s/<<papersize:\s+.*?>>//s;
790
 
791
$paper = $paper2 if $paper2;
792
$wid = $wid2 if $wid2;
793
$ht = $ht2 if $ht2;
794
 
795
$lm = $lm2 if $lm2;  # left margin
796
$tm = $tm2 if $tm2;  # top margin
797
$rm = $rm2 if $rm2;  # right margin
798
$bm = $bm2 if $bm2;  # bottom margin
799
$hh = $hh2 if $hh2;  # head height
800
$hs = $hs2 if $hs2;  # head sep
801
$fh = $fh2 if $fh2;  # foot height
802
$fs = $fs2 if $fs2;  # foot skip
803
 
804
if ($paper || $orient) {
805
    $vmargin ||= "\\usepackage{vmargin}\n";
806
    $paper ||= "Afour";
807
    if ($paper eq 'custom') {
808
	$vmargin .= "\\setpapersize{custom}{$wid}{$ht}\n";
809
    } else {
810
	$orient = "[$orient]" if $orient;
811
	$vmargin .= "\\setpapersize${orient}{$paper}\n";
812
    }
813
}
814
 
815
if ($lm || $tm || $rm || $bm) {
816
    $lm ||= '0mm';  # left margin
817
    $tm ||= '0mm';  # top margin
818
    $rm ||= '0mm';  # right margin
819
    $bm ||= '0mm';  # bottom margin
820
    $hh ||= '0mm';  # head height
821
    $hs ||= '0mm';  # head sep
822
    $fh ||= '0mm';  # foot height
823
    $fs ||= '0mm';  # foot skip
824
    $vmargin ||= "\\usepackage{vmargin}\n";
825
    $vmargin .= "\\setmarginsrb{$lm}{$tm}{$rm}{$bm}{$hh}{$hs}{$fh}{$fs}\n";
826
}
827
 
828
warn "vmargin($vmargin)";
829
 
830
if ($headfootstyle && $headfootstyle ne 'fancy') {
831
    $pagestyle = "\\pagestyle{$headfootstyle}\n";  # e.g. empty or plain
832
}
833
 
834
### Tweak paragraph and line spacing: <<linespace: LINESPACING!PARINDENT!PARSKIP>>
835
 
836
($linespacing,                          $parindent, $parskip) =
837
    $pd =~ m/<<linespace:\s+([^!>]*)(?:!([^!>]*)(?:!([^!>]*))?)?>>/s;
838
$pd =~ s/<<linespace:\s+.*?>>//s;
839
 
840
$linespace .= "\\renewcommand{\\baselinestretch}{$linespacing}\n" if $linespacing;
841
$linespace .= "\\setlength\\parindent{$parindent}\n" if $parindent;
842
$linespace .= "\\setlength\\parskip{$parskip}\n" if $parskip;
843
 
844
#die "pd($pd)";
845
 
846
$pd =~ s/<<cvsid:\s+(.*?)>>/$cvsid.="$1\n",''/ge;
847
($cvsfile, $cvsrevision, $cvsdate, $cvstime, $cvsuser) =
848
    $cvsid =~ /^\$Id:\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+/;
849
def_macro('CVSID', $cvsid);
850
def_macro('CVSFILE', $cvsfile);
851
def_macro('CVSREVISION', $cvsrevision);
852
def_macro('CVSDATE', $cvsdate);
853
def_macro('CVSTIME', $cvstime);
854
def_macro('CVSUSER', $cvsuser);
855
 
856
($author) = $pd =~ m/<<author:\s+(.*?)>>/;
857
$pd =~ s/<<author:\s+.*?>>//;
858
$author ||= 'N.N.';
859
#warn "author($author)";
860
def_macro('AUTHOR', $author);
861
 
862
($copyright) = $pd =~ m/<<copyright:\s+(.*?)>>/;
863
$pd =~ s/<<copyright:\s+.*?>>//;
864
$copyright ||= $author;
865
def_macro('COPYRIGHT', $copyright);
866
 
867
($top_id , $version) = $pd =~ m/<<version:(?:([\w-]+):)?\s+(.*?)>>/;
868
$pd =~ s/<<version:.*?>>//;
869
def_macro('VERSION', $version);
870
 
871
### Substitute macros
872
 
873
$pd =~ s/!!(\w+)(?:\?([^!]*)\?)?/$mac{$1}||$2/ge;
874
 
875
### Extract some special <<components>>
876
 
877
($x) = $pd =~ s%<<notapath:\s+(.*?)>>%for $x (split /[,\s]+/,$1)    { $not_a_path{$x}=1; }%gse;
878
($x) = $pd =~ s%<<notaurl:\s+(.*?)>>%for $x (split /[,\s]+/,$1)     { $not_a_url{$x}=1; }%gse;
879
($x) = $pd =~ s%<<notacountry:\s+(.*?)>>%for $x (split /[,\s]+/,$1) { $not_a_country{$x}=1; }%gse;
880
 
881
($abstract) = $pd =~ m/<<abstract:\s+(.*?)>>/s;
882
#warn "abstract $abstract"  if $trace;;
883
#$tex_abstract = "\\begin{quote} Abstract: ".tex_para($abstract)."\\end{quote}\n\n" if $abstract;
884
$tex_abstract = "\\begin{abstract}\n".tex_para($abstract)."\\end{abstract}\n\n" if $abstract;
885
$rtf_abstract = rtf_format($abstract) if $abstract;
886
$rtf_abstract =~ s/\n/\n /sg;
887
$nonl_abstract = $abstract;
888
$pdseal_abstract = $abstract;
889
$abstract =~ s%\r?\n\r?\n%^^^^/para~~~~\n^^^^para~~~~%sg;
890
$dbx_abstract = dbx_para($abstract);
891
$abstract =~ s%^^^^/para~~~~\n^^^^para~~~~%\n^^^^p~~~~%sg;
892
$html_abstract = html_para($abstract);
893
 
894
$pd =~ s/<<abstract:\s+.*?>>/<<tex:\n$tex_abstract>>/s;
895
 
896
($first_page) = $pd =~ m/<<1stpage:\s+(.*?)>>/s;
897
$pd =~ s/<<1stpage:\s+.*?>>//s;
898
 
899
($keywords) = $pd =~ m/<<keywords:\s+(.*?)>>/s;
900
$pd =~ s/<<keywords:\s+.*?>>//s;
901
$keywords =~ s{,\s*}{</keyword>\n<keyword>}gs;
902
 
903
($x) = $pd =~ m/<<texpreamble:\s+(.*?)>>/s;
904
$pd =~ s/<<texpreamble:\s+.*?>>//s;
905
$texpreamble = $x if $x;
906
$texpreamble =~ s/!\?!AUTHOR/$author/;
907
$texpreamble =~ s/!\?!HEADER_TITLE/$header_title/;
908
$texpreamble =~ s/!\?!AFTER_PAGE/$after_page/;
909
$texpreamble =~ s/!\?!COPYRIGHT/$copyright/;
910
$texpreamble =~ s/!\?!VERSION/$version/;
911
$texpreamble =~ s/!\?!TITLE/$doctitle/;      # *** $doctitle not defined yet
912
 
913
if ($pd =~ m/<<moretexpreamble:\s+.*?>>/s) {
914
    $moretexpreamble = '';
915
    $pd =~ s/<<moretexpreamble:\s+(.*?)>>/$moretexpreamble.=$1,''/gse;
916
}
917
$moretexpreamble =~ s/!\?!AUTHOR/$author/;
918
$moretexpreamble =~ s/!\?!HEADER_TITLE/$header_title/;
919
$moretexpreamble =~ s/!\?!AFTER_PAGE/$after_page/;
920
$moretexpreamble =~ s/!\?!COPYRIGHT/$copyright/;
921
$moretexpreamble =~ s/!\?!VERSION/$version/;
922
$moretexpreamble =~ s/!\?!TITLE/$doctitle/;      # *** $doctitle not defined yet
923
 
924
if ($pd =~ m/<<moremoretexpreamble:\s+.*?>>/s) {
925
    $pd =~ s/<<moremoretexpreamble:\s+(.*?)>>/$moremoretexpreamble.=$1,''/gse;
926
}
927
 
928
($x) = $pd =~ m/<<dbxpreamble:\s+(.*?)>>/s;
929
$pd =~ s/<<dbxpreamble:\s+.*?>>//s;
930
$dbxpreamble = $x if $x;
931
 
932
($x) = $pd =~ m/<<htmlpreamble:\s+(.*?)>>/s;
933
$pd =~ s/<<htmlpreamble:\s+.*?>>//s;
934
$htmlpreamble = $x if $x;
935
$htmlpreamble =~ s/!\?!AUTHOR/$author/;
936
$htmlpreamble =~ s/!\?!HEADER_TITLE/$header_title/;
937
$htmlpreamble =~ s/!\?!AFTER_PAGE/$after_page/;
938
$htmlpreamble =~ s/!\?!COPYRIGHT/$copyright/;
939
$htmlpreamble =~ s/!\?!VERSION/$version/;
940
$htmlpreamble =~ s/!\?!TITLE/$doctitle/;      # *** $doctitle not defined yet
941
 
942
($x) = $pd =~ m/<<htmlpostamble:\s+(.*?)>>/s;
943
$pd =~ s/<<htmlpostamble:\s+.*?>>//s;
944
$htmlpostamble = $x if $x;
945
$htmlpostamble =~ s/!\?!AUTHOR/$author/;
946
$htmlpostamble =~ s/!\?!HEADER_TITLE/$header_title/;
947
$htmlpostamble =~ s/!\?!AFTER_PAGE/$after_page/;
948
$htmlpostamble =~ s/!\?!COPYRIGHT/$copyright/;
949
$htmlpostamble =~ s/!\?!VERSION/$version/;
950
$htmlpostamble =~ s/!\?!TITLE/$doctitle/;      # *** $doctitle not defined yet
951
 
952
($x) = $pd =~ m/<<htmlpreamble2:\s+(.*?)>>/s;
953
$pd =~ s/<<htmlpreamble2:\s+.*?>>//s;
954
$htmlpreamble2 = $x if $x;
955
$htmlpreamble2 =~ s/!\?!AUTHOR/$author/;
956
$htmlpreamble2 =~ s/!\?!HEADER_TITLE/$header_title/;
957
$htmlpreamble2 =~ s/!\?!AFTER_PAGE/$after_page/;
958
$htmlpreamble2 =~ s/!\?!COPYRIGHT/$copyright/;
959
$htmlpreamble2 =~ s/!\?!VERSION/$version/;
960
$htmlpreamble2 =~ s/!\?!TITLE/$doctitle/;      # *** $doctitle not defined yet
961
 
962
($x) = $pd =~ m/<<htmlpostamble2:\s+(.*?)>>/s;
963
$pd =~ s/<<htmlpostamble2:\s+.*?>>//s;
964
$htmlpostamble2 = $x if $x;
965
$htmlpostamble2 =~ s/!\?!AUTHOR/$author/;
966
$htmlpostamble2 =~ s/!\?!HEADER_TITLE/$header_title/;
967
$htmlpostamble2 =~ s/!\?!AFTER_PAGE/$after_page/;
968
$htmlpostamble2 =~ s/!\?!COPYRIGHT/$copyright/;
969
$htmlpostamble2 =~ s/!\?!VERSION/$version/;
970
$htmlpostamble2 =~ s/!\?!TITLE/$doctitle/;      # *** $doctitle not defined yet
971
 
972
($additionalarticleinfodbx) = $pd =~ m/<<additionalarticleinfodbx:\s+(.*?)>>/s;
973
$pd =~ s/<<additionalarticleinfodbx:\s+.*?>>//s;
974
 
975
($odt_name, $x) = $pd =~ m/<<odtpreamble:\s+(\w+)\n(.*?)>>/s;
976
if ($x) {
977
    $pd =~ s/<<odtpreamble:\s+.*?>>//s;
978
    open ODT, ">$odt_name/content.xml" or die "Can not write ODT file '$odt_name/content.xml': $!";
979
    warn "Writing $odt_name/content.xml";
980
    print ODT $x;
981
} else {
982
    open ODT,">/dev/null";
983
}
984
 
985
($history_ena, $history_title, $x) = $pd =~ m/<<history:(\d:)?\s*(\S[^\n]*)?(.*?)>>/s;
986
$history = $x if $x; #           2 dd      mm      yy     3 auth   12.10.2005
987
@history = split qr{^([\d.-]+):: (\d+[./-]\d+[./-]\d+),\s+(.*?)\s*$}m, $history;
988
shift @history;
989
if (!@history) {
990
    #                              2 dd     mm      yy      12. October, 2005
991
    @history = split /^([\d.-]+):: (\d+\.\s+\w+,?\s+\d+),\s+(.*?)\s*$/m, $history;
992
    shift @history;
993
}
994
 
995
if ($history) {
996
    if ($history_title =~ /^\d/) {
997
	# *** Process "2.4.2005, description, --Author" style history
998
    }
999
    $tex_history = $history_title ? "\\subsubsection*{$history_title}" : '';
1000
    $tex_history .= qq({\\small\n\\begin{description});
1001
    for ($j=0; $j<$#history; $j+=4) {
1002
	$tex_revdesc = $history[$j+3];
1003
	$tex_revdesc =~ s%^\s+\*%\\item%gm;
1004
 
1005
	$tex_history .= qq(\\item[$history[$j]] $history[$j+1] $history[$j+2]\n);
1006
	$tex_history .= qq(\\begin{itemize}\n$tex_revdesc\n\\end{itemize}\n)
1007
	    unless $tex_revdesc =~ /^\s*$/s;
1008
    }
1009
    $tex_history .= qq(\\end{description}});
1010
}
1011
 
1012
if ($history_ena eq '1:') {
1013
    $pd =~ s/<<history:(\d:)?\s+.*?>>/<<tex:\n$tex_history\n>>/sg;
1014
} else {
1015
    $pd =~ s/<<history:(\d:)?\s+.*?>>//sg;
1016
}
1017
 
1018
($credit_title, $x) = $pd =~ m/<<credit:([^\n]*)(.*?)>>/s;
1019
$credit = $x if $x;
1020
 
1021
if ($credit) {
1022
    @credits = split /\n/, $credit;
1023
    $credit_title =~ s/^\s+//;
1024
    $tex_credit = "\\textbf{$credit_title}\\\\";
1025
    for $x (@credits) {
1026
	$tex_credit .= tex_para($x);
1027
    }
1028
}
1029
$pd =~ s/<<credit:\s+.*?>>/<<tex:\n$tex_credit>>/sg;
1030
 
1031
### Generate index entries
1032
 
1033
@ix = ();  # Words to index
1034
 
1035
sub add_to_index {
1036
    my ($x) = @_;
1037
    my ($w,$ws,@ws,$ww);
1038
    for $ws (split /\n/, $x) {
1039
	next if $ws =~ /^\s*$/s;
1040
	$ws =~ s/^\s+//;
1041
	$ws =~ s/\s+$//;
1042
	@ws = split /\s*!\s*/, $ws;
1043
	for $w (@ws) {
1044
	    ($ww,undef) = split /\@/, $w;
1045
	    next if $ww =~ /^\s*$/s;
1046
	    $ix{$ww} = $ws[0];
1047
	}
1048
    }
1049
}
1050
 
1051
$pd =~ s/<<wordix:(.*?)>>/add_to_index($1)/seg;
1052
$pd =~ s/<<conceptix:(.*?)>>/add_to_index($1)/seg;
1053
$pd =~ s/<<peopleix:(.*?)>>/add_to_index($1)/seg;
1054
@ix = keys %ix;
1055
 
1056
($makeindex) = $pd =~ m/<<makeindex:\s+(\d*)(.*?)>>/s;
1057
$pd =~ s/<<makeindex:\s+.*?>>/$makeindex?'<<tex: \\printindex>>':''/se;
1058
($maketoc) = $pd =~ m/<<maketoc:\s+(\d*)(.*?)>>/s;
1059
$pd =~ s/<<maketoc:\s+.*?>>/$maketoc?'<<tex: \\tableofcontents>>':''/se;
1060
($makelof) = $pd =~ m/<<makelof:\s+(\d*)(.*?)>>/s;
1061
$pd =~ s/<<makelof:\s+.*?>>/$makelof?'<<tex: \\listoffigures>>':''/se;
1062
($makelot) = $pd =~ m/<<makelot:\s+(\d*)(.*?)>>/s;
1063
$pd =~ s/<<makelot:\s+.*?>>/$makelot?'<<tex: \\listoftables>>':''/se;
1064
#warn "makeindex($makeindex) maketoc($maketoc) makelof($makelof) makelot($makelot)";
1065
 
1066
($mktit) = $pd =~ m/<<maketitle:\s+(\d*)(.*?)>>/s;
1067
if (defined($mktit)) {
1068
    $maketitle = $mktit ? "\\maketitle\n" : '';
1069
}
1070
$pd =~ s/<<maketitle:\s+.*?>>//s;
1071
 
1072
$pd =~ s/^\#.*?-\*-pd-\*-.*?\n//s;
1073
($doctitle,$ul) = $pd =~ m/^(\w..+?)\r?\n(\#\#\#+)\r?\n\r?\n/s;
1074
#($doctitle,$version,$ul) = $pd =~ m/^(\w..+?)\nVersion: ([0-9]+\.[0-9]+-[0-9][0-9])\n(\#\#\#+)\n\n/s;
1075
 
1076
$pd =~ s/^\w..+?\r?\n\#\#\#+\r?\n\r?\n//s;
1077
warn "Wrong length underline" if length($doctitle) != length($ul);
1078
 
1079
$pd =~ s%<<rawtex:\s*(.*?)>>%hexit($1, 'RAWTEX')%gse;
1080
$pd =~ s%<<rawdbx:\s*(.*?)>>%hexit($1, 'RAWDBX')%gse;
1081
$pd =~ s%<<rawrtf:\s*(.*?)>>%hexit($1, 'RAWRTF')%gse;
1082
$pd =~ s%<<rawhtml:\s*(.*?)>>%hexit($1, 'RAWHTML')%gse;
1083
 
1084
writeall("pd.dump.$$", $pd) if $trace; # Dump file after special tags have been extracted
1085
 
1086
if (1) {
1087
    $x = $pd;
1088
    $x =~ s/\\\w+(\[.*?\])*(\{.*?\})*/ /gs;
1089
    $x =~ s/\$.{1,100}?\$/ /gs;
1090
    $x =~ s/<<\w+:\s+.*?>>/ /sg;  # All special blocks are omitted
1091
    $x =~ s/\[.+?\]/ /gs;
1092
    $x =~ s/\d+/ /gs;
1093
    $x =~ s|[.,;:!?+*&/%\"\'°º()<>{}^~=-]| |g; # *** primero, segunda
1094
    my @spell = split /\s+/s, $x;
1095
    my %spell;
1096
    for $x (@spell) { ++$spell{$x}; }
1097
    open SPELL, ">${texdir}spell.words" or die "Can't write dump file ${texdir}spell.words: $!";
1098
    warn "Writing ${texdir}spell.words";
1099
    @spell = sort keys %spell;
1100
    for $x (@spell) {
1101
	print SPELL "$x\n" unless $x =~ /^[A-Z]+$/;
1102
    }
1103
    close SPELL;
1104
    # aspell --encoding=iso8859-1 --lang=pt list <spell.words >miten.meni  *** ei toimi hyvin
1105
    # aspell --encoding=iso8859-1 --lang=en_GB-ize --personal=./spell.right list <spell.words
1106
    # aspell --encoding=iso8859-1 --lang=en_US --personal=./spell.right list <tex/spell.words
1107
    # First line of spell.right: personal_ws-1.1 en 350 iso8859-1
1108
    # ispell -d portugues -p oikein.dict -l <spell.words >miten.meni # Toimii
1109
    # cd /var/lib/ispell; unzip  /t/en_GB-oed.zip; buildhash [-s] dict affix hash  # syntax err :-(
1110
}
1111
 
1112
### Split into lines and do line processing
1113
 
1114
@pd = split /\r?\n/, $pd;
1115
$i = 0;
1116
#die Dumper \@pd;
1117
 
1118
$sec_id[0] = $top_id || $doctitle;
1119
$sec_id[0] =~ tr[A-Za-z0-9][_]c;
1120
$sec_level = 0;      # The section nesting level (0 = doc, 1=sec, 2=subsec, 3=subsubsec, ...)
1121
 
1122
sub sec {
1123
    my ($la, $j, $nndbx, $given_id, $short_title, $new_sec_level, @n_sec);
1124
    while ($i <= $#pd) {
1125
	warn "$i: sec $sec_level" if $trace;
1126
	body('','');
1127
	if ($i > $#pd) {  # end
1128
	    close_dbx_sections();
1129
	    return;
1130
	}
1131
 
1132
	# Ok, now body has detected a section
1133
 
1134
	$short_title = $given_id = undef;
1135
	$_ = $pd[$i];    # section title
1136
	#       12   2 1       3   3    4      4      5   5
1137
	if (/^<<((sub)*)sec:(?:(\w+):(?:([^:>]+):)?)? (.*?)>>/) {  # <<sec:ID:short tit: Title>>
1138
	    warn "$i: section detected list_level=$list_level" if $trace;
1139
	    $new_sec_level = (length($1) / 3) + 1;
1140
	    $given_id = $3;
1141
	    $short_title = "[$4]";
1142
	    $_ = $5;
1143
	} else {
1144
	    $la = $pd[$i+1]; # underline lookahead
1145
	    warn "underline length does not match" if length $_ != length $la;   # Sec candidate
1146
	    if      ($la =~ /^====+$/)   { $new_sec_level = 1;  # Section (Chapter)
1147
            } elsif ($la =~ /^----+$/)   { $new_sec_level = 2;  # Subsection (Section)
1148
	    } elsif ($la =~ /^~~~~+$/)   { $new_sec_level = 3;  # Subsubsection (Subsection)
1149
	    } elsif ($la =~ /^\^\^\^+$/) { $new_sec_level = 4;  # Subsubsubsection
1150
            } else { warn "false alarm, wrong underline type"; }
1151
	}
1152
	s/^[\d.]* //s if $pdflag{'stripsecnum'};
1153
 
1154
	if ($new_sec_level == $sec_level) {
1155
	    print DBX ( (' 'x$sec_level) . "</section><!--$sec_id[$sec_level]-->\n\n\n");
1156
	    #print RTF "\\sect}\n\n\n";
1157
	    if ($sec_level < 1) {
1158
		warn "Figures in the previous section: $cap_n_images. Total figures thus far: $n_images.\n";
1159
		$cap_n_images = 0;
1160
	    }
1161
	} elsif ($new_sec_level > $sec_level) {
1162
	    warn "Section level can only ever increase by one ($i:$pd[$i]) ($sec_level $new_sec_level)" if $sec_level != ($new_sec_level-1);
1163
	    $sec_level = $new_sec_level;
1164
	    $n_sec[$sec_level] = 0;
1165
	} else {  # section level decreases (by arbitrary amount)
1166
	    if ($sec_level < 1) {
1167
		warn "Figures in the previous section: $cap_n_images. Total figures thus far: $n_images.\n";
1168
		$cap_n_images = 0;
1169
	    }
1170
	    for ($j = $sec_level; $j >= $new_sec_level; --$j) {
1171
		print DBX ((' 'x$j) . "</section><!--$sec_id[$sec_level]-->\n\n\n");
1172
		#print RTF "\\sect}\n\n\n";
1173
	    }
1174
	    $sec_level = $new_sec_level;
1175
	}
1176
 
1177
	++$n_sec[$sec_level];
1178
	$sec_id[$sec_level] = $given_id || $_;
1179
	$sec_id[$sec_level] =~ s/[^A-Za-z0-9]//gs;
1180
	$sec_id = join '-', @sec_id[0..$sec_level];
1181
	$nn = '';
1182
	for ($j = 1; $j <= $sec_level; ++$j) {
1183
	    $nn .= $n_sec[$j] . '.';
1184
	}
1185
	chop $nn;
1186
 
1187
	$link = $sec_id;
1188
	##$link = $nn;
1189
	##$link =~ s/[^\w.-]//gs;
1190
	##$link =~ s/[.]/-/gs;
1191
	#$link = fold_label($_);   # fjon
1192
 
1193
	$sec_no = $pdflag{'secnum'} ? $nn.' ' : '';
1194
	$sec_no_dbx = $sec_no if $number;
1195
	#while ($sec_id_used{$sec_id}) { $sec_id++; } $sec_id_used{$sec_id} = 1;
1196
	$x = dbx_format($_);
1197
	print DBX ( (' 'x$sec_level) . qq(<section id="$sec_id">\n<title>$sec_no_dbx$x</title>\n));
1198
 
1199
	print NONL "$_\n\n";
1200
	print PDSEAL "$sec_no$_\n\n";
1201
 
1202
	$x = rtf_format($_);
1203
	#print RTF "{\\sectd \\tc\\tcf67\\tcl$sec_level \\ds$sec_level {\\s$sec_level $sec_no$x}\n";
1204
	my $rtf_style = $rtf_styles{'s'.$sec_level};
1205
	warn "----> sec_level=$sec_level style($rtf_style)" if $trace;
1206
	print RTF "{\\pard $rtf_style \\s$sec_level $sec_no$x\\par}\n";
1207
 
1208
	$x = html_format($_);
1209
	print HTML ((' 'x$sec_level) . qq(<a id="$link"></a><h$sec_level>$sec_no$x</h$sec_level>\n));
1210
	push @html_toc_title, $sec_level < 2 ? "<b>$sec_no$x</b>" : "$sec_no$x";
1211
	push @html_toc_link, $link;
1212
 
1213
	if ($sec_level < $html2_split_threshold && $html2) {
1214
	    $prevprev = $prev2;
1215
	    $prev2 = $html2;
1216
	    ($nn_dash = $nn) =~ s/[.]/-/gs;
1217
	    $html2 = "$base-$nn_dash$sec_id.html";
1218
	    #$html2 = $nn.$x;
1219
	    #$html2 =~ s/[^\w.-]//gs;
1220
	    #$html2 =~ s/[.]/-/gs;
1221
	    #$html2 = "$base-$html2.html";
1222
 
1223
	    if (!$nohtmlpreamb) {
1224
		my $amb = $htmlpostamble2;
1225
		$amb =~ s/!\?!TITLE/$doctitle: $sec_no$x/gs;
1226
		$amb =~ s/!\?!BASE/$base/gs;
1227
		$amb =~ s/!\?!PREV/$prevprev/gs;
1228
		$amb =~ s/!\?!NEXT/$html2/gs;
1229
		print HTML2 $amb;
1230
	    }
1231
	    close HTML2;
1232
	    open HTML2, ">$htmldir$html2" or die "Can't open $htmldir$html2 for writing new HTML segment: $!";
1233
	    warn "Writing $htmldir$html2";
1234
	    if (!$nohtmlpreamb) {
1235
		my $amb = $htmlpreamble2;
1236
		$amb =~ s/!\?!TITLE/$doctitle: $sec_no$x/gs;
1237
		$amb =~ s/!\?!BASE/$base/gs;
1238
		$amb =~ s/!\?!PREV/$prev/gs;
1239
		$amb =~ s/!\?!NEXT/top-next-not-impl/gs;
1240
		print HTML2 $amb;
1241
		#warn "amb($amb) base($base)\n\n";
1242
	    }
1243
        }
1244
        $reflist{$link} = $nn;   # Remember caption for later use
1245
        $refhtmlpage{$link} = $html2;
1246
 
1247
	print HTML2 ( (' 'x$sec_level) . qq(<a id="$link"></a><h$sec_level>$sec_no$x</h$sec_level>\n) );
1248
	push @html2_toc_link, qq($html2\#$link);  # if $sec_level < $html2_split_threshold; # fjon
1249
 
1250
	warn "--- SEC $nn $x\n";
1251
	$x = tex_format($_);
1252
	#s/_/\\_/g;   # Avoid TeX math mode: Missing $ inserted
1253
	print TEX $new_slide . '\\' . $tex_sec[$sec_level] . $short_title . "{$x}\\label{$sec_id}\n";
1254
	print TEX "\\message{=== SEC $nn}\n";  # Progress reports in LaTeX source
1255
	$i += 2;
1256
    }
1257
}
1258
 
1259
$indent = 0; # current indent level
1260
$list_level = 0;     # Hierarchical level of current list
1261
@list_indent = (0);  # Indendation level of different lists
1262
@list_type = (0);    # 1 = numeric, a = alpha, * = bullet, : = definition, etc.
1263
 
1264
sub body {
1265
    my ($ind, $first) = @_;
1266
    my ($itemstart, $bullet, $item, $la, @para);
1267
    my $ind_len = length($ind);
1268
    push @para, $first if $first;
1269
    while ($i <= $#pd) {
1270
	warn "BODY $i($pd[$i])" if $trace>1;
1271
	if ($pd[$i] =~ /^\s*$/) {  # empty line --> close current paragraph
1272
	    @para = para(@para);
1273
	    ++$i;
1274
	    warn "para done" if $trace>1;
1275
	    next;
1276
	}
1277
	if (substr($pd[$i],0,$ind_len) ne $ind) {  # lesser indent terminates current constuct
1278
	    warn "$i: lesser indent >$ind< ind_len=$indlen list_level=$list_level" if $trace;
1279
	    last;
1280
	}
1281
	if ($pd[$i]=~/^<<(sub)*sec:.*?>>/) {  # section
1282
	    warn "$i: section detected list_level=$list_level" if $trace;
1283
	    last;
1284
	}
1285
	$la = $pd[$i+1];
1286
	if ((length($pd[$i]) >= 4) && $la =~ /^[=~^-]{4,}$/) {  # section
1287
	    warn "Section underline wrong length\n$pd[$i]\n$la" if length($pd[$i]) != length($la);
1288
	    warn "$i: section detected list_level=$list_level" if $trace;
1289
	    last;
1290
	}
1291
 
1292
	$_ = $z = substr($pd[$i], $ind_len);      # remove indent for rest of processing
1293
	($itemstart, $item) = ($z =~ /^(\d+\.\s+)(.*)$/sx);  # *** Debug
1294
	warn "list_level=$list_level pd-1($pd[$i-1]),len=".length($pd[$i-1])." z($z) itst($itemstart) item($item) ord1=".ord(substr($z,1,1))." ord2=".ord(substr($z,2,1)) if $trace>1;
1295
 
1296
	if ((($itemstart, $bullet, $item) = /^(([*+-])\s+)(.*)$/)
1297
	    && ($list_level || $pd[$i - 1] =~ /^\s*$/)) { # Start bulleted list
1298
	    @para = para(@para);
1299
	    $list_type[++$list_level] = $bullet;
1300
	    $list_indent[$list_level] = $ind_len + length($itemstart);
1301
	    warn "$i: bullet setting list_indent[$list_level] ind($ind) m1($itemstart) pd[i-1]($pd[$i-1])" if $trace;
1302
	    list($ind_len + length($itemstart), $itemstart, $item);
1303
	    warn "$i: bulleted list done" if $trace;
1304
	    next;
1305
	} elsif ((($itemstart, $item) = /^(\d+\.\s+)(.*)$/s)
1306
		 && ($list_level || $pd[$i - 1] =~ /^\s*$/)) { # Start ordered list
1307
	    @para = para(@para);
1308
	    $list_type[++$list_level] = '1';
1309
	    $n_list[$list_level] = 1;
1310
	    warn "$i: ord setting list_indent[$list_level] ind($ind) m1=>$itemstart< pd[i-1]($pd[$i-1])" if $trace;
1311
	    $list_indent[$list_level] = $ind_len + length($itemstart);
1312
	    list($ind_len + length($itemstart), $itemstart, $item);
1313
	    warn "$i: ord list done list_level=$list_level" if $trace;
1314
	    next;
1315
	} elsif ((($itemstart, $item) = /^([a-hj-z][.\)]\s+)(.*)$/)
1316
		 && ($list_level || $pd[$i - 1] =~ /^\s*$/)) {  # Start lower alpha list
1317
	    @para = para(@para);
1318
	    $list_type[++$list_level] = 'a';
1319
	    $n_list[$list_level] = 'a';
1320
	    warn "$i: lower alpha setting list_indent[$list_level] ind=$ind m1=>$itemstart<" if $trace;
1321
	    $list_indent[$list_level] = $ind_len + length($itemstart);
1322
	    list($ind_len + length($itemstart), $itemstart, $item);
1323
	    warn "$i: lower alpha list done list_level=$list_level" if $trace;
1324
	    next;
1325
	} elsif ((($itemstart, $item) = /^([A-HJ-Z]\.\s+)(.*)$/)
1326
		 && ($list_level || $pd[$i - 1] =~ /^\s*$/)) {  # Start upper alpha list
1327
	    @para = para(@para);
1328
	    $list_type[++$list_level] = 'A';
1329
	    $n_list[$list_level] = 'A';
1330
	    $list_indent[$list_level] = $ind_len + length($itemstart);
1331
	    list($ind_len + length($itemstart), $itemstart, $item);
1332
	    warn "$i: upper alpha list done list_level=$list_level" if $trace;
1333
	    next;
1334
	} elsif ((($itemstart, $item) = /^(i[.\)]\s+)(.*)$/)
1335
		 && ($list_level || $pd[$i - 1] =~ /^\s*$/)) {  # Start lower roman list
1336
	    @para = para(@para);
1337
	    $list_type[++$list_level] = 'i';
1338
	    $n_list[$list_level] = 'i';
1339
	    warn "$i: lower roman setting list_indent[$list_level] ind=$ind m1=>$itemstart<" if $trace;
1340
	    $list_indent[$list_level] = $ind_len + length($itemstart);
1341
	    list($ind_len + length($itemstart), $itemstart, $item);
1342
	    warn "$i: lower roman list done list_level=$list_level" if $trace;
1343
	    next;
1344
	} elsif ((($itemstart, $item) = /^(I\.\s+)(.*)$/)
1345
		 && ($list_level || $pd[$i - 1] =~ /^\s*$/)) {  # Start upper alpha list
1346
	    @para = para(@para);
1347
	    $list_type[++$list_level] = 'I';
1348
	    $n_list[$list_level] = 'I';
1349
	    $list_indent[$list_level] = $ind_len + length($itemstart);
1350
	    list($ind_len + length($itemstart), $itemstart, $item);
1351
	    warn "$i: upper Roman list done list_level=$list_level" if $trace;
1352
	    next;
1353
        } elsif ((($itemstart, $bullet, $item) = /^(([^\n]+?)::\s+)(.*)$/)
1354
		 && ($list_level || $pd[$i - 1] =~ /^\s*$/)) {  # Start definition list
1355
	    @para = para(@para);
1356
	    $list_type[++$list_level] = ':';
1357
	    #$list_indent[$list_level] = $ind_len + length($itemstart);
1358
	    $list_indent[$list_level] = $ind_len + 4;
1359
	    varlist($ind_len + 4, $bullet, $item);
1360
	    warn "$i: definition list done list_level=$list_level" if $trace;
1361
	    next;
1362
	}
1363
 
1364
	if (/^> (.*?)$/) {    # usenet quoted stuff is block quote
1365
	    @para = para(@para);
1366
	    blockquote($1);
1367
	    next;
1368
	}
1369
 
1370
	if (/^\s+(.*?)$/) {   # indented stuff is verbatim
1371
	    @para = para(@para);
1372
	    code($1);
1373
	    next;
1374
	}
1375
 
1376
	if (/^<<texsections:\s+(.*?)>>$/) {
1377
	    @para = para(@para);
1378
	    @tex_sec = split /[,\s]+/, $1;
1379
	    ++$i;
1380
	    next;
1381
	}
1382
	if (/^<<pdflags:\s+(.*?)>>$/) {
1383
	    @para = para(@para);
1384
	    for $flag (split /[,\s]+/, $1) {
1385
		($flagname, $flagvalue) = split /=/, $flag, 2;
1386
		$pdflag{$flagname} = $flagvalue;
1387
	    }
1388
	    ++$i;
1389
	    next;
1390
	}
1391
 
1392
	#                  1           2    2    3    3    4    4          5 legend
1393
        if (/^<<gnuplot:\s*(\S.*?)(?:\,(\S*?)(?:,(\S*?)(?:,(\S*?))?)?)?:\s*(.*)$/) {
1394
	    @para = para(@para);
1395
	    print NONL $_;
1396
	    print PDSEAL $_;
1397
 
1398
	    warn "-----creating temporary gnuplot file $1.gp\n";
1399
	    open GNUPLOT, ">$1.gp" or die "Can't create temprary file $1.gp: $!";
1400
	    warn "Writing $1.gp";
1401
	    print GNUPLOT "# Generated by pd2tex. DO NOT EDIT. CHANGES WILL BE LOST.\n";
1402
	    print GNUPLOT qq(set output "$1.eps"\n);
1403
	    ++$i;
1404
	    if ($pd[$i] !~ /^>>/) {
1405
		print GNUPLOT qq(set terminal postscript\n) unless $pd[$i] =~ /set\s+terminal/;
1406
		print GNUPLOT qq(set encoding iso_8859_1\n) unless $pd[$i] =~ /set\s+encoding/;
1407
		print GNUPLOT $pd[$i]."\n";
1408
		for (++$i; $pd[$i] !~ /^>>/; ++$i) {
1409
		    print GNUPLOT $pd[$i]."\n";
1410
		}
1411
	    }
1412
	    close GNUPLOT;
1413
	    image($1, $5, $2, $3, $4);
1414
	    ++$i;
1415
	    next;
1416
	}
1417
 
1418
        if (($name, $pos, $siz, $trim, $caption) =
1419
	    #          1     1     2    2    3    3    4    4          5  5
1420
	    /^<<dot:\s*(\S.*?)(?:\,(\S*?)(?:,(\S*?)(?:,(\S*?))?)?)?:\s*(.*)$/) {
1421
	    @para = para(@para);
1422
 
1423
	    warn "-----creating temporary dot file $name.dot\n";
1424
	    open DOT, ">$name.dot" or die "Can't create temprary file $name.dot: $!";
1425
	    warn "Writing $name.dot";
1426
	    warn `pwd`;
1427
	    print DOT "// Generated by pd2tex. DO NOT EDIT. CHANGES WILL BE LOST.\n";
1428
	    for (++$i; $pd[$i] =~ /^\s*\/\//; ++$i) {  # comments
1429
		print DOT $pd[$i]."\n";
1430
	    }
1431
	    #warn "DOT name($name) $i: $pd[$i]";
1432
	    if ($pd[$i] !~ /graph\s+\w+\s*\{/) {  # not explicitly specified
1433
		($name2 = $name) =~ s/[^a-z0-9]/_/gi;
1434
		print DOT "digraph $name2 {\n";
1435
		$need_close_curly = 1;
1436
	    } else {
1437
		$need_close_curly = 0;
1438
	    }
1439
	    for (; $pd[$i] !~ /^>>/; ++$i) {
1440
		print DOT $pd[$i]."\n";
1441
	    }
1442
	    print DOT "}\n" if $need_close_curly;
1443
	    close DOT;
1444
	    image($name, $caption, $pos, $siz, $trim);
1445
	    ++$i;
1446
	    next;
1447
	}
1448
 
1449
	if (/<<epspdf:\s*(\S+)>>/) {  # trigger image generation without rendering image in output
1450
	    @para = para(@para);
1451
	    gen_img($1, "$i epspdf: $pd[$i]");
1452
	    ++$i;
1453
	    next;
1454
	}
1455
 
1456
        #              path        pos       siz       trim             caption?
1457
        #              1     1    ,2    2   ,3    3   ,4    4      5:   6   65
1458
        if (/^<<img:\s*(\S.*?)(?:\,(\S*?)(?:,(\S*?)(?:,(\S*?))?)?)?(:\s*(.*?))?>>/i) {
1459
	    @para = para(@para);
1460
	    #warn "IMG IMG IMG [$1/$2/$3/$4/$6]";
1461
	    print NONL $_;
1462
	    print PDSEAL $_;
1463
	    image($1, $6, $2, $3, $4);
1464
	    ++$i;
1465
	    next;
1466
	}
1467
 
1468
        #              path        pos       siz       trim         layers            caption
1469
	#              1     1    ,2    2   ,3    3   ,4    4      :5            56:   7   7
1470
        if (/^<<dia:\s*(\S.*?)(?:\,(\S*?)(?:,(\S*?)(?:,(\S*?))?)?)?:([a-z0-9_,-]+)(:\s*(.*?))?>>/i) {
1471
	    @para = para(@para);
1472
	    print NONL $_;
1473
	    print PDSEAL $_;
1474
	    #warn "DIA DIA DIA [$1/$2/$3/$4/$5/$7]";
1475
	    image($1, $7, $2, $3, $4, $5);
1476
	    ++$i;
1477
	    next;
1478
	}
1479
 
1480
	#                                                1     1     2    2      3  3
1481
        if (($ref, $posspec, $legend) = /^<<doubleimg:\s*(\S.*?)(?:\,(\S*?))?:\s*(.*)$/) {
1482
	    my ($path1, $legend1, $path2, $legend2);
1483
	    @para = para(@para);
1484
	    print NONL $_;
1485
	    print PDSEAL $_;
1486
 
1487
	    ++$i;
1488
	    if (($path1, $legend1) = ($pd[$i] =~ /^([^:>]+):\s*(.*)$/)) {
1489
		++$i;
1490
		if (($path2, $legend2) = ($pd[$i] =~ /^([^:>]+):\s*(.*)$/)) {
1491
		    ++$i;
1492
		}
1493
	    }
1494
	    for (; $pd[$i] !~ /^>>/; ++$i) {
1495
		warn "doubleimg: skipping excess input($pd[$i])";
1496
	    }
1497
	    #warn "doubleimage($path1,$legend1,$path2,$legend2)";
1498
	    doubleimage($ref, $legend, $posspec, $path1, undef, $legend1, $path2, undef, $legend2);
1499
	    ++$i;
1500
	    next;
1501
	}
1502
 
1503
	#                                                1     1     2    2      3  3
1504
        if (($ref, $posspec, $legend) = /^<<doubledia:\s*(\S.*?)(?:\,(\S*?))?:\s*(.*)$/) {
1505
	    my ($path1, $legend1, $path2, $legend2);
1506
	    @para = para(@para);
1507
	    print NONL $_;
1508
	    print PDSEAL $_;
1509
 
1510
	    ++$i;
1511
	    if (($path1, $layers1, $legend1) = ($pd[$i] =~ /^([^:>]+):([a-z0-9_,-]+):\s*(.*)$/i)) {
1512
		++$i;
1513
		if (($path2, $layers2, $legend2) = ($pd[$i] =~ /^([^:>]+):([a-z0-9_,-]+):\s*(.*)$/i)) {
1514
		    ++$i;
1515
		}
1516
	    }
1517
	    for (; $pd[$i] !~ /^>>/; ++$i) {
1518
		warn "doubledia: skipping excess input($pd[$i])";
1519
	    }
1520
	    #warn "doubleimage($path1,$legend1,$path2,$legend2)";
1521
	    doubleimage($ref, $legend, $posspec, $path1, $layers1, $legend1, $path2, $layers2, $legend2);
1522
	    ++$i;
1523
	    next;
1524
	}
1525
 
1526
	# <<table: Legenda\n ...>>
1527
	#       123      4      5    2      1 6   7                      76
1528
        if (/^<<(((long)|(mini)|(raw))?table):(\s*([A-Za-z0-9\xa0-\xff].*))?$/) {
1529
	    @para = para(@para);
1530
	    table($7,$1);
1531
	    next;
1532
	}
1533
 
1534
	#<<csv: file1,topleft2,botright3,options4: Legenda6>>
1535
        #              1     1    ,2    2   ,3    3   ,4    4      5:   6   65
1536
        if (/^<<csv:\s*(\S.*?)(?:\,(\S*?)(?:,(\S*?)(?:,(\S*?))?)?)?(:\s*(.*?))?>>/i) {
1537
	    @para = para(@para);
1538
	    #warn "CSV [$1/$2/$3/$4/$6]";
1539
	    csv($1, $6, $2, $3, $4);
1540
	    ++$i;
1541
	    next;
1542
	}
1543
 
1544
        if (/^<<references(:\d)?:( (\w.*?))?\s*$/) {
1545
	    @para = para(@para);
1546
	    warn "Found references";
1547
	    references($3, $1);
1548
	    next;
1549
	}
1550
 
1551
	#              1     1 2   3                      32
1552
        if (/^<<xmlfmt:([^:]*):(\s*([A-Za-z0-9\xa0-\xff].*))?$/) {
1553
	    @para = para(@para);
1554
	    xmlfmt($3,$1);
1555
	    next;
1556
	}
1557
 
1558
	#              1file_1 2sec__2 3xsd__3    4Cap4
1559
        if (/^<<sgfrag:([^:]*):([^:]*):([^:]*):\s*(.+?)\s*>>/) {
1560
	    @para = para(@para);
1561
	    sgfrag($1, $2, $3, $4);
1562
	    ++$i;
1563
	    next;
1564
	}
1565
 
1566
	#              12   2 1 3 4    43
1567
        if (/^<<schema:((\S*):)?( (\w.*))?$/) {  # XML schema verbatim listing
1568
	    @para = para(@para);
1569
	    print DBX   qq(<programlisting format="schema"><computeroutput><!\[CDATA\[);
1570
	    print RTF   qq({\\f2);
1571
	    print HTML  qq(<pre>);
1572
	    print HTML2 qq(<pre>);
1573
	    print TEX   qq(\\begin{verbatim});
1574
	    unindented_code($2, $4);  # filespec, first
1575
	    print TEX   qq(\\end{verbatim}\n);
1576
	    print DBX   qq(\]\]></computeroutput></programlisting>);
1577
	    print RTF   qq(});
1578
	    print HTML  "</pre>";
1579
	    print HTML2 "</pre>";
1580
	    ++$i;
1581
	    next;
1582
	}
1583
 
1584
	#            12   2 1 3 4    43
1585
        if (/^<<code:((\S*):)?( (\w.*))?$/) {  # code verbatim listing
1586
	    @para = para(@para);
1587
	    print DBX   qq(<programlisting format="code"><computeroutput><!\[CDATA\[);
1588
	    print RTF   qq({\\f2);
1589
	    print HTML  qq(<pre>);
1590
	    print HTML2 qq(<pre>);
1591
 
1592
	    #print TEX  qq(\\begin{Verbatim}[fontsize=\\small]);
1593
	    #unindented_code($2,$4);
1594
	    #print TEX  qq(\\end{Verbatim}\n);
1595
 
1596
	    print TEX   qq(\\begin{lstlisting});
1597
	    unindented_code($2, $4);
1598
	    print TEX   qq(\\end{lstlisting}\n);
1599
 
1600
	    print DBX   qq(\]\]></computeroutput></programlisting>);
1601
	    print RTF   qq(});
1602
	    print HTML  "</pre>";
1603
	    print HTML2 "</pre>";
1604
	    ++$i;
1605
	    next;
1606
	}
1607
 
1608
	#             12   2 1 3 4    43
1609
        if (/^<<ccode:((\S*):)?( (\w.*))?$/) {  # C-style code verbatim listing
1610
	    @para = para(@para);
1611
	    print DBX   qq(<programlisting format="code"><computeroutput><!\[CDATA\[);
1612
	    print RTF   qq({\\f2);
1613
	    print HTML  qq(<pre>);
1614
	    print HTML2 qq(<pre>);
1615
 
1616
	    print TEX   qq(\\begin{lstlisting});
1617
	    unindented_code($2, $4);
1618
	    print TEX   qq(\\end{lstlisting}\n);
1619
 
1620
	    print DBX   qq(\]\]></computeroutput></programlisting>);
1621
	    print RTF   qq(});
1622
	    print HTML  "</pre>";
1623
	    print HTML2 "</pre>";
1624
	    ++$i;
1625
	    next;
1626
	}
1627
 
1628
	#               12   2 1 3 4    43
1629
        if (/^<<console:((\S*):)?( (\w.*))?$/) {  # console output verbatim listing
1630
	    @para = para(@para);
1631
	    print DBX   qq(<programlisting format="code"><computeroutput><!\[CDATA\[);
1632
	    print RTF   qq({\\f2);
1633
	    print HTML  qq(<pre>);
1634
	    print HTML2 qq(<pre>);
1635
 
1636
	    print TEX   qq(\\begin{lstlisting});
1637
	    unindented_code($2, $4);
1638
	    print TEX   qq(\\end{lstlisting}\n);
1639
 
1640
	    print DBX   qq(\]\]></computeroutput></programlisting>);
1641
	    print RTF   qq(});
1642
	    print HTML  "</pre>";
1643
	    print HTML2 "</pre>";
1644
	    ++$i;
1645
	    next;
1646
	}
1647
 
1648
	#               12   2 1 3 4    43
1649
        if (/^<<diffout:((\S*):)?( (\w.*))?$/) {  # diff outoput verbatim listing
1650
	    @para = para(@para);
1651
	    print DBX   qq(<programlisting format="code"><computeroutput><!\[CDATA\[);
1652
	    print RTF   qq({\\f2);
1653
	    print HTML  qq(<pre>);
1654
	    print HTML2 qq(<pre>);
1655
 
1656
	    print TEX   qq(\\begin{lstlisting});
1657
	    unindented_code($2, $4);
1658
	    print TEX   qq(\\end{lstlisting}\n);
1659
 
1660
	    print DBX   qq(\]\]></computeroutput></programlisting>);
1661
	    print RTF   qq(});
1662
	    print HTML  "</pre>";
1663
	    print HTML2 "</pre>";
1664
	    ++$i;
1665
	    next;
1666
	}
1667
 
1668
	#               12   2 1 3 4    43
1669
        if (/^<<email:((\S*):)?( (\w.*))?$/) {  # email, bug tracker, or wiki post verbatim
1670
	    @para = para(@para);
1671
	    print DBX   qq(<programlisting format="code"><computeroutput><!\[CDATA\[);
1672
	    print RTF   qq({\\f2);
1673
	    print HTML  qq(<pre>);
1674
	    print HTML2 qq(<pre>);
1675
 
1676
	    print TEX   qq(\\begin{verbatim});
1677
	    unindented_code($2, $4);
1678
	    print TEX   qq(\\end{verbatim}\n);
1679
 
1680
	    print DBX   qq(\]\]></computeroutput></programlisting>);
1681
	    print RTF   qq(});
1682
	    print HTML  "</pre>";
1683
	    print HTML2 "</pre>";
1684
	    ++$i;
1685
	    next;
1686
	}
1687
 
1688
	#                 12   2 1 3 4    43
1689
        if (/^<<logoutput:((\S*):)?( (\w.*))?$/) {  # logoutput verbatim listing
1690
	    @para = para(@para);
1691
	    print DBX   qq(<programlisting format="logoutput"><computeroutput><!\[CDATA\[);
1692
	    print RTF   qq({\\f2);
1693
	    print HTML  qq(<pre>);
1694
	    print HTML2 qq(<pre>);
1695
	    print TEX   qq(\\begin{verbatim});
1696
	    unindented_code($2, $4);
1697
	    print TEX qq(\\end{verbatim}\n);
1698
	    print DBX   qq(\]\]></computeroutput></programlisting>);
1699
	    print RTF   qq(});
1700
	    print HTML  "</pre>";
1701
	    print HTML2 "</pre>";
1702
	    ++$i;
1703
	    next;
1704
	}
1705
 
1706
        if (/^<<newpage:.*?>>\s*$/) {
1707
	    @para = para(@para);
1708
	    if ($class eq 'slide') {
1709
		print DBX    "\n<!--newpage-->\n";
1710
		print NONL   "\n\n";
1711
		print PDSEAL "\n\n";
1712
		print RTF    "\n\\page\n";
1713
		#print HTML  "\n<hr><!--newpage-->\n";
1714
		#print HTML2 "\n<hr><!--newpage-->\n";
1715
		print HTML   "\n<!--newpage-->\n";
1716
		print HTML2  "\n<!--newpage-->\n";
1717
		print TEX    "\n\\end{slide}\n\n\\begin{slide}\n";
1718
	    } else {
1719
		print DBX    "\n<!--newpage-->\n";
1720
		print NONL   "\n\n";
1721
		print PDSEAL "\n\n";
1722
		print RTF    "\n\\page\n";
1723
		#print HTML  "\n<hr><!--newpage-->\n";
1724
		#print HTML2 "\n<hr><!--newpage-->\n";
1725
		print HTML   "\n<!--newpage-->\n";
1726
		print HTML2  "\n<!--newpage-->\n";
1727
		print TEX    "\n\\clearpage\n";
1728
	    }
1729
	    warn "newpage done" if $trace;
1730
	    ++$i;
1731
	    next;
1732
	}
1733
 
1734
        if (/^<<closesec:.*?>>\s*$/) {
1735
	    @para = para(@para);
1736
	    close_dbx_sections();
1737
	    warn "closesec done" if $trace;
1738
	    ++$i;
1739
	    next;
1740
	}
1741
 
1742
        if (/<<eqn:(.*?):(.*?)>>/) {  # direct TeX code for an equation (fjon)
1743
	    @para = para(@para);
1744
	    plot_eqn($1, $2, ++$eq_nr);
1745
	    ++$i;
1746
	    warn "eqn done" if $trace;
1747
	    next;
1748
	}
1749
        if (/<<eqn:(.*?)>>/) {  # direct TeX code for an equation
1750
	    @para = para(@para);
1751
	    ++$eq_nr;
1752
	    plot_eqn($1, $eq_nr, $eq_nr);
1753
	    #print TEX "\\begin{equation}$1\\end{equation}" if $1;
1754
	    ++$i;
1755
	    warn "eqn done" if $trace;
1756
	    next;
1757
	}
1758
        if (/^<<eqn:( (.*?))?$/) {  # direct TeX code for an equation
1759
	    @para = para(@para);
1760
	    ++$eq_nr;
1761
	    print TEX "\\begin{equation}";
1762
	    print TEX $2 if $2;
1763
	    for (++$i; $pd[$i] !~ /^>>/; ++$i) {
1764
		print TEX $pd[$i]."\n";
1765
	    }
1766
	    print TEX "\\end{equation}";
1767
	    ++$i;
1768
	    warn "eqn done" if $trace;
1769
	    next;
1770
	}
1771
 
1772
        if (/<<comment:(.*?)>>/) {  # Backend comment pass-thru
1773
	    @para = para(@para);
1774
	    #warn "=========== comment one($1)";
1775
	    print TEX   "% $1\n";
1776
	    print NONL  "# $1\n";
1777
	    #print PDSEAL "";
1778
	    print RTF   "<!-- $1 -->\n";
1779
	    print DBX   "<!-- $1 -->\n";
1780
	    print HTML  "<!-- $1 -->\n";
1781
	    print HTML2 "<!-- $1 -->\n";
1782
	    ++$i;
1783
	    warn "comment done" if $trace;
1784
	    next;
1785
	}
1786
        if (/^<<comment:(.*?)$/) {  # Backend comment pass-thru
1787
	    warn "comment start i=$i ($pd[$i])" if $trace;
1788
	    @para = para(@para);
1789
	    #warn "=========== comment two($2)";
1790
	    print TEX   "% $1\n";
1791
	    print NONL  "# $1\n";
1792
	    #print PDSEAL "";
1793
	    print RTF   "<!-- $1\n";
1794
	    print DBX   "<!-- $1\n";
1795
	    print HTML  "<!-- $1\n";
1796
	    print HTML2 "<!-- $1\n";
1797
	    for (++$i; $pd[$i] !~ /^>>/; ++$i) {
1798
		#warn "=========== comment two bis($pd[$i])";
1799
		print TEX   "% $pd[$i]\n";
1800
		print NONL  "# $pd[$i]\n";
1801
		#print PDSEAL "";
1802
		print RTF   $pd[$i]."\n";
1803
		print DBX   $pd[$i]."\n";
1804
		print HTML  $pd[$i]."\n";
1805
		print HTML2 $pd[$i]."\n";
1806
	    }
1807
	    if ($pd[$i] =~ /^>>/) {
1808
		print RTF "-->\n";
1809
		print DBX "-->\n";
1810
		print HTML "-->\n";
1811
		print HTML2 "-->\n";
1812
	    }
1813
	    ++$i;
1814
	    warn "comment done i=$i ($pd[$i])" if $trace;
1815
	    next;
1816
	}
1817
 
1818
	#               1 2 3             4      5          6           7           8
1819
	#    <<feedback:0!7!20081107-2259!idtype!identifier!remote addr!user agent! Title>> body... <<endfeedback: >>
1820
	#               1   1 2   2 3     3 4     4 5     5 6     6 7     7    8   8
1821
        if (/<<feedback:(\w+)!(\w+)!([^!]+)!([^!]*)!([^!]*)!([^!]*)!([^!]*)!\s*(.*?)\s*>>/) {  # Blog feedback
1822
	    @para = para(@para);
1823
	    warn "=========== feedback($1,$2,$3,$4,$5,$6,$7,$8)";
1824
	    if ($1 eq '1') {
1825
		print TEX  "% feedback: $1 $2 $3 $4 $5 $6 $7 $8\n";
1826
		print NONL "# feedback: $1 $2 $3 $4 $5 $6 $7 $8\n";
1827
		#print PDSEAL "";
1828
		print RTF  "<!-- feedback: $1 $2 $3 $4 $5 $6 $7 $8 -->\n";
1829
		print DBX  "<!-- feedback: $1 $2 $3 $4 $5 $6 $7 $8 -->\n";
1830
		my $fb_class = ($2 && ($2 & 0x01)) ? 'pdblogfbo' : 'pdblogfb';
1831
		my $num = $2 ? "#$2" : '';
1832
		my $fb_html = <<HTML;
1833
<p>
1834
<table class=$fb_class>
1835
<tr><th class=$fb_class>
1836
<b class=${fb_class}t>$8</b><br class=${fb_class}t><i class=${fb_class}ts>$3, by $5</i>
1837
</th><th class=${fb_class}num>$num</th></tr><tr><td class=$fb_class colspan=2>
1838
<p class=$fb_class>
1839
HTML
1840
    ;
1841
		print HTML  $fb_html;
1842
		print HTML2 $fb_html;
1843
		#print HTML qq(<hr class=pdblogfb><b class=pdblogfbt>$8</b><br class=pdblogfbt><i class=pdblogfbts>$3, by $5</i><p class=pdblogfb>);
1844
		#print HTML2 qq(<hr class=pdblogfb><b class=pdblogfbt>$8</b><br class=pdblogfbt><i class=pdblogfbts>$3, by $5</i><p class=pdblogfb>);
1845
		++$i;
1846
		warn "tex done" if $trace;
1847
	    } else {
1848
		for (++$i; $pd[$i] !~ /<<endfeedback:/; ++$i) {
1849
		    #warn "hidden feedback($pd[$i])";
1850
		}
1851
	    }
1852
	    next;
1853
	}
1854
        if (/<<endfeedback:.*?>>/) {  # Close feedback block
1855
	    @para = para(@para);
1856
	    warn "=========== endfeedback";
1857
	    print HTML  "</td></tr></table>\n\n";
1858
	    print HTML2 "</td></tr></table>\n\n";
1859
	    ++$i;
1860
	    next;
1861
	}
1862
 
1863
        if (/<<multicolstart:\s*(.*?)>>/) {  # Open Multicolumn block
1864
	    @para = para(@para);
1865
	    my $wid = $1 || '70mm';
1866
	    print TEX   "\\parbox[t]{$wid}{";
1867
	    print NONL  "<!-- multicolstart($wid) -->\n";
1868
	    #print PDSEAL "";
1869
	    print RTF   "<!-- multicolstart($wid) -->\n";
1870
	    print DBX   "<!-- multicolstart($wid) -->\n";
1871
	    print HTML  "<table><tr><td>\n";
1872
	    print HTML2 "<table><tr><td>\n";
1873
	    ++$i;
1874
	    warn "mc1 done" if $trace;
1875
	    next;
1876
	}
1877
 
1878
        if (/<<multicolnext:\s*(.*?)(,(.*?))?>>/) {  # close prev, start next col
1879
	    @para = para(@para);
1880
	    my $wid = $1 || '70mm';
1881
	    my $sepwid = $3 || '5mm';
1882
	    print TEX   "}\\rule{$sepwid}{0mm}\\parbox[t]{$wid}{";
1883
	    print NONL  "<!-- multicolnext($wid) -->\n";
1884
	    #print PDSEAL "";
1885
	    print RTF   "<!-- multicolnext($wid) -->\n";
1886
	    print DBX   "<!-- multicolnext($wid) -->\n";
1887
	    print HTML  "</td><td>\n";
1888
	    print HTML2 "</td><td>\n";
1889
	    ++$i;
1890
	    warn "mc1 done" if $trace;
1891
	    next;
1892
	}
1893
 
1894
        if (/<<multicolend:\s*>>/) {  # Close Multicolumn block
1895
	    @para = para(@para);
1896
	    print TEX   "}\n";
1897
	    print NONL  "<!-- multicolend() -->\n";
1898
	    #print PDSEAL "";
1899
	    print RTF   "<!-- multicolend() -->\n";
1900
	    print DBX   "<!-- multicolend() -->\n";
1901
	    print HTML  "</td></tr></table>\n\n";
1902
	    print HTML2 "</td></tr></table>\n\n";
1903
	    ++$i;
1904
	    warn "mc1 done" if $trace;
1905
	    next;
1906
	}
1907
 
1908
        if (/<<tex:(.*?)>>/) {  # direct TeX code
1909
	    @para = para(@para);
1910
	    #warn "=========== tex one($1)";
1911
	    print TEX $1 if $1;
1912
	    ++$i;
1913
	    warn "tex done" if $trace;
1914
	    next;
1915
	}
1916
        if (/^<<tex:(.*?)$/) {  # direct TeX code
1917
	    warn "tex start i=$i ($pd[$i])" if $trace;
1918
	    @para = para(@para);
1919
	    #warn "=========== tex two($2)";
1920
	    print TEX $1 if $1;
1921
	    for (++$i; $pd[$i] !~ /^>>/; ++$i) {
1922
		#warn "=========== tex two bis($pd[$i])";
1923
		print TEX $pd[$i]."\n";
1924
	    }
1925
	    ++$i;
1926
	    warn "tex done i=$i ($pd[$i])" if $trace;
1927
	    next;
1928
	}
1929
 
1930
        if (/^<<dbx:\s*(.*)$/) {  # direct DocBook code
1931
	    @para = para(@para);
1932
	    #warn "Entering dbx($1)";
1933
	    print DBX $1 if $1;
1934
	    for (++$i; $pd[$i] !~ /^>>/; ++$i) {
1935
		#warn "dbx i=$i ($pd[$i])";
1936
		print DBX $pd[$i]."\n";
1937
	    }
1938
	    ++$i;
1939
	    warn "dbx done" if $trace;
1940
	    next;
1941
	}
1942
 
1943
        if (/^<<rtf:\s*(.*)$/) {  # direct RTF code
1944
	    @para = para(@para);
1945
	    #warn "Entering dbx($1)";
1946
	    print RTF $1 if $1;
1947
	    for (++$i; $pd[$i] !~ /^>>/; ++$i) {
1948
		#warn "rtf i=$i ($pd[$i])";
1949
		print RTF $pd[$i]."\n";
1950
	    }
1951
	    ++$i;
1952
	    warn "rtf done" if $trace;
1953
	    next;
1954
	}
1955
 
1956
        if (/^<<odt:\s*(.*)$/) {  # direct ODT code
1957
	    @para = para(@para);
1958
	    #warn "Entering dbx($1)";
1959
	    print ODT $1 if $1;
1960
	    for (++$i; $pd[$i] !~ /^>>/; ++$i) {
1961
		#warn "rtf i=$i ($pd[$i])";
1962
		print ODT $pd[$i]."\n";
1963
	    }
1964
	    ++$i;
1965
	    warn "odt done" if $trace;
1966
	    next;
1967
	}
1968
 
1969
        if (/^<<html:\s*(.*)$/) {  # direct HTML code
1970
	    @para = para(@para);
1971
	    print HTML $2 if $1;
1972
	    print HTML2 $2 if $1;
1973
	    for (++$i; $pd[$i] !~ /^>>/; ++$i) {
1974
		print HTML $pd[$i]."\n";
1975
		print HTML2 $pd[$i]."\n";
1976
	    }
1977
	    ++$i;
1978
	    warn "html done" if $trace;
1979
	    next;
1980
	}
1981
 
1982
        if (/<<cvssig:(.*?)>>/) {
1983
	    @para = para(@para);
1984
	    open BZ, "|bzip2 -9>cvssig" or die "cvssig tag failed to invoke bzip2: $!";
1985
	    #print BZ $1;
1986
	    print BZ $cvsid;
1987
	    close BZ;
1988
	    $cvssig = '';
1989
	    $cvssigraw = readall('cvssig');
1990
	    $cvssigraw =~ s/(.)(.)(.)/$cvssig.=b64enc($1,$2,$3),''/ges;
1991
	    $cvssigraw =~ s/(.)/sprintf("%02x",ord($1))/ges;  # last 0, 1, or 2 bytes
1992
	    $cvssig =~ s/(.{64})/$1\n/g;       # line wrap to 64 cols
1993
	    print DBX   "$cvssig=$cvssigraw";
1994
	    print NONL  "$cvssig=$cvssigraw";
1995
	    print PDSEAL "$cvssig=$cvssigraw";
1996
	    print RTF   "$cvssig=$cvssigraw";
1997
	    print HTML  "$cvssig=$cvssigraw";
1998
	    print HTML2 "$cvssig=$cvssigraw";
1999
	    print TEX   "$cvssig=$cvssigraw";
2000
	    ++$i;
2001
	    warn "cvssig done" if $trace;
2002
	    next;
2003
	}
2004
 
2005
        if (/<<pdseal:\s*(.*?)>>/) {
2006
	    $salt=$1;
2007
	    @para = para(@para);
2008
	    close PDSEAL;
2009
	    $pdseal = readall("$texdir$base.seal");
2010
	    $pdseal = pdseal1($pdseal);
2011
	    writeall("$texdir$base.norm", $pdseal_norm);
2012
	    print DBX   $pdseal;
2013
	    print NONL  $pdseal;
2014
	    print RTF   $pdseal;
2015
	    print HTML  $pdseal;
2016
	    print HTML2 $pdseal;
2017
	    print TEX   $pdseal;
2018
	    ++$i;
2019
	    warn "pdseal done" if $trace;
2020
	    next;
2021
	}
2022
 
2023
	### Special segments for EDDA. Added by Fredrik Jonsson
2024
 
2025
	#                  1     1     2 3  32
2026
        if (/^<<desvar:\s*([\w.\/]*)\s*(:(.*))?>>/) {
2027
	    desvar($1,$3);
2028
	    ++$i;
2029
	    next;
2030
	}
2031
        if (/^<<plot:/) {
2032
	    plot_waves();
2033
	    next;
2034
	}
2035
        if (/^<<data:/) {
2036
	    print_data();
2037
	    next;
2038
	}
2039
        if (/^<<sch:/) {
2040
	    plot_schematics();
2041
	    next;
2042
	}
2043
 
2044
        if (/^<<logfile:\s*([\w.\/]*)\s*(:(.*))?>>/) {
2045
	    print DBX  qq(<programlisting format="schema"><computeroutput><!\[CDATA\[);
2046
	    print HTML qq(<pre>);
2047
	    print HTML2 qq(<pre>);
2048
	    print TEX  qq(\\begin{Verbatim}[fontsize=\\small]\n);
2049
	    #print TEX  qq(\\begin{verbatim}\n);
2050
 
2051
	    if(-r $1){
2052
		$/ = "\n"; # Disable "slurp" mode
2053
		open(LOGFILE,$1);
2054
		while(<LOGFILE>){
2055
		    print DBX  dbx_entity_escape_lite($_);
2056
		    my $x = $_;
2057
		    while(length($x) > $maxlogline){
2058
			my $xx = substr($x,0,$maxlogline);
2059
			print TEX  tex_esc_verbatim($xx)."\n";
2060
			print HTML $xx."\n";
2061
			print HTML2 $xx."\n";
2062
			$x = substr($x, $maxlogline, length($x));
2063
		    }
2064
		    print TEX  tex_esc_verbatim($x);
2065
		    print HTML $x;
2066
		    print HTML2 $x;
2067
		}
2068
		close(LOGFILE);
2069
		undef $/; # Enable "slurp" mode again
2070
	    } else {
2071
		warn("Unable to open $1");
2072
		print HTML "Missing file $1\n";
2073
		print HTML2 "Missing file $1\n";
2074
		print TEX "Missing file $1\n";
2075
	    }
2076
 
2077
	    print DBX qq(\]\]></computeroutput></programlisting>);
2078
	    print HTML "</pre>";
2079
	    print HTML2 "</pre>";
2080
	    print TEX qq(\n\\end{Verbatim}\n);
2081
	    #print TEX qq(\\end{verbatim}\n);
2082
	    ++$i;
2083
	    next;
2084
	}
2085
 
2086
        if (($name) = /^<<ect:\s*(.*)?/) {
2087
	    @para = para(@para);
2088
	    $name = $base if !$name;
2089
	    open ECT, ">.pd/pd.lim" or die "Can't create temprary file .pd/pd.lim: $!";
2090
	    warn "Writing .pd/pd.lim";
2091
	    ++$i;
2092
	    for (; $pd[$i] !~ /^>>/; ++$i) {
2093
		print ECT $pd[$i]."\n";
2094
	    }
2095
	    close ECT;
2096
	    system_cmd('pd_data');  # What command? Where? --Sampo
2097
 
2098
	    my $ref = fold_label($name);
2099
 
2100
	    if(-e ".pd/ectable.html"){
2101
		my $x = readall('.pd/ectable.html');
2102
		++$table_no;
2103
		print HTML "<p><a id=\"$ref\"></a>Table $table_no:$name</p><br>";
2104
		print HTML2 "<p><a id=\"$ref\"></a>Table $table_no:$name</p><br>";
2105
		$reflist{$ref} = $table_no;
2106
		$refhtmlpage{$ref} = $html2;
2107
	    }
2108
	    if(-e ".pd/ectable.tex"){
2109
		my $x = readall('.pd/ectable.tex');
2110
		#print TEX "\\begin{landscape}\n";
2111
		#print TEX "\\ref{$ref}\n";
2112
		$x =~ s/!!REFERENCE/$ref/gse;
2113
		print TEX $x;
2114
		#print TEX "\\end{landscape}\n";
2115
	    }
2116
 
2117
	    ++$i;
2118
	    #++$sec_float_obj;
2119
	    next;
2120
	}
2121
	# end EDDA
2122
 
2123
	if (/^<<EOF: .*?>>/) {
2124
	    $i = $#pd + 1;
2125
	    last;
2126
	}
2127
 
2128
	warn "push to para" if $trace>1;
2129
        push @para, "$_\n";
2130
	++$i;
2131
    }
2132
    warn "$i: end of body list_level=$list_level" if $trace;
2133
    para(@para);
2134
    return;
2135
}
2136
 
2137
### Base64 encoder so we avoid dependency on MIME::Base64 module.
2138
 
2139
sub b64enc {
2140
    my ($b1, $b2, $b3) = @_;
2141
    #warn "b1($b1) b2($b2) b3($b3)";
2142
    my $x1 = (ord($b1) >> 2) & 0x3f;
2143
    my $x2 = (ord($b1) & 3) | ((ord($b2) >> 2) & 0x3c);
2144
    my $x3 = (ord($b2) & 0xf) | ((ord($b3) >> 2) & 0x30);
2145
    my $x4 = ord($b3) & 0x3f;
2146
    #warn "x1($x1) x2($x2) x3($x3) x4($x4)";
2147
    my $b64str = '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-.'; # safish b64
2148
    return substr($b64str,$x1,1).substr($b64str,$x2,1).substr($b64str,$x3,1).substr($b64str,$x4,1);
2149
}
2150
 
2151
sub pdseal_normalize {
2152
    my ($x) = @_;
2153
    #warn "INPUT for pdseal_normalize($x)";
2154
    $x =~ s/[ \t]+/ /g;
2155
    $x =~ s/\r\n/\n/g;
2156
    $x =~ s/\r/\n/g;
2157
    $x =~ s/\n +/\n/g;
2158
    $x =~ s/ +\n/\n/g;
2159
    $x =~ s/\n{2,}/\n\n/g;
2160
    $x =~ s/([^\n])\n([^\n])/$1 $2/sg;  # Single newlines are insignificant
2161
    $x =~ s/ +/ /g;
2162
    $x =~ s/^[ \n]+//s;    # zap initial whitespace
2163
    $x =~ s/[ \n]+$/\n/s;  # normalize to end in single newline
2164
    #warn "OUTPUT for pdseal_normalize($x)";
2165
    return $x;
2166
}
2167
 
2168
sub pdseal1 {
2169
    my ($x) = @_;
2170
    $pdseal_norm = $x = pdseal_normalize($x);
2171
    require Digest::SHA1;
2172
    $x = Digest::SHA1::sha1($x);
2173
    $x .= '1';  # Make it 21 bytes so it will give 28 base64 chars with no padding
2174
    $x =~ s/(.)(.)(.)/b64enc($1,$2,$3)/ges;
2175
    return "PDSEAL1$x";
2176
}
2177
 
2178
### Process a definition list. The list has just been detected in body. Now we
2179
### need to proceed to next level of indent.
2180
 
2181
sub varlist {
2182
    my ($ind_len, $prefix, $first) = @_;
2183
    print DBX   ((' 'x$list_level) . $dbx_list_open{$list_type[$list_level]});
2184
    #print RTF   ((' 'x$list_level) . $rtf_list_open{$list_type[$list_level]});
2185
    print HTML  ((' 'x$list_level) . $html_list_open{$list_type[$list_level]});
2186
    print HTML2 ((' 'x$list_level) . $html_list_open{$list_type[$list_level]});
2187
    print TEX   ((' 'x$list_level) . $tex_list_open{$list_type[$list_level]});
2188
    while (1) {
2189
	warn "$i: start varlist $ind_len ($prefix) --[$first]-- list_level=$list_level" if $trace;
2190
	my $dbx_prefix = dbx_format($prefix);
2191
	print DBX ((' 'x$list_level) . qq(<varlistentry><term>$dbx_prefix</term><listitem>\n));
2192
	print NONL "$prefix: ";
2193
	print PDSEAL "$prefix ";
2194
	my $rtf_prefix = rtf_format($prefix);
2195
	my $rtf_style = $rtf_styles{'s3'.$list_level};
2196
	print RTF "{$rtf_style \\s3$list_level \\b\n$rtf_prefix\\par}\\fi0\n";
2197
	my $html_prefix = html_format($prefix);  # allow formatting in list item title
2198
	print HTML "<dt>$html_prefix<dd>";
2199
	print HTML2 "<dt>$html_prefix<dd>";
2200
	my $tex_prefix = tex_format($prefix);  # allow formatting in list item title
2201
	#$prefix = tex_esc($prefix);
2202
	print TEX "\\item[$tex_prefix] ";
2203
	++$i;
2204
 
2205
	body(' 'x$ind_len, $first);  # Process paragraphs for this list item (the definition)
2206
	warn "$i: back from body --[$first]-- list_level=$list_level" if $trace;
2207
	print DBX ((' 'x$list_level) . "</listitem></varlistentry>\n");
2208
 
2209
	$la = $pd[$i+1];
2210
	if ((length($pd[$i]) == length($la)) && $la =~ /^[=~^-]{3,}$/) {  # section
2211
	    warn "$i: section detected list_level=$list_level" if $trace;
2212
	    last;
2213
	}
2214
 
2215
	### Can either be list item at same level or list item continuation at any
2216
	### previous level (i.e. new paragraph) or new item at any previous level
2217
 
2218
	$_ = $pd[$i];
2219
	($indent) = /^(\s*)/;
2220
	$indent = length($indent);
2221
	warn "***** indent=$indent prev_indent=".$list_indent[$list_level-1]." level=$list_level" if $trace;
2222
	if ($indent == $list_indent[$list_level-1]) {
2223
	    my $typ = $list_type[$list_level];
2224
	    warn "checking for another item at same level typ($typ) --[$_]--" if $trace;
2225
	    if (($typ eq ':') && /^(\s*(([^\n]+?)::\s+))(.*)$/) {
2226
		$prefix = $3;
2227
		$first = $4;
2228
		warn "$i: another item list_level=$list_level --[$first]--" if $trace;
2229
		next;
2230
	    }
2231
	    warn "$i: same level didn't match --[$pd[$i]]--" if $trace;
2232
	}
2233
	last;	# Was not an item of the same list
2234
    }
2235
    print DBX   ((' 'x$list_level) . $dbx_list_close{$list_type[$list_level]});
2236
    #print RTF   ((' 'x$list_level) . $rtf_list_close{$list_type[$list_level]});
2237
    print HTML  ((' 'x$list_level) . $html_list_close{$list_type[$list_level]});
2238
    print HTML2 ((' 'x$list_level) . $html_list_close{$list_type[$list_level]});
2239
    print TEX   ((' 'x$list_level) . $tex_list_close{$list_type[$list_level]});
2240
    --$list_level;
2241
    warn "$i: list closed list_level=$list_level" if $trace;
2242
}
2243
 
2244
### Process a list. The list has just been detected in body. Now we need to proceed
2245
### to next level of indent.
2246
 
2247
sub list {
2248
    my ($ind_len, $prefix, $first) = @_;
2249
    print DBX   ((' 'x$list_level) . $dbx_list_open{$list_type[$list_level]});
2250
    #print RTF   ((' 'x$list_level) . $rtf_list_open{$list_type[$list_level]});
2251
    print HTML  ((' 'x$list_level) . $html_list_open{$list_type[$list_level]});
2252
    print HTML2 ((' 'x$list_level) . $html_list_open{$list_type[$list_level]});
2253
    print TEX   ((' 'x$list_level) . $tex_list_open{$list_type[$list_level]});
2254
    while (1) {
2255
	warn "$i: start list body $ind_len ($prefix) --[$first]-- list_lvl=$list_level type($list_type[$list_level]) n($n_list[$list_level])" if $trace;
2256
 
2257
	#$first = "$n_list[$list_level]. $first" if $number && $list_type[$list_level]=~/^[Aa1]$/;
2258
	print DBX   ((' 'x$list_level) . qq(<listitem>\n));
2259
	my $rtf_item = $rtf_list_item{$list_type[$list_level]};
2260
	$rtf_item =~ s/!!N/$list_level/;
2261
	$rtf_item =~ s/!!S/$rtf_styles{"s3$list_level"}/;
2262
	$rtf_item =~ s/!!M/$ord_mark{$list_type[$list_level]}[$n_list[$list_level]]/;
2263
	#print RTF   (("\\tab"x$list_level) . $rtf_item);
2264
	print RTF   $rtf_item;
2265
	print HTML  ((' 'x$list_level) . qq(<li>\n));
2266
	print HTML2 ((' 'x$list_level) . qq(<li>\n));
2267
	print TEX   ((' 'x$list_level) . $tex_list_item{$list_type[$list_level]});
2268
	if ($list_type[$list_level] =~ /^[*+-]$/) {
2269
	    print PDSEAL "$list_type[$list_level] ";
2270
	} else {
2271
	    print PDSEAL $ord_mark{$list_type[$list_level]}[$n_list[$list_level]].". ";
2272
	}
2273
	++$i;
2274
	body(' 'x$ind_len, $first);  # Process paragraphs for this list item
2275
	warn "$i: back from body --[$first]-- list_level=$list_level" if $trace;
2276
	print DBX ((' 'x$list_level) . "</listitem>\n");
2277
	print RTF   "}\n\n";
2278
 
2279
	$la = $pd[$i+1];
2280
	if ((length($pd[$i]) == length($la)) && $la =~ /^[=~^-]{3,}$/) {  # section
2281
	    warn "$i: section detected list_level=$list_level" if $trace;
2282
	    last;
2283
	}
2284
 
2285
	### Can either be list item at same level or list item continuation at any
2286
	### previous level (i.e. new paragraph) or new item at any previous level
2287
 
2288
	$_ = $pd[$i];
2289
	($indent) = /^(\s*)/;
2290
	$indent = length($indent);
2291
	warn "***** indent=$indent prev_indent=".$list_indent[$list_level-1]." level=$list_level" if $trace;
2292
	if ($indent == $list_indent[$list_level-1]) {
2293
	    my $typ = $list_type[$list_level];
2294
	    my $cur_ind = $list_indent[$list_level];
2295
	    warn "checking for another item at same level typ=$typ cur_ind=$cur_ind  --[$_]--" if $trace;
2296
	    if (($typ eq '1') && /^(\s*\d+\.\s+)(.*)/) {
2297
		if (length($1) == $cur_ind) {
2298
		    ++$n_list[$list_level];
2299
		    $first = $2;
2300
		    warn "$i: another item list_level=$list_level --[$first]--" if $trace;
2301
		    next;
2302
		} else {
2303
		    warn "$i: Indent does not match ($_)";
2304
		}
2305
	    } elsif (($typ eq 'a') && /^(\s*[a-z]+[.\)]\s+)(.*)/) {
2306
		if (length($1) == $cur_ind) {
2307
		    ++$n_list[$list_level];
2308
		    $first = $2;
2309
		    warn "$i: another item list_level=$list_level --[$first]--" if $trace;
2310
		    next;
2311
		} else {
2312
		    warn "$i: Indent does not match ($_)";
2313
		}
2314
	    } elsif (($typ eq 'A') && /^(\s*[A-Z]+\.\s+)(.*)/) {
2315
		if (length($1) == $cur_ind) {
2316
		    ++$n_list[$list_level];
2317
		    $first = $2;
2318
		    warn "$i: another item list_level=$list_level --[$first]--" if $trace;
2319
		    next;
2320
		} else {
2321
		    warn "$i: Indent does not match ($_)";
2322
		}
2323
	    } elsif (($typ eq 'i') && /^(\s*[ivxlcdm]+[.\)]\s+)(.*)/) {
2324
		if (length($1) == $cur_ind) {
2325
		    ++$n_list[$list_level];
2326
		    $first = $2;
2327
		    warn "$i: another item list_level=$list_level --[$first]--" if $trace;
2328
		    next;
2329
		} else {
2330
		    warn "$i: Indent does not match ($_)";
2331
		}
2332
	    } elsif (($typ eq 'I') && /^(\s*[IVXLCDM]+\.\s+)(.*)/) {
2333
		if (length($1) == $cur_ind) {
2334
		    ++$n_list[$list_level];
2335
		    $first = $2;
2336
		    warn "$i: another item list_level=$list_level --[$first]--" if $trace;
2337
		    next;
2338
		} else {
2339
		    warn "$i: Indent does not match ($_)";
2340
		}
2341
	    } elsif (/^(\s*([*+-])\s+)(.*)/) {
2342
		if ((length($1) == $cur_ind) && ($typ eq $2)) {
2343
		    ++$n_list[$list_level];
2344
		    $first = $3;
2345
		    warn "$i: another item list_level=$list_level --[$first]--" if $trace;
2346
		    next;
2347
		} else {
2348
		    warn "$i: Indent does not match ($_)";
2349
		}
2350
	    }
2351
	    warn "$i: same level didn't match --[$pd[$i]]--" if $trace;
2352
	}
2353
 
2354
	last;  # Was not an item of the same list
2355
    }
2356
    print DBX   ((' 'x$list_level) . $dbx_list_close{$list_type[$list_level]});
2357
    #print RTF   ((' 'x$list_level) . $rtf_list_close{$list_type[$list_level]});
2358
    print HTML  ((' 'x$list_level) . $html_list_close{$list_type[$list_level]});
2359
    print HTML2 ((' 'x$list_level) . $html_list_close{$list_type[$list_level]});
2360
    print TEX   ((' 'x$list_level) . $tex_list_close{$list_type[$list_level]});
2361
    --$list_level;
2362
    warn "$i: list closed list_level=$list_level" if $trace;
2363
}
2364
 
2365
sub sgfrag {
2366
    my ($in, $sec, $out, $caption) = @_;
2367
    my ($sg,$dbx);
2368
    if ($pdflag{'showsgasxsd'} eq '1') {
2369
        $sg = readall($out, 1);
2370
	$dbx = qq(<programlisting format="schema"><xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="./$out" parse="text"/></programlisting>);
2371
    } elsif ($pdflag{'showsgasxsd'} eq '2') {
2372
        $sg = readall($out, 1);
2373
	$dbx = '<programlisting format="schema"><computeroutput><!\[CDATA\[' .
2374
	    dbx_entity_escape_lite($sg)	. ']]></computeroutput></programlisting>';
2375
    } else {
2376
	$sg = readall($in, 1);
2377
	$sg ||= readall("$in.sg", 1);
2378
	#my $xs = readall("$in.xsd");
2379
	if ($sec) {
2380
	    ($sg) = $sg =~ /\#sec\($sec\)\s*(.*?)\s*\#endsec\($sec\)/s;
2381
	    #($xs) = $xs =~ /sec\($sec\)\s*(.*?)\s*endsec\($sec\)/s;
2382
	}
2383
	$dbx = qq(<programlisting format="schemagrammar"><computeroutput><!\[CDATA\[)
2384
	    . dbx_entity_escape_lite($sg) . qq(\]\]></computeroutput></programlisting>);
2385
    }
2386
    ++$img_no;
2387
    my $dbx_caption  = dbx_format($caption);
2388
    my $rtf_caption  = rtf_format($caption);
2389
    my $html_caption = html_format($caption);
2390
    my $tex_caption  = tex_caption($caption);
2391
    my $label = "$in-$sec";
2392
 
2393
    print DBX   qq(<figure id="$label" label="$img_no"><title>$dbx_caption</title>);
2394
    print RTF   qq(figstart $rtf_caption);
2395
    print HTML  qq(<pre>);
2396
    print HTML2 qq(<pre>);
2397
    print TEX   qq(\\begin{figure}\\begin{verbatim});
2398
    print DBX   $dbx;
2399
    print NONL  $sg;
2400
    print PDSEAL  $sg;
2401
    print RTF   $sg;
2402
    print HTML  $sg;
2403
    print HTML2 $sg;
2404
    print TEX   $sg;
2405
    print DBX   qq(</figure>);
2406
    print RTF   qq(figend);
2407
    print HTML  "</pre>Fig-$img_no: $html_caption<p>";
2408
    print HTML2 "</pre>Fig-$img_no: $html_caption<p>";
2409
    print TEX   qq(\\end{verbatim}$tex_caption\\label{$label}\\end{figure});
2410
}
2411
 
2412
sub xmlfmt_html {
2413
    my ($x) = @_;
2414
}
2415
 
2416
sub xmlfmt {
2417
    my ($frag_name, $opts) = @_;
2418
    my $x = '';
2419
    my @opts = split /\s*,\s*/, $opts;
2420
 
2421
    for ($row = 0; $i<=$#pd && $pd[$i] !~ /^>>/; ++$i) {
2422
	$x .= $pd[$i] . "\n";
2423
    }
2424
 
2425
    print DBX   qq(<programlisting format="$opts[0]"><computeroutput><!\[CDATA\[);
2426
    print RTF   qq({\\f2);
2427
    print HTML  qq(<pre>);
2428
    print HTML2 qq(<pre>);
2429
    print TEX   qq(\\begin{verbatim});
2430
    print DBX   dbx_entity_escape_lite($x);
2431
    print RTF   $x;
2432
    print RTF   xmlfmt_html($x);
2433
    print HTML  xmlfmt_html($x);
2434
    print HTML2 xmlfmt_html($x);
2435
    print TEX   texfmt_html($x);
2436
    print DBX   qq(\]\]></computeroutput></programlisting>);
2437
    print RTF   "}";
2438
    print HTML  "</pre>";
2439
    print HTML2 "</pre>";
2440
    print TEX   qq(\\end{verbatim});
2441
}
2442
 
2443
### Tables
2444
 
2445
sub table {
2446
    my ($table_name,$tablekind) = @_;
2447
    # globals: @pd, $i
2448
    $i+=2;
2449
    my (@table, @col_beg, @col_wid, @col_hdr, @row1, @vis_wid);
2450
    my ($j, $row, $cols, $line, $wid);
2451
    my @align = ();
2452
    my $cur_col = 0;
2453
    if ($table_name) {
2454
	my $table_n = $table_no+1;
2455
	print NONL "Table $table_n: $table_name\n";
2456
	print PDSEAL "Table $table_n: $table_name\n";
2457
    }
2458
    print NONL $pd[$i-1]."\n";
2459
    print NONL $pd[$i]."\n";
2460
    print PDSEAL $pd[$i-1]."\n";
2461
    #print PDSEAL $pd[$i]."\n";   # No equals signs in pdseal
2462
    @row1 = split / /, $pd[$i];   # Line of equals signs to set width of columns
2463
    $cols = $#row1+1;
2464
    $line = $pd[$i-1];            # Line of column titles
2465
    for ($j = 0; $j < $cols; ++$j) {
2466
	$wid = length($row1[$j]);
2467
	$col_hdr[$j] = substr($line, $cur_col, $wid);
2468
	$vis_wid[$j] = $col_wid[$j] = $wid;
2469
	$col_beg[$j] = $cur_col;
2470
	warn "col $j: >$row1[$j]< wid=$wid cur_col=$cur_col hdr: >>$col_hdr[$j]<<"; # if $trace>1;
2471
	$cur_col += $wid + 1;
2472
    }
2473
    for (++$i; ; ++$i) {
2474
	if ($pd[$i]=~/^WIDTHS:\s*(.*?)\s*$/) {
2475
	    $j = 0;
2476
	    for $wid (split /,/, $1) {
2477
		++$j;
2478
		my ($plusminus, $viswid,$ali) = $wid =~ /^([+-])?(\d*)([lrc])?$/;
2479
		$align[$j] = $ali;
2480
		warn "TAB COL $j: ($plusminus)($viswid)($ali)";
2481
		if (length $viswid) {
2482
		    if (length $plusminus) {
2483
			$vis_wid[$j-1] += $plusminus.$viswid;
2484
		    } else {
2485
			$vis_wid[$j-1] = $viswid;
2486
		    }
2487
		}
2488
	    }
2489
	    next;
2490
	}
2491
	if ($pd[$i]=~/^OPTIONS:\s*(.*?)\s*/) {
2492
	    next;
2493
	}
2494
	last;
2495
    }
2496
    for ($row = 0; $i<=$#pd && $pd[$i] !~ /^>>/;) {
2497
	warn "$i: $pd[$i]" if $trace>1;
2498
	print NONL $pd[$i]."\n";
2499
	print PDSEAL $pd[$i]."\n";
2500
	if ($pd[$i] =~ /^:$/) {  # end of col by line mode
2501
	    warn "$i: end of col by line marker" if $trace>1;
2502
	    ++$i;
2503
	    next;
2504
	}
2505
	if ($pd[$i] =~ /^\s*$/) {  # col by line mode
2506
	    warn "$i: col by line mode cols=$cols" if $trace>1;
2507
	    ++$i;
2508
	    for ($j = 0; $j < $cols; ++$j, ++$i) {
2509
		if ($pd[$i] =~ /^>>/) {
2510
		    warn "Wrong number of lines in end of table in col-by-line mode: [$pd[$i-1]]";
2511
		    last;
2512
		}
2513
		$table[$row][$j] = $pd[$i];
2514
	    }
2515
	    ++$row;
2516
	    next;
2517
	}
2518
 
2519
	# row by line mode
2520
	$line = $pd[$i];
2521
	for ($j = 0; $j < $cols-1; ++$j) {
2522
	    $table[$row][$j] = substr($line, $col_beg[$j], $col_wid[$j]);
2523
	    warn "$i: col $j: ($table[$row][$j])  --[$line]--" if $trace>1;
2524
	}
2525
	$table[$row][$cols-1] = substr($line, $col_beg[$cols-1]);  # last col takes the rest
2526
	++$i;
2527
	++$row;
2528
    }
2529
    ++$i;
2530
 
2531
    # Ok, now we got table in @table and @col_hdr. Format it into Lib docbook table. The
2532
    # Liberty DocBook tools require two special columns to be added to sides and require namest.
2533
 
2534
    #warn "table1 ".Dumper \@col_hdr;
2535
    #warn "table2 ".Dumper \@vis_wid;
2536
    table_output(\@table, \@col_hdr, \@vis_wid, $row, $cols, $table_name, $tablekind);
2537
}
2538
 
2539
sub table_output {
2540
    my ($tabr, $col_hdrr, $vis_widr, $rows, $cols, $table_name, $tablekind) = @_;
2541
    my ($j, $rr, $dbx, $html, $tex, $colspecs, $tex_colspec, $wid);
2542
 
2543
    $colspecs = '';
2544
    $tex_colspec = $tex_left_bar;
2545
    $dbx = qq(<thead>\n<row>\n);
2546
    $html = "<tr>\n";
2547
    $colspecs = qq(<colspec colname="c0" colwidth="0pt"/>\n);    # left extra col
2548
    for ($j = 1; $j <= $cols; ++$j) {
2549
	#warn "table_output2($$col_hdrr[$j-1])";
2550
	$dbx .= qq( <entry namest="c$j">) . dbx_para_raw($$col_hdrr[$j-1]) . "</entry>\n";
2551
	$html .= qq( <th$th_align{$align[$j]}>) . html_format($$col_hdrr[$j-1]) . "</th>\n";
2552
	$wid = sprintf('%.1f', $$vis_widr[$j-1] * $dbx_col_wid_factor);
2553
	$colspecs .= qq(<colspec colname="c$j" colwidth="${wid}in"/>\n);
2554
 
2555
	$tp = tex_format($$col_hdrr[$j-1]);
2556
	$tex .= "$tp &";
2557
	$wid = sprintf('%.1f', $$vis_widr[$j-1] * $tex_col_wid_factor);
2558
	$tex_colspec .= $tex_boxed_tab ? "p{${wid}mm}|" : "p{${wid}mm}";
2559
    }
2560
    $colspecs .= qq(<colspec colname="c$j" colwidth="0pt"/>\n);  # right extra col
2561
 
2562
    $dbx .= "</row>\n</thead>\n<tbody>\n";
2563
    $html .= "</tr>\n";
2564
    chop $tex;
2565
    $tex .= $tex_tab_hdr_sep;
2566
 
2567
    # Generate Table Body
2568
 
2569
    print TEX "\\message{===TAB}";
2570
 
2571
    for ($rr = 0; $rr < $rows; ++$rr) {
2572
	if ($$tabr[$rr][0] eq '-----') {
2573
	    $tex .= "\\hline\n";
2574
	    next;
2575
	}
2576
	$dbx .= qq(<row>\n);
2577
	$html .= "<tr>\n";
2578
	for ($j = 1; $j <= $cols; ++$j) {
2579
	    $dbx .= qq( <entry namest="c$j">) . dbx_para_raw($$tabr[$rr][$j-1]) . "</entry>\n";
2580
	    $html .= qq( <td$td_align{$align[$j]}>) . html_format($$tabr[$rr][$j-1]) . "</td>\n";
2581
	    $tp = tex_format($$tabr[$rr][$j-1]);
2582
	    #$tex .= "$tp &";
2583
	    $tex .= $tex_align{$align[$j]}."$tp &";
2584
	}
2585
	chop $tex;
2586
	$tex .= $tex_tab_line_sep;
2587
	$dbx .= "</row>\n";
2588
	$html .= "</tr>\n";
2589
    }
2590
    substr($tex, -length($tex_tab_line_sep)) = '' if $tex_tab_line_sep;
2591
    $dbx .= "</tbody>\n";
2592
    $cols += 2;  # account for extra cols
2593
 
2594
    $html =~ s|<th>\s*</th>|<th>&nbsp;</th>|gs;  # Make empty cells appear correctly on firefox
2595
    $html =~ s|<td>\s*</td>|<td>&nbsp;</td>|gs;  # Make empty cells appear correctly on firefox
2596
 
2597
    # Wrap the table into necessary top level tags
2598
 
2599
    print TEX "\\hbadness=10000\n";  # Disable warnings
2600
    if ($table_name) {
2601
	++$table_no;
2602
	my $label = fold_label($table_name);
2603
	$reflist{$label} = $table_no;
2604
	$refhtmlpage{$label} = $html2;
2605
	my $dbx_caption = dbx_format($table_name);
2606
	my $tex_caption = tex_caption($table_name);
2607
	my $html_caption = html_format($table_name);
2608
	print DBX qq(<table id="$label" tocentry="1" frame="all"><title>$dbx_caption</title><tgroup cols="$cols" align="left">\n$colspecs$dbx</tgroup></table>\n);
2609
	#print HTML qq(<p><i>$html_caption</i><br><table border=1>\n$html</table>\n);
2610
	#print HTML2 qq(<p><i>$html_caption</i><br><table border=1>\n$html</table>\n);
2611
	print HTML  qq(<p>Table $table_no:<i>$html_caption</i><br><table border=0>\n$html</table>\n);
2612
	print HTML2 qq(<p>Table $table_no:<i>$html_caption</i><br><table border=0>\n$html</table>\n);
2613
 
2614
	if ($tablekind eq 'longtable') {
2615
	    print TEX qq(\\begin{longtable}[$tex_flt_place]{$tex_colspec}\n$tex_caption\\label{tab:$label} \\\\ \n$tex_top_line\\endfirsthead\n\\caption[]{\\small (continuation)} \\\\ \n$tex_top_line\\endhead\n$tex\n$tex_bot_line\\end{longtable}\n);
2616
	} elsif ($tablekind eq 'minitable') {
2617
	    print TEX qq(\\begin{floatingtable}{\\begin{tabular}{$tex_colspec}\n$tex_top_line$tex\n$tex_bot_line\\end{tabular}}\n$tex_caption\\label{tab:$label}\n\\end{floatingtable}\n);
2618
	} elsif ($tablekind eq 'rawtable') {
2619
	    print TEX qq($tex_caption\\label{tab:$label}\\\\\n\\begin{tabular}{$tex_colspec}\n$tex_top_line$tex\n$tex_bot_line\\end{tabular}\n);
2620
	} else {
2621
	    print TEX qq(\\begin{table}[$tex_flt_place]\n\\centering$tex_caption\\label{tab:$label}\n\\vspace{3mm}\\begin{tabular}{$tex_colspec}\n$tex_top_line$tex\n$tex_bot_line\\end{tabular}\\end{table}\n);
2622
	}
2623
    } else {
2624
	print DBX qq(<informaltable><tgroup cols="$cols" align="left">\n$colspecs$dbx</tgroup></informaltable>\n);
2625
	print HTML qq(<table border=1>\n$html</table>\n);
2626
	print HTML2 qq(<table border=1>\n$html</table>\n);
2627
	if ($tablekind eq 'longtable') {
2628
	    print TEX qq(\\begin{longtable}[$tex_flt_place]{$tex_colspec}\n$tex_top_line$tex\n$tex_bot_line\\end{longtable}\n);
2629
	} elsif ($tablekind eq 'minitable') {
2630
	    print TEX qq(\\begin{floatingtable}{\\begin{tabular}{$tex_colspec}\n$tex_top_line$tex\n$tex_bot_line\\end{tabular}}\\end{floatingtable}\n);
2631
	} elsif ($tablekind eq 'rawtable') {
2632
	    print TEX qq(\\begin{tabular}{$tex_colspec}\n$tex_top_line$tex\n$tex_bot_line\\end{tabular}\n);
2633
	} else {
2634
	    print TEX qq(\\begin{table}[$tex_flt_place]\\centering\\begin{tabular}{$tex_colspec}\n$tex_top_line$tex\n$tex_bot_line\\end{tabular}\\end{table}\n);
2635
	}
2636
    }
2637
    print TEX "\\hbadness=$hbadness\n";  # Restore normal warning level
2638
}
2639
 
2640
### Comma separated values tables
2641
 
2642
sub read_csv {
2643
    my ($path, $topleft, $botright, $opts) = @_;
2644
    my ($i,$j);
2645
    my $csv = readall("$path.csv", 1);
2646
    $csv =~ s/\"//g;  # Zap double quotes
2647
    my @x = split /\r?\n/, $csv;
2648
    #warn "CSV0 ".Dumper \@x;
2649
    for ($i = 0; $i <= $#x; ++$i) {
2650
	if ($opts eq 'pipeysep') {
2651
	    $x[$i] = [ split '\|', $x[$i] ];
2652
	} else {
2653
	    $x[$i] = [ split ',', $x[$i] ];
2654
	}
2655
    }
2656
    my ($left, $top)  = $topleft  =~ /^([a-z]+)(\d+)$/i;
2657
    my ($right, $bot) = $botright =~ /^([a-z]+)(\d+)$/i;
2658
    $left = ord(lc($left)) - ord('a');
2659
    $right = ord(lc($right)) - ord('a');
2660
    --$top;
2661
    --$bot;
2662
    warn "csv ($left,$top), ($right,$bot)";
2663
    #warn "CSV1 ".Dumper \@x;
2664
    @x = splice @x, $top, $bot+1-$top;
2665
    #warn "CSV2 ".Dumper \@x;
2666
    for ($i = 0; $i <= $#x; ++$i) {
2667
	$x[$i] = [ splice(@{$x[$i]}, $left, $right+1-$left) ];
2668
    }
2669
    #warn "CSV3 ".Dumper \@x;
2670
    return \@x;
2671
}
2672
 
2673
sub csv {
2674
    my ($path, $caption, $topleft, $botright, $opts) = @_;
2675
    my $xr = read_csv($path, $topleft, $botright, $opts);
2676
    my $col_hdrr = shift @{$xr};
2677
    my $vis_widr = shift @{$xr};
2678
    for (my $i = 0; $i <= $#{$vis_widr}; ++$i) {
2679
	$$vis_widr[$i] = length($$vis_widr[$i]);
2680
    }
2681
    #warn "CSV4 ".Dumper $xr;
2682
    table_output($xr, $col_hdrr, $vis_widr, $#{$xr}+1, $#{$col_hdrr}+1, $table_name, '');
2683
}
2684
 
2685
### Refs
2686
 
2687
sub close_dbx_sections {
2688
    while ($sec_level) {
2689
	print DBX ( (' 'x$sec_level) . "</section><!--$sec_id[$sec_level]-->\n\n\n");
2690
	--$sec_level;
2691
    }
2692
}
2693
 
2694
sub references {
2695
    my ($ref_name, $ena) = @_;
2696
    my ($ii, $labwid);
2697
    # globals: @pd, $i
2698
    $ref_id = $dbx_ref_name = $ref_name || 'References';
2699
    $ref_id =~ tr[A-Za-z0-9][_]c;
2700
 
2701
    close_dbx_sections();
2702
    print DBX <<DBX if $ena ne ':0';   # <section id="$ref_id"><bibliography id="references-$ref_id">
2703
<bibliodiv id="references-$ref_id">
2704
  <title>$dbx_ref_name</title>
2705
DBX
2706
;
2707
    if ($ena ne ':0') {
2708
	if ($ref_name) {
2709
	    print TEX   "\\renewcommand\\refname{$ref_name}\n";  # article
2710
	    #print TEX  "\\renewcommand\\bibname{$ref_name}\n";  # book
2711
	    print HTML  "<H2>$ref_name</H2>\n<dl>\n";
2712
	    print HTML2 "<H2>$ref_name</H2>\n<dl>\n";
2713
	    print NONL  "$ref_name\n\n";
2714
	    print PDSEAL "$ref_name\n\n";
2715
	} else {
2716
	    print HTML  "<H2>References</H2>\n<dl>\n";
2717
	    print HTML2 "<H2>References</H2>\n<dl>\n";
2718
	    print NONL  "$ref_name\n\n";
2719
	    print PDSEAL "$ref_name\n\n";
2720
	}
2721
    }
2722
 
2723
    $labwid = 4;
2724
    for ($ii = $i+1; $ii<=$#pd && $pd[$ii] !~ /^>>/; ++$ii) {
2725
	warn "$ii: $pd[$i]" if $trace>1;
2726
	if (($lab,$rest) = $pd[$i] =~ /^\s*\[(.*?)\]\s+(.*?)\s*$/) {
2727
	    $labwid = length($lab) if length($lab) > $labwid;
2728
	}
2729
    }
2730
 
2731
    print TEX "\\begin{thebibliography}{XXXX".('X'x$labwid)."}\n" if $ena ne ':0';
2732
    for (++$i; $i<=$#pd && $pd[$i] !~ /^>>/; ++$i) {
2733
	warn "$i: $pd[$i]" if $trace>1;
2734
	next if $ena eq ':0';
2735
 
2736
	print NONL $pd[$i];
2737
	print PDSEAL $pd[$i];
2738
	if (($lab,$rest) = $pd[$i] =~ /^\s*\[(.*?)\]\s+(.*?)\s*$/) {
2739
	    $lab = tex_esc($lab);
2740
	    $rest = tex_esc($rest);
2741
	    print DBX qq(  <bibliomixed id="$lab"/>\n);
2742
	    print TEX "\\bibitem[$lab]{$lab} $rest\n";
2743
	    print HTML qq(<dt>[<a id="$lab" class=ref>$lab</a>] <dd>$rest\n);
2744
	    print HTML2 qq(<dt>[<a id="$lab" class=ref>$lab</a>] <dd>$rest\n);
2745
	} else {
2746
	    $rest = tex_esc($pd[$i]);
2747
	    print TEX "$rest\n";
2748
	    print HTML "$pd[$i]\n";
2749
	    print HTML2 "$pd[$i]\n";
2750
	}
2751
    }
2752
    ++$i;
2753
    if ($ena ne ':0') {
2754
	#print DBX qq(</bibliography>\n </section>\n);
2755
	print DBX qq(</bibliodiv>\n);
2756
	print TEX "\\end{thebibliography}\n";
2757
	print HTML "</dl>\n";
2758
	print HTML2 "</dl>\n";
2759
    }
2760
}
2761
 
2762
# Output verbatim material to all output streams, even to an external file
2763
 
2764
sub unindented_code {
2765
    my ($filespec, $first) = @_;
2766
    if ($filespec) {
2767
	open OUT, ">$filespec" or die "Can't write file($filespec): $!";
2768
    }
2769
    print DBX   dbx_entity_escape_lite($first) if $first;
2770
    print NONL  $first if $first;
2771
    print PDSEAL $first if $first;
2772
    print RTF   $first if $first;
2773
    print HTML  $first if $first;
2774
    print HTML2 $first if $first;
2775
    print OUT   $first if $first && $filespec;
2776
    print TEX   tex_esc_verbatim($first."\n") if $first;
2777
    for (++$i; $pd[$i] !~ /^>>/; ++$i) {
2778
	print DBX   dbx_entity_escape_lite($pd[$i])."\n";
2779
	print NONL  $pd[$i]."\n";
2780
	print PDSEAL $pd[$i]."\n";
2781
	print RTF   $pd[$i]."\n";
2782
	print HTML  $pd[$i]."\n";
2783
	print HTML2 $pd[$i]."\n";
2784
	print OUT   $pd[$i]."\n" if $filespec;
2785
	#print TEX   (tex_esc_verbatim($pd[$i])."\n");
2786
	my $x = $pd[$i];    # Line wrap code from fjon
2787
	while(length($x) > $maxlogline){
2788
	    print TEX  (tex_esc_verbatim(substr($x,0,$maxlogline-1))."\\\n");
2789
	    $x = substr($x, ($maxlogline-1), length($x));
2790
	}
2791
	print TEX  (tex_esc_verbatim($x)."\n");
2792
    }
2793
    close OUT;
2794
}
2795
 
2796
sub code {
2797
    my ($first_line) = @_;
2798
    my ($ind) = $pd[$i] =~ /^(\s+)/;
2799
    my $code = $pd[$i] . "\n";
2800
    #warn "CODE0($code)";
2801
    for (++$i;
2802
	 ($i<=$#pd) && ((substr($pd[$i],0,length($ind)) eq $ind) || $pd[$i]=~/^\s*$/);
2803
	 ++$i) {
2804
	warn "$i code $#pd: line($pd[$i])" if $trace>2;
2805
	$code .= $pd[$i] . "\n";
2806
    }
2807
    if ($first_line =~ /^NOTE: (.*)$/) {
2808
	$first_line = $1;
2809
	$code =~ s/^\s*NOTE: .*?\n//s;
2810
	my $dbx_code = dbx_para($code);
2811
	my $tex_code = tex_para($code);
2812
	print DBX qq(<note><title>$first_line</title>$dbx_code</note>\n);
2813
	print TEX qq(\\quote{\\emph{$first_line}\n$tex_code}\n);
2814
	return;
2815
    }
2816
    print NONL $code;
2817
    print PDSEAL $code;
2818
    print DBX "$code_open_tag<![CDATA[".dbx_entity_escape_lite($code)."]]>$code_close_tag\n";
2819
    #warn "CODE($code)";
2820
    $code = tex_esc_verbatim($code);
2821
    #warn "CODE1($code)";
2822
    $code =~ s/(\r?\n)+$//gs;
2823
    #warn "CODE2($code)";
2824
    print TEX "\\begin{verbatim}$code\\end{verbatim}\n\n";
2825
    $code =~ s/</&lt;/g;
2826
    print HTML "<pre>$code</pre>\n";
2827
    print HTML2 "<pre>$code</pre>\n";
2828
}
2829
 
2830
sub blockquote {
2831
    my ($first_line) = @_;
2832
    my ($ind) = $pd[$i] =~ /^(\s*> )/;
2833
    my $len_ind = length($ind);
2834
    my $code = $first_line;
2835
    my ($dbx_quote, $tex_quote, $html_quote, $rtf_quote);
2836
    for (++$i; ($i<=$#pd) && (substr($pd[$i],0,$len_ind) eq $ind); ++$i) {
2837
	warn "$i: $pd[$i]" if $trace;
2838
        $line = substr($pd[$i], $len_ind-1);  # include space between lines
2839
	if ($line =~ /^\s*$/) {               # empty line signifies paragraph break
2840
	    $dbx_quote .= dbx_para($code) . "\n\n";
2841
	    $tex_quote .= tex_para($code) . "\n\n";
2842
	    $code = '';
2843
	} else {
2844
	    $code .= $line;
2845
	}
2846
    }
2847
    print NONL $code;
2848
    print PDSEAL $code;
2849
    $dbx_quote .= dbx_para($code);
2850
    print DBX "<blockquote>$dbx_quote</blockquote>\n";
2851
 
2852
    $rtf_quote .= rtf_format($code);
2853
    print RTF "{\\pard $rtf_styles{'s21'} \\s21\n$rtf_quote\\par}\n";
2854
 
2855
    $html_quote .= html_format($code);
2856
    print HTML "<blockquote>$html_quote</blockquote>\n";
2857
    print HTML2 "<blockquote>$html_quote</blockquote>\n";
2858
 
2859
    $tex_quote .= tex_format($code);
2860
    print TEX "\\begin{quote}$tex_quote\n\\end{quote}\n";
2861
}
2862
 
2863
###
2864
### Material from fjon, some very specific to ocean wave simulation
2865
###
2866
 
2867
sub desvar {
2868
    # Extract design variables from ocean script
2869
    # Put variables in table
2870
 
2871
    my($filename,$comment) = @_;
2872
    open(INFILE, $filename) or warn "Can't open desvar file '$filename':$!";
2873
 
2874
    my $x_html = "<p><i>" . html_format($comment) . "</i><br><table>\n" .
2875
	"<tr><th>Variable</th><th>Value</th><th>Comment</th></tr>\n";
2876
    print HTML $x_html;
2877
    print HTML2 $x_html;
2878
    my $x_comm = tex_format($comment);
2879
    my $x_tex = <<TEX;
2880
\\begin{longtable}[ht]{|l|l|l|}
2881
\\caption{\\small $x_comm}\\\\
2882
\\endfirsthead
2883
\\caption[]{\\small (continuation)} \\\\
2884
\\endhead
2885
\\hline
2886
Variable & Value & comment \\\\\\hline\\hline
2887
TEX
2888
;
2889
    print TEX $x_tex;
2890
 
2891
    $/ = "\n"; # Disable "slurp" mode
2892
    while(<INFILE>) {
2893
       #                    1   1     2    2             3    3
2894
       if( /^;?desVar\(\s*\"(\w*)\"\s*(.*)\s*\)\s*;?\s*(\w.*)?/ ) {
2895
           $x_html = "<tr><td>" . html_format($1) . "</td><td>" .
2896
               $2 . "</td><td>" . html_format($3) .
2897
               "&nbsp;</td></tr>\n";
2898
           print HTML $x_html;
2899
           print HTML2 $x_html;
2900
           print TEX tex_format($1)." & ".tex_format($2)." & ".tex_format($3).
2901
               "\\\\\n\\hline\n";
2902
       }
2903
    }
2904
    close(INFILE);
2905
    print HTML "</table>\n";
2906
    print HTML2 "</table>\n";
2907
    print TEX "\\end{longtable}\n";
2908
    undef $/; # Enable "slurp" mode again
2909
}
2910
 
2911
sub plot_waves {
2912
    my $corners = '*';
2913
    my $subdir = '*';
2914
#    for (++$i; $pd[$i] !~ /^>>/; ++$i) {
2915
    my $continue = 1;
2916
    my $found = 0;
2917
    my $gnuplotcmd = "";
2918
    while($continue == 1){
2919
       if($pd[$i] =~ /^(un)?set (.*)/) {
2920
           $gnuplotcmd .= "$1set $2\n";
2921
       } elsif($pd[$i] =~ /^(\S*)=(.*)/) {
2922
           if($1 eq "corners") {
2923
               $corners = $2;
2924
           } elsif($1 eq "dir") {
2925
               $subdir = $2;
2926
           }
2927
       } else {
2928
           my ($in_line) = ($pd[$i] =~ /(?:<<plot:)?([^>]*)/);
2929
           my ($plot,$comment) = split(/:/, $in_line);
2930
           if(!$plot) { next; }
2931
           my ($wavedef, $title, $xlabel, $ylabel, $plot_opt) = split(/,/,$plot);
2932
 
2933
           @wavelist = split(/&/, $wavedef);
2934
 
2935
           @plotcmd = ();
2936
           $n_plots = 0;
2937
           $newest_file = 0;
2938
           @waves = ();
2939
           foreach(@wavelist){
2940
#              ($wave, $wave_corners) = /([\w-]*)(?:\((.*)\))?/;
2941
               my ($wave, $wave_corners, $caption) = /([\w-]*)(?:\((.*)\))?(?:\"(.*)\")?/;
2942
               if(!$caption){
2943
                   $caption = $wave;
2944
               }
2945
               @waves = (@waves, $wave);
2946
 
2947
               $found = 0;
2948
               if($wave_corners){
2949
                   @cornerlist = split(/\s/,$wave_corners);
2950
               } else {
2951
                   @cornerlist = split(/\s/,$corners);
2952
               }
2953
 
2954
               # Count number of files
2955
               my $file_count = 0;
2956
               foreach(@cornerlist){
2957
                   $corner = $_;
2958
                   @files = <$subdir/$corner/$wave>;
2959
                   foreach(@files){
2960
                       $file = $_;
2961
                       if(-e $file){
2962
                           $file_count++;
2963
                       }
2964
                   }
2965
               }
2966
 
2967
               # Create plots commands
2968
               foreach(@cornerlist){
2969
                   $corner = $_;
2970
                   @files = <$subdir/$corner/$wave>;
2971
# Removed search of data in non-testbench directory
2972
#                  if($subdir eq '*'){
2973
#                      @files = (@files, <$corner/$wave>);
2974
#                  }
2975
                   foreach(@files){
2976
                       $file = $_;
2977
                       if(-e $file){
2978
                           print "Exist:$file\n";
2979
                           $timestamp = (stat($file))[9];
2980
                           if($timestamp > $newest_file){
2981
                               $newest_file = $timestamp;
2982
                           }
2983
                           print "Number of files @files\n";
2984
                           if($file_count == 1){
2985
                               # Only one corner, don't include corner in caption
2986
                               @plotcmd = (@plotcmd,
2987
                                           "\"$file\" title \"$caption\" $plot_opt");
2988
                           } else {
2989
                               ($corn) = ($file =~ /\w*\/(.*)\/\w*/);
2990
                               @plotcmd = (@plotcmd,
2991
                                           "\"$file\" title \"$caption:$corn\" $plot_opt");
2992
                           }
2993
                           $n_plots++;
2994
                           $found = 1;
2995
                       }
2996
                   }
2997
               }
2998
               if($found == 0) {
2999
                   print HTML "<error:Missing waveform $wave>";
3000
               }
3001
           }
3002
 
3003
           $filename = join('', @waves);
3004
           if($subdir ne '*'){
3005
               $filename = $filename."-".$subdir;
3006
           }
3007
           if($cornerlist[0] ne '*'){
3008
               $filename = $filename."-".join('',@cornerlist);
3009
           }
3010
 
3011
           if($n_plots == 0){
3012
               @plotcmd = ("0");
3013
           }
3014
 
3015
           open GNUPLOT,">.pd/cmdfile.gnuplot";
3016
	   warn "Writing .pd/cmdfile.gnuplot";
3017
           print GNUPLOT "reset\n".
3018
               "set terminal postscript eps color dashed\n".
3019
               "set data style lines\n".
3020
               "set grid\n".
3021
               "set autoscale xy\n".
3022
#                  "set title \"$title\"\n".
3023
               "set xlabel \"$xlabel\"\n".
3024
               "set ylabel \"$ylabel\"\n".
3025
               "set output 'tex/$filename.eps'\n".
3026
               "$gnuplotcmd".
3027
               "plot ".join(",", @plotcmd)."\n";
3028
           close GNUPLOT;
3029
 
3030
           $gnuplotcmd = "";
3031
           $newplot = 0;
3032
           $cmdfile = ".pd/$filename.gnuplot";
3033
           if((-e $cmdfile) &&
3034
              ($newest_file < (stat($cmdfile))[9]) &&
3035
              (system("diff $cmdfile .pd/cmdfile.gnuplot") eq "0")) {
3036
 
3037
               warn("Nothing changed in [".join(' ',@waves)."]\n");
3038
               $newplot = 0;
3039
           } else {
3040
               warn("Creating plot [".join(' ',@waves)."]\n");
3041
               system("mv .pd/cmdfile.gnuplot $cmdfile");
3042
               system('gnuplot',"$cmdfile");
3043
               system('epstopdf',"tex/$filename.eps");
3044
               $newplot = 1;
3045
           }
3046
 
3047
           if((!-e "$htmldir$filename.png") || $newplot){
3048
               system('convert',"-density","100x100","tex/$filename.eps",
3049
                      "$htmldir$filename.png");
3050
           }
3051
           if((!-e "$htmldir$filename"."-zoom.png") || $newplot){
3052
               system('convert',"-density","200x200","tex/$filename.eps",
3053
                      "$htmldir$filename"."-zoom.png");
3054
           }
3055
           if((!-e "tex/$filename.pdf") || $newplot){
3056
#              system('ps2pdf',"tex/$filename.eps","tex/$filename.pdf");
3057
           }
3058
           ++$img_no;
3059
           $refname = fold_label($filename);
3060
           $reflist{$refname} = $img_no;
3061
           $refhtmlpage{$refname} = $html2;
3062
           my $html_caption = "<p><a href=\"$filename"."-zoom.png\" ".
3063
               "id=\"$refname\"><img src=\"$filename.png\"></a><br>".
3064
               "Fig-$img_no: <i>".html_format($title)."</i></p>\n";
3065
           print HTML $html_caption;
3066
           print HTML2 $html_caption;
3067
 
3068
           my $tex_caption = tex_caption($title);
3069
           print TEX "\\begin{figure}[ht]\n\\center\\includegraphics[totalheight=3.5in]".
3070
               "{$filename.pdf}\n$tex_caption\n".
3071
               "\\label{$refname}\\end{figure}\n";
3072
       }
3073
 
3074
    } continue {
3075
       if($pd[$i] =~ />>$/) {
3076
           $continue = 0;
3077
       }
3078
       $i++;
3079
    }
3080
#    print TEX "\\pagestyle{fancy}\n";
3081
    $sec_float_obj++;
3082
}
3083
 
3084
sub print_data {
3085
    my $corners = '*';
3086
    my $subdir = '*';
3087
    my $continue = 1;
3088
    my $firstdata = 1;
3089
 
3090
    my ($cmd,$table_caption,$label) = split(/:/, $pd[$i++]);
3091
    ++$table_no;
3092
    if(!$label) {
3093
       $label = "table_$table_no";
3094
    }
3095
    my $ref = fold_label($label);
3096
    $reflist{$ref} = $table_no;
3097
    $refhtmlpage{$ref} = $html2;
3098
 
3099
    # print table head
3100
    $html = "<p><a id=\"$ref\"></a><br>".
3101
       "<table border=0>\n" .
3102
       "<tr><th rowspan=\"2\">Parameter</th><th colspan=\"3\">Spec</th>".
3103
       "<th colspan=\"3\">Result</th><th rowspan=\"2\">Unit</th><th rowspan=\"2\">Pass</th></tr>\n".
3104
       "<tr><th>Min</th><th>Typ</th><th>Max</th>".
3105
       "<th>Min</th><th>Typ</th><th>Max</th></tr>\n";
3106
    print HTML $html;
3107
    print HTML2 $html;
3108
 
3109
    $tex = "\\begin{center}\n".
3110
       "\\scriptsize\n".
3111
       "\\tablehead{\n".
3112
       "          &     & Spec&     &     &Result&    &      &     \\\\\n".
3113
       "Parameter & Min & Typ & Max & Min & Typ & Max & Unit & Pass\\\\\n".
3114
       "\\hline\n\\hline}\n".
3115
       "\\tabletail{\\hline}\n".
3116
#      "\\title{\\textbf{Table $table_no:$label}}\n".
3117
       "\\bottomcaption{$table_caption}\n".
3118
       "\\label{$ref}\n".
3119
       "\\begin{mpsupertabular}{l|ccc|ccc|c|c}\n";
3120
    print TEX $tex;
3121
 
3122
    while($continue == 1){
3123
       if($pd[$i] =~ /^(\S*)=(.*)/) {
3124
           if($1 eq 'corners') {
3125
               $corners = $2;
3126
           } elsif ($1 eq 'dir') {
3127
               $subdir = $2;
3128
           } else {
3129
               warn("Illegal command '$1'\n");
3130
           }
3131
           next;
3132
       }
3133
       my ($varname,$caption,$eq,$min_spec,$typ_spec,$max_spec,$unit,$n_dec) =
3134
           split(/,/, $pd[$i]);
3135
       if(!$varname){
3136
           next;
3137
       }
3138
       if(!$unit){
3139
           # Unit not specified = Wrong number of parameters. Use line as title
3140
           $html = "<tr><th colspan=\"9\">$pd[$i]</th></tr>\n";
3141
           print HTML $html;
3142
           print HTML2 $html;
3143
           if($firstdata eq 0){
3144
               print TEX "\\hline\n";
3145
           }
3146
           print TEX "\\multicolumn{9}{l}{\\textbf{$pd[$i]}}\\\\\n\\hline\n";
3147
           next;
3148
       }
3149
       if($n_dec eq ''){
3150
           $n_dec = 2;
3151
       }
3152
 
3153
       my ($typ, $min, $max, $min_corner, $max_corner, $typ_corner);
3154
       $min_corner = '';
3155
       $max_corner = '';
3156
       my $count = 0;
3157
       # Walk through corners and subdir to find variables
3158
       my @cornerlist = split(/\s/,$corners);
3159
       $/ = "\n"; # Disable "slurp" mode
3160
       foreach(@cornerlist){
3161
           $corner = $_;
3162
           @files = <$subdir/$corner/$varname>;
3163
           foreach(@files){
3164
               $file = $_;
3165
 
3166
               # Read data
3167
               open DATAFILE, $file;
3168
               chomp($data = <DATAFILE>);
3169
               close DATAFILE;
3170
 
3171
               # Find min and max value
3172
               ($corn) = ($file =~ /\w*\/(.*)\/\w*/);
3173
               if($count eq 0){
3174
                   $typ = $data;
3175
                   $min = $data;
3176
                   $max = $data;
3177
                   $typ_corner = $corn;
3178
                   $min_corner = $corn;
3179
                   $max_corner = $corn;
3180
               } else {
3181
                   if($corn eq 'typ'){
3182
                       $typ = $data;
3183
                       $typ_corner = $corn;
3184
                   }
3185
                   if($min > $data){
3186
                       $min = $data;
3187
                       $min_corner = $corn;
3188
                   }
3189
                   if($max < $data){
3190
                       $max = $data;
3191
                       $max_corner = $corn;
3192
                   }
3193
               }
3194
               $count++;
3195
           }
3196
       }
3197
       # Scale result according to unit
3198
       my($prefix) = $unit =~ /(.?)/;
3199
       if    ($prefix eq 'T') { $scale = 1e-12; }
3200
       elsif ($prefix eq 'G') { $scale = 1e-9; }
3201
       elsif ($prefix eq 'M') { $scale = 1e-6; }
3202
       elsif ($prefix eq 'k') { $scale = 1e-3; }
3203
       elsif ($prefix eq 'm') { $scale = 1e3; }
3204
       elsif ($prefix eq 'u') { $scale = 1e6; }
3205
       elsif ($prefix eq 'n') { $scale = 1e9; }
3206
       elsif ($prefix eq 'p') { $scale = 1e12; }
3207
       elsif ($prefix eq 'f') { $scale = 1e15; }
3208
       else { $scale = 1; }
3209
 
3210
       $min *= $scale;
3211
       $max *= $scale;
3212
       $typ *= $scale;
3213
 
3214
       # Check results
3215
       if((($min_spec eq '') || ($min >= $min_spec)) &&
3216
          (($max_spec eq '') || ($max <= $max_spec))){
3217
           $result_html = '&nbsp;';
3218
           $result_tex = '';
3219
       } else {
3220
           $result_html = 'FAIL';
3221
           $result_tex = 'FAIL';
3222
       }
3223
 
3224
       $typ_cap_tex = sprintf("%.$n_dec"."f",$typ);
3225
       $typ_cap_html = $typ_cap_tex;
3226
       if($count eq 1){
3227
       # Dont print min and max data if only one data point found
3228
           $max_cap_html = '&nbsp;';
3229
           $min_cap_html = '&nbsp;';
3230
           $min_cap_tex = '';
3231
           $max_cap_tex = '';
3232
       } elsif($count eq 0){
3233
       # Dont print results if no data found
3234
           $max_cap_html = '&nbsp;';
3235
           $min_cap_html = '&nbsp;';
3236
           $typ_cap_html = '&nbsp;';
3237
           $min_cap_tex = '';
3238
           $max_cap_tex = '';
3239
           $typ_cap_tex = '';
3240
           $result_html = '&nbsp;';
3241
           $result_tex = '';
3242
           print HTML "<error:Data $varname not found>\n";
3243
       } else {
3244
           $min_cap_html = sprintf("%.$n_dec"."f (%s)",$min,$min_corner);
3245
           $max_cap_html = sprintf("%.$n_dec"."f (%s)",$max,$max_corner);
3246
           $min_cap_tex = sprintf("%.$n_dec"."f\\ensuremath{^{%s}}",$min,$min_corner);
3247
           $max_cap_tex = sprintf("%.$n_dec"."f\\ensuremath{^{%s}}",$max,$max_corner);
3248
       }
3249
 
3250
 
3251
       # Print result if data found
3252
           $html = "<tr><td>$caption</td>".
3253
               "<td>$min_spec&nbsp;</td>".
3254
               "<td>$typ_spec&nbsp;</td>".
3255
               "<td>$max_spec&nbsp;</td>".
3256
               "<td>$min_cap_html</td>" .
3257
               "<td>$typ_cap_html</td>".
3258
               "<td>$max_cap_html</td>".
3259
               "<td>$unit</td><td>$result_html</td></tr>\n";
3260
           print HTML $html;
3261
           print HTML2 $html;
3262
           $tex = "$caption & $min_spec & $typ_spec & $max_spec &".
3263
               "$min_cap_tex & $ typ_cap_tex & $max_cap_tex & ".
3264
               "$unit & $result_tex \\\\\n";
3265
           print TEX $tex;
3266
           $firstdata = 0;
3267
    } continue {
3268
       $i++;
3269
       if($pd[$i] =~ />>$/){
3270
           $continue = 0;
3271
       }
3272
    }
3273
 
3274
    # Close table
3275
    $html = "</p></table>Table $table_no:<i>$table_caption</i>\n";
3276
    print HTML $html;
3277
    print HTML2 $html;
3278
 
3279
    print TEX "\\end{mpsupertabular}\n\\normalsize\n\\end{center}\n";
3280
 
3281
    $i++;
3282
    undef $/; # Enable "slurp" mode again
3283
}
3284
 
3285
sub plot_schematics {
3286
    my $cont = 1;
3287
 
3288
    print HTML '<p><i>Schematics:</i><br>';
3289
    print HTML2 '<p><i>Schematics:</i><br>';
3290
 
3291
    # Deuglify filenames of newly printed schematics
3292
    my $schdir = 'sch';
3293
    my @sch_list = glob "$schdir/*,*";     # schematic printed using hieracical plots contains a ,
3294
    my $index;
3295
    foreach my $sch (@sch_list) { # rename Cadence file format, easier for LaTex and for sort
3296
       $index++;
3297
       print "Schematic $index of " . @sch_list . "\n";
3298
       if ($sch =~ /[@](.*),(.*),(.*)/) { #strip @ prefix and extract ckt and libname
3299
           my $libname = $1;
3300
           my $cktname = $2;
3301
           my $viewname = $3;
3302
           my $viewext;
3303
           if($viewname eq 'schematic') {
3304
               $viewext = '';
3305
           } else {
3306
               $viewext = "-$viewname";
3307
           }
3308
 
3309
           rename "$sch", "$schdir/$cktname.$libname.$viewname.ps" or warn "couldn't rename $sch\n";
3310
           system "ps2ps $schdir/$cktname.$libname.$viewname.ps $schdir/$cktname$viewext-$libname";
3311
           unlink "$schdir/$cktname.$libname.$viewname.ps";   # delete eps files
3312
       }
3313
    }
3314
 
3315
    while($cont){
3316
#      my ($pre, $sch, $lib) = ($pd[$i] =~ /(?:<<sch:)?([\s\^]*)([\w]*)\s*\((\w*)/);
3317
       my ($pre, $sch, $lib) = ($pd[$i] =~ /(?:<<sch:)?(\W*)([\w-]*)\s*\((\w*)/);
3318
       $filename = "$sch-$lib";
3319
       print "$filename\n";
3320
       if(-r "sch/$filename"){
3321
           if((stat("sch/$filename"))[9] > (stat("tex/$filename.pdf"))[9]){
3322
               print "Converting $filename to pdf\n";
3323
               system('epstopdf',"sch/$filename", "-outfile","tex/$filename.pdf");
3324
           }
3325
           if((stat("sch/$filename"))[9] > (stat("$htmldir$filename.png"))[9]){
3326
               print "Converting $filename to png\n";
3327
               system("convert -density 150x150 sch/$filename $htmldir$filename.png");
3328
           }
3329
           ++$img_no;
3330
           $refname = fold_label($filename);
3331
           $reflist{$refname} = $img_no;
3332
           $refhtmlpage{$refname} = $html2;
3333
 
3334
           my $html_caption = "$pre<a href=\"$filename.png\"".
3335
               "id=\"$refname\">$sch ($lib)</a><br>\n";
3336
           print HTML $html_caption;
3337
           print HTML2 $html_caption;
3338
           $tex_caption = "";
3339
           print TEX <<TEX;
3340
\\setlength{\\unitlength}{1in}
3341
\\newpage
3342
\\begin{picture}(5,7)(1.5,2.5)
3343
\\thispagestyle{plain}
3344
\\includegraphics[width=1\\paperwidth,height=1\\paperheight,keepaspectratio]{$filename.pdf}
3345
\\end{picture}
3346
\\newpage
3347
TEX
3348
    ;
3349
#          print TEX "\\begin{figure}[ht]\n\\center".
3350
#              "\\includegraphics[totalheight=9in]".
3351
#              "\\includegraphics[width=1.0\\textwidth,".
3352
#              "height=1.0\\textheight,keepaspectratio]".
3353
#              "\\includegraphics[width=0.95\\paperwidth,".
3354
#              "height=0.95\\paperheight,keepaspectratio]".
3355
#              "{$filename.pdf}\n$tex_caption".
3356
#              "\\label{$refname}\n\\end{figure}\n\\clearpage\n\n";
3357
       }
3358
 
3359
       if($pd[$i] =~ />>$/) {
3360
           $cont = 0;
3361
       }
3362
       $i++;
3363
    }
3364
    print HTML '</p>';
3365
    print HTML2 '</p>';
3366
}
3367
 
3368
# Generate TeX for equation AND render it for HTML representation
3369
 
3370
sub plot_eqn {
3371
    my($equation,$tag,$eqnr) = @_;
3372
    my $ref = fold_label($tag);
3373
 
3374
    print TEX "\\begin{equation}\\label{$ref}$equation\\end{equation}";
3375
 
3376
    # Convert latex equation to png to include in HTML document
3377
    my $f = "eqn_$tag";
3378
    my $dpi = 150;
3379
    my $res = 0.5;
3380
    my $imageCmd = 'pnmtopng';
3381
    #my $imageCmdD = 'pngtopnm';
3382
    my $imageExt = 'png';
3383
    my $background = "";
3384
    my $transparent = "ff/ff/ff";
3385
    $reflist{$ref} = $eqnr;
3386
    $refhtmlpage{$ref} = $html2;
3387
 
3388
    open TEXEQN,">$f.tex";
3389
    warn "Writing $f.tex";
3390
    print TEXEQN "\\documentclass[12pt]{article}\n" .
3391
	"\\pagestyle{empty}\n".
3392
	"\\begin{document}\n".
3393
	"\\begin{displaymath}\n".
3394
#      "\\bf\n".
3395
	"$equation\n".
3396
	"\\end{displaymath}\n".
3397
	"\\end{document}\n";
3398
    close TEXEQN;
3399
 
3400
    # Only recreate png file if tex file changed
3401
    if((-e ".pd/$f.tex") && (-e "$htmldir$f.$imageExt") &&
3402
       (system("diff .pd/$f.tex $f.tex") eq "0")){
3403
	unlink "$f.tex";
3404
	warn("Nothing changed in equation $tag\n");
3405
    } else {
3406
	# *** the following, from fjon, has too many tool dependencies for my taste --Sampo
3407
	unlink ".pd/$f.tex";
3408
	rename "$f.tex", ".pd/$f.tex";
3409
	system("latex .pd/$f.tex\n");
3410
	system("dvips -f $f.dvi > $f.ps\n");
3411
	$cmd = "echo quit | gs -q -dNOPAUSE  -r" . int($dpi / $res). "x". int($dpi / $res) .
3412
	    " -sOutputFile=- -sDEVICE=pbmraw $f.ps | " .
3413
	    "pnmcrop -white | pnmdepth 255 | $background pnmscale " .
3414
           $res . " | " .
3415
           "$imageCmd -interlace -transparent rgb:$transparent >$htmldir$f.$imageExt";
3416
	system($cmd);
3417
	system("rm $f.dvi $f.aux $f.log $f.ps");
3418
    }
3419
    # Place equation in table to align equation number
3420
    $html = "<table><tr>".
3421
	"<td class=\"eqn\"><a id=\"$ref\"><img src=\"$f.$imageExt\"></a>".
3422
	"<td class=\"eqn\">($eqnr)\n".
3423
	"</table><br>\n";
3424
#      "<a id=\"$ref\"><img src=\"$f.$imageExt\"></a>".
3425
#      "&nbsp;&nbsp;($eqnr)<br>\n";
3426
    print HTML $html;
3427
    print HTML2 $html;
3428
}
3429
 
3430
### End fjon contribution
3431
 
3432
# N.B. In order to be able to escape < and > properly we use here a trick:
3433
#      ^^^^ represents < and ~~~~ represents >. Once escaping is done, they
3434
#      are substituted back.
3435
 
3436
$inline_open = '^^^^inlinemediaobject~~~~^^^^imageobject~~~~';
3437
$inline_close = '^^^^/imageobject~~~~^^^^/inlinemediaobject~~~~';
3438
 
3439
sub fold_label {
3440
    my ($label) = @_;
3441
    $label =~ s|[^\w_:-]|-|g;  # fjon added _
3442
    return $label;
3443
}
3444
 
3445
sub dbx_entity_escape_lite {  # Used by verbatim modes that use CDATA
3446
    my ($x) = @_;
3447
    return $x unless $encoding eq 'UTF-8';
3448
 
3449
    return $x;
3450
}
3451
 
3452
sub dbx_entity_escape {
3453
    my ($x) = @_;
3454
    return $x unless $encoding eq 'UTF-8';
3455
 
3456
    $x =~ s/\@/&commat;/g;
3457
 
3458
    $x =~ s/á/&aacute;/g;   $x =~ s/à/&agrave;/g;  $x =~ s/â/&acirc;/g;
3459
    $x =~ s/ä/&auml;/g;     $x =~ s/ã/&atilde;/g;  $x =~ s/å/&aring;/g;
3460
    $x =~ s/Á/&Aacute;/g;   $x =~ s/À/&Agrave;/g;  $x =~ s/Â/&Acirc;/g;
3461
    $x =~ s/Ä/&Auml;/g;     $x =~ s/Ã/&Atilde;/g;  $x =~ s/Å/&Aring;/g;
3462
 
3463
    $x =~ s/ó/&oacute;/g;   $x =~ s/ò/&ograve;/g;  $x =~ s/ô/&ocirc;/g;
3464
    $x =~ s/ö/&ouml;/g;     $x =~ s/õ/&otilde;/g;
3465
    $x =~ s/Ó/&Oacute;/g;   $x =~ s/Ò/&Ograve;/g;  $x =~ s/Ô/&Ocirc;/g;
3466
    $x =~ s/Ö/&Ouml;/g;     $x =~ s/Õ/&Otilde;/g;
3467
 
3468
    $x =~ s/í/&iacute;/g;   $x =~ s/ì/&igrave;/g;  $x =~ s/î/&icirc;/g; $x =~ s/ï/&iuml;/g;
3469
    $x =~ s/Í/&Iacute;/g;   $x =~ s/Ì/&Igrave;/g;  $x =~ s/Î/&Icirc;/g; $x =~ s/Ï/&Iuml;/g;
3470
 
3471
    $x =~ s/é/&eacute;/g;   $x =~ s/è/&egrave;/g;  $x =~ s/ê/&ecirc;/g; $x =~ s/ë/&euml;/g;
3472
    $x =~ s/É/&Eacute;/g;   $x =~ s/È/&Egrave;/g;  $x =~ s/Ê/&Ecirc;/g; $x =~ s/Ë/&Euml;/g;
3473
 
3474
    $x =~ s/ú/&uacute;/g;   $x =~ s/ù/&ugrave;/g;  $x =~ s/û/&ucirc;/g; $x =~ s/ü/&uuml;/g;
3475
    $x =~ s/Ú/&Uacute;/g;   $x =~ s/Ù/&Ugrave;/g;  $x =~ s/Û/&Ucirc;/g; $x =~ s/Ü/&Uuml;/g;
3476
 
3477
    $x =~ s/ç/&ccedilla;/g; $x =~ s/Ç/&Ccedilla;/g;
3478
    $x =~ s/ñ/&ntilde;/g;   $x =~ s/Ñ/&Ntilde;/g;
3479
 
3480
    return $x;
3481
}
3482
 
3483
sub dbx_format_infobox {
3484
    my ($id,$link,$tableargs,$content) = @_;
3485
    $content =~ s/</^^^^/gs;
3486
    $content =~ s/>/~~~~/gs;
3487
    return tag(qq(a href="#" onClick="vis('$id',1);")).$link.tag('/a')
3488
       .tag(qq(table id=$id $tableargs)).tag('tr').tag('td').$content
3489
       .tag('/td').tag('/tr').tag('/table');
3490
}
3491
 
3492
sub dbx_para_raw {
3493
    my $x = join ' ', @_;
3494
    return "\n" unless length $x;
3495
    local ($1,$2,$3,$4,$5,$6,$7,$8,$9);
3496
 
3497
    if ($fn_style == 3) {
3498
	$x =~ s%<<footnote:\s*(.*?)\s*>>%$fn_num++,qq(^^^^footnote id="fn$fn_num" label="$fn_num"~~~~^^^^para~~~~$1^^^^/para~~~~^^^^/footnote~~~~)%gse;
3499
    } elsif ($fn_style == 1) {
3500
	$x =~ s%<<footnote:\s*(.*?)\s*>>%$fn_num++,qq([*** fn$fn_num: $1 ***])%gse;
3501
    } else {
3502
	$x =~ s%<<footnote:\s*(.*?)\s*>>%%gs;
3503
    }
3504
    $x =~ s%<<feedbackopts:.*?>>%%gs;
3505
    $x =~ s%<<addfeedbacktop:.*?>>%%gs;
3506
    $x =~ s%<<addfeedbackbot:.*?>>%%gs;
3507
    $x =~ s%<<infobox:(\w+):([^:]*):([^:]*):\s*(.*?)\s*>>%dbx_format_infobox($1,$2,$3,$4)%gse;
3508
    $x =~ s/\(\*\*\*(.*?)\)//gs;
3509
 
3510
    #         1    2  34     5       6     7     8
3511
    $x =~ s%<<(\S*?(\.((gif)|(jpe?g)|(svg)|(png)|(e?ps))))>>%
3512
	$inline_open^^^^imagedata fileref="$1"/~~~~$inline_close%gsx;
3513
    $x =~ s%<<tt:\s*(.*?)>>%^^^^computeroutput~~~~$1^^^^/computeroutput~~~~%gs;
3514
    $x =~ s%<<bold:\s*(.*?)>>%^^^^emphasis role="bold"~~~~$1^^^^/emphasis~~~~%gs;
3515
    $x =~ s%<<italic:\s*(.*?)>>%^^^^emphasis~~~~$1^^^^/emphasis~~~~%gs;
3516
    $x =~ s%<<see:\s*(\S[^>]*?)(?::\s+(\S[^>]*))?>>%qq(^^^^xref linkend=") . fold_label($1) . qq("/~~~~)%gse;
3517
    $x =~ s%<<ix:\s*([^>]+)>>%$1%gs;  # index entry
3518
    $x =~ s%<<ref:\s*([^:]+): (.*?)>>%<xref linkend="$2"/>%gs;   # *** should do proper ref
3519
    $x =~ s|<(/?\w.*?/?)>|^^^^$tag_tag~~~~<$1>^^^^/$tag_tag~~~~|gs;
3520
    $x =~ s%((?<!\S)\@[a-z0-9-]+)%^^^^computeroutput~~~~$1^^^^/computeroutput~~~~%gsxi;  # XML or HTML @attribute
3521
    # *** add URL, email, and file path detection
3522
    $x =~ s|&|&amp;|g;
3523
    $x =~ s|<|&lt;|g;
3524
    $x =~ s|>|&gt;|g;
3525
    $x =~ s|\\\\|<literallayout>\n</literallayout>|g;
3526
    $x =~ s|\^\^\^\^\^\^\^\^RAWTEX: (.*?)~~~~~~~~||gse;
3527
    $x =~ s|\^\^\^\^\^\^\^\^RAWDBX: (.*?)~~~~~~~~|unhexit($1)|gse;
3528
    $x =~ s|\^\^\^\^\^\^\^\^RAWRTF: (.*?)~~~~~~~~||gse;
3529
    $x =~ s|\^\^\^\^\^\^\^\^RAWHTML: (.*?)~~~~~~~~||gse;
3530
    $x =~ s|\^\^\^\^|<|g;
3531
    $x =~ s|~~~~|>|g;
3532
    $x =~ s|\*(\S.*?\S)\*|<emphasis role="bold">$1</emphasis>|gs;
3533
    $x =~ s|([\s\(])\+([a-z].*?\w)\+|$1<emphasis>$2</emphasis>|gsi;
3534
    $x =~ s|~(\S.*?\S)~|<computeroutput>$1</computeroutput>|gs;
3535
    $x =~ s|~([/\#\$\w-].*?[\w\)])~|<computeroutput>$1</computeroutput>|gs;
3536
    #$x =~ s|~(\S.*?\S)~|<literal>$1</literal>|gs;
3537
    #$x =~ s|\+(\S.*?\S)\+|<command>$1</command>|gs;
3538
    #$x =~ s|!(\S.*?\S)!|<replaceable>$1</replaceable>|gs;
3539
    #$x =~ s|\[(\S.*?\S)\]|[<link linkend="$1">$1</link>]|gs;  # biblio refs
3540
    $x =~ s|\[(\w.*?[\w.])\]|<xref linkend="$1"/>|gs;  # biblio refs
3541
 
3542
    # convert LaTeX leftovers to something reasonable
3543
    $x =~ s|\\mu|µ|gs;
3544
    $x =~ s|\\acute\{a\}|á|gs;
3545
    $x =~ s|\\times| x |gs;
3546
    $x =~ s|\\:| |gs;
3547
    $x =~ s|(?<!\\)\^\{([^\{\}]+)\}|<sup>$1</sup>|gs if $x =~ /\$/;  # *** different for dbx?
3548
    $x =~ s|(?<!\\)\^(\w)|<sup>$1</sup>|gs if $x =~ /\$/;
3549
    $x =~ s|(?<!\\)_\{([^\{\}]+)\}|<sub>$1</sub>|gs if $x =~ /\$/;
3550
    $x =~ s|(?<!\\)_(\w)|<sub>$1</sub>|gs if $x =~ /\$/;
3551
    $x =~ s/!\\/\\/g;  # Backslash escape
3552
    $x =~ s|\$||gs;
3553
    $x =~ s|<dollari>|\$|gs;
3554
    $x =~ s|<ampersandi>|&|gs;
3555
    $x =~ s|\\pm |±|gs;
3556
    $x =~ s|\\isotope\{(\d+)\}\{(\w+)\}|<sup>$1</sup>$2|gs;
3557
    $x =~ s/\\[a-z]+(\[[^]]+\])*(\{[^}]+\})*//gsi;  # most LaTeX macros
3558
    $x =~ s/\\{/{/gs;
3559
    $x =~ s/\\}/}/gs;
3560
    $x =~ s%====%_%g;
3561
 
3562
    return dbx_entity_escape($x);
3563
}
3564
 
3565
sub dbx_para {
3566
    my $x = &dbx_para_raw;
3567
    return '' if $x =~ /^\s*$/s;
3568
    my $prepara = $para_started ? '' : '<para>';
3569
    return "$prepara$x</para>";
3570
}
3571
 
3572
sub dbx_format {
3573
    return &dbx_para_raw;
3574
}
3575
 
3576
###
3577
### NONL formatting
3578
###
3579
 
3580
sub nonl_format {
3581
    my $x = join ' ', @_;
3582
    return "\n" unless length $x;
3583
    local ($1,$2,$3,$4,$5,$6,$7,$8,$9);
3584
 
3585
    if ($fn_style) {
3586
	#$x =~ s%<<footnote:\s*(.*?)\s*>>%<<footnote: $1>>%gse;
3587
    } else {
3588
	$x =~ s%<<footnote:\s*(.*?)\s*>>%%gs;
3589
    }
3590
    $x =~ s%<<feedbackopts:.*?>>%%gs;
3591
    #                        1   1 2     2    3   3
3592
    $x =~ s%<<addfeedbacktop:(\w+):([^:]+):\s*(.*?)\s*>>%%gse;
3593
    $x =~ s%<<addfeedbackbot:(\w+):([^:]+):\s*(.*?)\s*>>%%gse;
3594
    #                 1   1 2     2 3     3    4   4
3595
    $x =~ s%<<infobox:(\w+):([^:]*):([^:]*):\s*(.*?)\s*>>%%gse;
3596
    $x =~ s%<<label:\s*(.*?)\s*>>%%gs;
3597
    $x =~ s%<<link:(.*?)(:\s+(.*?))?\s*>>%defined($3)?$3:$1%gsex;
3598
    $x =~ s/\(\*\*\*(.*?)\)//gs;
3599
 
3600
    #         1    2  34     5       6     7     8
3601
    #$x =~ s%<<(\S*?(\.((gif)|(jpe?g)|(svg)|(png)|(e?ps))))>>%^^^^img href="$1"/~~~~%gsx;
3602
    $x =~ s%<<tt:\s*(.*?)>>%$1%gsex;
3603
    $x =~ s%<<italic:\s*(.*?)>>%$1%gs;
3604
    $x =~ s%<<bold:\s*(.*?)>>%$1%gs;
3605
    #$x =~ s%<<seeix:\s*(\S[^:>]*):\s*(\S[^>]*)>>%^^^^a href="#$1"~~~~$2^^^^/a~~~~%gs;  # Combined index and ref
3606
 
3607
    # Fredrik Jonsson: Store reference as <see:ref> in html document for future resolving
3608
    #$x =~ s%<<see:\s*(\S[^>]*?)(?::\s+(\S[^>]*))?>>%"^^^^see:?:". fold_label($1) . "=$2~~~~"%gse;
3609
 
3610
    $x =~ s%<<ix:\s*([^>]+)>>%$1%gs; # index entry
3611
    $x =~ s%<<ixx:\s*([^>]+)>>%%gs;  # hidden index entry
3612
    $x =~ s%<<ref:\s*([^:]+): (.*?)>>%$2%gs;
3613
    $x =~ s|\\\\|\n|g;
3614
 
3615
    $x =~ s|\*(\S.*?\S)\*|$1|gs;                         # bold
3616
    $x =~ s{(\A|\s|\()\+([a-z].*?[\w.])\+}{$1$2}gsi;     # italic
3617
    $x =~ s|(?<!~)~([/\#\$\w-].*?[\w\)\}:])~(?!~)|$1|gsex;  # computer output
3618
    $x =~ s|<<RAWTEX: (.*?)>>||gse;
3619
    $x =~ s|<<RAWDBX: (.*?)>>||gse;
3620
    $x =~ s|<<RAWRTF: (.*?)>>||gse;
3621
    $x =~ s|<<RAWHTML: (.*?)>>||gse;
3622
 
3623
    #$x =~ s|~(\w.*?\w)~|<literal>$1</literal>|gs;
3624
    #$x =~ s|\+(\w.*?\w)\+|<command>$1</command>|gs;
3625
    #$x =~ s|!(\w.*?\w)!|<replaceable>$1</replaceable>|gs;
3626
    #$x =~ s|\[(\w.*?\w)\]|[<link linkend="$1">$1</link>]|gs;  # biblio refs
3627
    #$x =~ s|\[(\w.*?[\w.])\]|$1|gsex;  # biblio refs
3628
    #$x =~ s|||gs;
3629
 
3630
    # convert LaTeX leftovers to something reasonable
3631
    $x =~ s|\\mu|µ|gs;
3632
    $x =~ s|\\acute\{a\}|á|gs;
3633
    $x =~ s|\\times| x |gs;
3634
    $x =~ s|\\:| |gs;
3635
    $x =~ s|(?<!\\)\^\{([^\{\}]+)\}|$1|gs if $x =~ /\$/;
3636
    $x =~ s|(?<!\\)\^(\w)|$1|gs if $x =~ /\$/;
3637
    $x =~ s|(?<!\\)_\{([^\{\}]+)\}|$1|gs if $x =~ /\$/;
3638
    $x =~ s|(?<!\\)_(\w)|$1|gs if $x =~ /\$/;
3639
    $x =~ s/!\\/\\/g;  # Backslash escape
3640
    $x =~ s|\$||gs;
3641
    $x =~ s|<dollari>|\$|gs;
3642
    $x =~ s|<ampersandi>|&|gs;
3643
    $x =~ s|\\pm |±|gs;
3644
    $x =~ s|\\isotope\{(\d+)\}\{(\w+)\}|$1 $2|gs;
3645
    $x =~ s/\\[a-z]+(\[[^]]+\])*(\{[^}]+\})*//gsi;  # most LaTeX macros
3646
    $x =~ s/\\{/{/gs;
3647
    $x =~ s/\\}/}/gs;
3648
    $x =~ s%====%_%g;
3649
 
3650
    return $x;
3651
}
3652
 
3653
sub nonl_para {
3654
    my $x = &nonl_format;
3655
    $x =~ s/\r?\n\r?\n/<<PAR>>/g;
3656
    $x =~ s/\s*\r?\n/ /g;
3657
    $x =~ s/<<PAR>>/\n\n/g;
3658
    return $x;
3659
}
3660
 
3661
sub pdseal_para {
3662
    my $x = join ' ', @_;
3663
    $x =~ s|\\\\||g;
3664
    $x =~ s%<<footnote:\s*(.*?)\s*>>%%gs;
3665
    $x =~ s%<<see:\s*(\S[^>]*?)(?::\s+(\S[^>]*))?>>%%gse;
3666
    $x = &nonl_format($x);
3667
    $x =~ s/\r?\n\r?\n/<<PAR>>/g;
3668
    $x =~ s/\s*\r?\n/ /g;
3669
    $x =~ s/<<PAR>>/\n\n/g;
3670
    return $x;
3671
}
3672
 
3673
###
3674
### RTF formatting
3675
###
3676
 
3677
sub rtf_format_infobox {
3678
    my ($id,$link,$tableargs,$content) = @_;
3679
    return $content;
3680
}
3681
 
3682
sub rtf_para_raw {
3683
    my $x = join ' ', @_;
3684
    return "\n" unless length $x;
3685
    local ($1,$2,$3,$4,$5,$6,$7,$8,$9);
3686
 
3687
    if ($fn_style == 3) {
3688
	$x =~ s%<<footnote:\s*(.*?)\s*>>%$fn_num++,qq({\\*\\footnote $1})%gse;
3689
    } elsif ($fn_style == 1) {
3690
	$x =~ s%<<footnote:\s*(.*?)\s*>>%$fn_num++,qq(\\chftn{\\*\\footnote {\\up6\\chftn } $1})%gse;
3691
	#$x =~ s%<<footnote:\s*(.*?)\s*>>%$fn_num++,qq([*** fn$fn_num: $1 ***])%gse;
3692
    } else {
3693
	$x =~ s%<<footnote:\s*(.*?)\s*>>%%gs;
3694
    }
3695
    $x =~ s%<<feedbackopts:.*?>>%%gs;
3696
    $x =~ s%<<addfeedbacktop:.*?>>%%gs;
3697
    $x =~ s%<<addfeedbackbot:.*?>>%%gs;
3698
    $x =~ s%<<infobox:(\w+):([^:]*):([^:]*):\s*(.*?)\s*>>%rtf_format_infobox($1,$2,$3,$4)%gse;
3699
    $x =~ s/\(\*\*\*(.*?)\)//gs;
3700
 
3701
    #         1    2  34     5       6     7     8
3702
    $x =~ s%<<(\S*?(\.((gif)|(jpe?g)|(svg)|(png)|(e?ps))))>>%
3703
	$inline_open^^^^imagedata fileref="$1"/~~~~$inline_close%gsx;
3704
    $x =~ s%<<tt:\s*(.*?)>>%{\\f2 $1}%gs;
3705
    $x =~ s%<<bold:\s*(.*?)>>%{\\b $1}%gs;
3706
    $x =~ s%<<italic:\s*(.*?)>>%{\\i $1}%gs;
3707
    $x =~ s%<<see:\s*(\S[^>]*?)(?::\s+(\S[^>]*))?>>%qq(^^^^xref linkend=") . fold_label($1) . qq("/~~~~)%gse;
3708
    $x =~ s%<<ix:\s*([^>]+)>>%{\\xe $1}%gs;  # index entry
3709
    $x =~ s%<<ref:\s*([^:]+): (.*?)>>%<xref linkend="$2"/>%gs;   # *** should do proper ref
3710
    $x =~ s|<(/?\w.*?/?)>|^^^^$tag_tag~~~~<$1>^^^^/$tag_tag~~~~|gs;
3711
    # *** add URL, email, and file path detection
3712
    $x =~ s|\\\\|\\ql\\line |g;
3713
    $x =~ s|\^\^\^\^\^\^\^\^RAWTEX: (.*?)~~~~~~~~||gse;
3714
    $x =~ s|\^\^\^\^\^\^\^\^RAWDBX: (.*?)~~~~~~~~||gse;
3715
    $x =~ s|\^\^\^\^\^\^\^\^RAWRTF: (.*?)~~~~~~~~|unhexit($1)|gse;
3716
    $x =~ s|\^\^\^\^\^\^\^\^RAWHTML: (.*?)~~~~~~~~||gse;
3717
    $x =~ s|\^\^\^\^|<|g;
3718
    $x =~ s|~~~~|>|g;
3719
    $x =~ s<\*(\S.*?\S)\*><{\\b $1}>gs;  # bold
3720
    $x =~ s<(\A|\s|\()\+([a-z].*?[\w.])\+><$1\{\\i $2\}>gsi;     # italic
3721
    #$x =~ s|([\s\(])\+([a-z].*?\w)\+|$1{\\i $2}|gsi;  # Italic  ***
3722
    $x =~ s|~(\S.*?\S)~|{\\f2 $1 }|gs;
3723
    $x =~ s|~([/\#\$\w-].*?[\w\)])~|{\\f2 $1 }|gs;
3724
    #$x =~ s|~(\S.*?\S)~|<literal>$1</literal>|gs;
3725
    #$x =~ s|\+(\S.*?\S)\+|<command>$1</command>|gs;
3726
    #$x =~ s|!(\S.*?\S)!|<replaceable>$1</replaceable>|gs;
3727
    #$x =~ s|\[(\S.*?\S)\]|[<link linkend="$1">$1</link>]|gs;  # biblio refs
3728
    $x =~ s|\[(\w.*?[\w.])\]|<xref linkend="$1"/>|gs;  # biblio refs
3729
 
3730
    # convert LaTeX leftovers to something reasonable
3731
    $x =~ s|\\mu|µ|gs;
3732
    $x =~ s|\\acute\{a\}|á|gs;
3733
    $x =~ s|\\times| x |gs;
3734
    $x =~ s|\\:| |gs;
3735
    $x =~ s|(?<!\\)\^\{([^\{\}]+)\}|{\\up $1}|gs if $x =~ /\$/;
3736
    $x =~ s|(?<!\\)\^(\w)|{\\up $1}|gs if $x =~ /\$/;
3737
    $x =~ s|(?<!\\)_\{([^\{\}]+)\}|{\\dn $1}|gs if $x =~ /\$/;
3738
    $x =~ s|(?<!\\)_(\w)|{\\dn $1}|gs if $x =~ /\$/;
3739
    $x =~ s/!\\/\\/g;  # Backslash escape
3740
    $x =~ s|\$||gs;
3741
    $x =~ s|<dollari>|\$|gs;
3742
    $x =~ s|<ampersandi>|&|gs;
3743
    $x =~ s|\\pm |±|gs;
3744
    $x =~ s|\\isotope\{(\d+)\}\{(\w+)\}|<sup>$1</sup>$2|gs;
3745
    #$x =~ s/\\[a-z]+(\[[^]]+\])*(\{[^}]+\})*//gsi;  # most LaTeX macros
3746
    $x =~ s/\\{/{/gs;
3747
    $x =~ s/\\}/}/gs;
3748
    $x =~ s%====%_%g;
3749
 
3750
    return $x;
3751
}
3752
 
3753
sub rtf_para {
3754
    my $x = &rtf_para_raw;
3755
    return '' if $x =~ /^\s*$/s;
3756
    #my $prepara = $para_started ? '' : '\\par ';
3757
    #return "$prepara$x";
3758
    #return "{\\pard $rtf_styles{'s10'} \\s10 $x\\par}\n";
3759
 
3760
    # We want the paragraphs to inherit style from containg unit, e.g. to preserve
3761
    # list indentation.
3762
    return "{$x\\par}\\fi0\n";
3763
}
3764
 
3765
sub rtf_format {
3766
    return &rtf_para_raw;
3767
}
3768
 
3769
###
3770
### HTML formatting
3771
###
3772
 
3773
sub tag {
3774
    my ($tag, $cont) = @_;
3775
    if ($cont) {
3776
	my ($thetag) = split /\s+/, $tag, 2;
3777
	return qq(^^^^$tag~~~~$cont^^^^/$thetag~~~~);
3778
    } else {
3779
	return qq(^^^^$tag~~~~);
3780
    }
3781
}
3782
 
3783
sub html_format_func {
3784
    my ($ret, $func, $args) = @_;
3785
    my $proto = "$ret$func($args)";
3786
    #warn "CANDIDATE html func($func)\n";
3787
    return $proto if $not_a_path{$proto};
3788
    #return "$ret$func($args)" if !$pdflag{'autoformat'};
3789
    $proto =~ s%_%====%g;
3790
    #warn "html func($func)\n";
3791
    return tag('i', $proto);
3792
}
3793
 
3794
sub html_format_email {
3795
    my ($uid, $dom) = @_;
3796
    my $addr = "$uid\@$dom";
3797
    return $addr if $not_a_path{$addr} || $not_a_url{$addr};
3798
    #warn "email uid($uid) dom($dom)\n";
3799
    #return "$uid\@$dom" if !$pdflag{'autoformat'};
3800
    $addr =~ s%_%====%g;
3801
    $addr =~ s|\.|''''|g;
3802
    return tag(qq(a href="mailto:$addr"), "$addr");
3803
}
3804
 
3805
sub html_format_url {
3806
    my ($url, $what) = @_;
3807
    return $url if $not_a_path{$url} || $not_a_url{$url};
3808
    #warn "url($url) $what\n";
3809
    #return $url if !$pdflag{'autoformat'};
3810
    $url =~ s%_%====%g;
3811
    $url =~ s|\.|''''|g;
3812
    $url =~ s|/|""""|g;
3813
    my $link = $url;
3814
    $link = 'http://'.$link if $link !~ m{:""""""""};
3815
    return tag(qq(a href="$link"), $url);
3816
}
3817
 
3818
sub html_format_country_url {
3819
    my ($url, $cc, $what) = @_;
3820
    return $url if $not_a_country{$cc};
3821
    return $url if $not_a_path{$url} || $not_a_url{$url};
3822
    #warn "url($url) cc($cc) $what";
3823
    return html_format_url($url);
3824
}
3825
 
3826
sub html_format_path {
3827
    my ($path,$what) = @_;
3828
    return $path if $not_a_path{$path};
3829
    return $path if $path=~m|^[0-9/.,-]+$|s;  # Avoid pure numbers like 12/34 or 1.2
3830
    #warn "path($path) $what";
3831
    $path =~ s%_%====%g;
3832
    $path =~ s|\.|''''|g;
3833
    $path =~ s|/|""""|g;
3834
    return tag('tt', $path);
3835
}
3836
 
3837
sub html_format_ip {
3838
    my ($path,$what) = @_;
3839
    return $path if $not_a_path{$path};
3840
    return $path if $path=~m|^\d+\.\d+\.?$|s;       # Avoid pure numbers like 1.2
3841
    return $path if $path=~m|^\d+\.\d+\.\d+\.?$|s;  # Avoid pure numbers like 1.2.3
3842
    #warn "path($path) $what";
3843
    $path =~ s%_%====%g;
3844
    $path =~ s|\.|''''|g;
3845
    $path =~ s|/|""""|g;
3846
    return tag('tt', $path);
3847
}
3848
 
3849
sub html_format_ref {
3850
    my ($ref) = @_;
3851
    return qq([$ref]);
3852
}
3853
 
3854
sub html_format_tt {
3855
    my ($tt) = @_;
3856
    $tt =~ s/\$/^^^^dollari~~~~/gs;
3857
    return tag('tt', $tt);
3858
}
3859
 
3860
sub html_format_fn {
3861
    my ($note) = @_;
3862
    ++$fn_num;
3863
    $note =~ s/\"/^^^^ampersandi~~~~quot;/gs;   # Quote friendly
3864
    $note =~ s%</?\w+.*?>%%gs;    # Zap tags such as <i> or <tt>
3865
    #warn "FN($note)";
3866
    $note = " (($note))";  # Renders much more naturally
3867
    return tag(qq(img src="fn.png" title="$note" alt="$note"));
3868
}
3869
 
3870
sub html_format_infobox {
3871
    my ($id,$link,$tableargs,$content) = @_;
3872
    #$note =~ s/\"/^^^^ampersandi~~~~quot;/gs;   # Quote friendly
3873
    #$note =~ s%</?\w+.*?>%%gs;    # Zap tags such as <i> or <tt>
3874
    #warn "infobox($note)";
3875
    $content =~ s/</^^^^/gs;
3876
    $content =~ s/>/~~~~/gs;
3877
    if (length($link)) {
3878
	return tag(qq(a href="#" onClick="vis('$id',$id=!$id);")).$link.tag('/a')
3879
	    .tag(qq(table id=$id $tableargs)).tag('tr').tag('td').$content
3880
	    .tag('/td').tag('/tr').tag('/table');
3881
    } else {
3882
	return tag(qq(table id=$id $tableargs)).tag('tr').tag('td').$content
3883
	    .tag('/td').tag('/tr').tag('/table');
3884
    }
3885
}
3886
 
3887
sub html_format_addfeedback {
3888
    my ($vis,$link,$title) = @_;
3889
    return '' if !$vis;
3890
    my $templ = readall('pdblogcom.html');
3891
    $templ =~ s/!!LINK/$link/gs;
3892
    $templ =~ s/!!TIT/$title/gs;
3893
    $templ =~ s/!!BASE/$base/gs;
3894
    $templ =~ s/</^^^^/gs;
3895
    $templ =~ s/>/~~~~/gs;
3896
    return $templ;
3897
}
3898
 
3899
sub html_biblio {
3900
    my ($bibref) = @_;
3901
    return '['.$biblio.']' if $not_a_path{$biblio};
3902
    return qq([<a href="#$bibref"/>$1</a>]);
3903
}
3904
 
3905
sub html_format {
3906
    my $x = join ' ', @_;
3907
    return "\n" unless length $x;
3908
    local ($1,$2,$3,$4,$5,$6,$7,$8,$9);
3909
 
3910
    if ($fn_style) {
3911
	$x =~ s%<<footnote:\s*(.*?)\s*>>%html_format_fn($1)%gse;
3912
    } else {
3913
	$x =~ s%<<footnote:\s*(.*?)\s*>>%%gs;
3914
    }
3915
    $x =~ s%<<feedbackopts:.*?>>%%gs;
3916
    #                        1   1 2     2    3   3
3917
    $x =~ s%<<addfeedbacktop:(\w+):([^:]+):\s*(.*?)\s*>>%html_format_addfeedback($1,$2,$3)%gse;
3918
    $x =~ s%<<addfeedbackbot:(\w+):([^:]+):\s*(.*?)\s*>>%html_format_addfeedback($1,$2,$3)%gse;
3919
    #                 1   1 2     2 3     3    4   4
3920
    $x =~ s%<<infobox:(\w+):([^:]*):([^:]*):\s*(.*?)\s*>>%html_format_infobox($1,$2,$3,$4)%gse;
3921
    $x =~ s%<<label:\s*(.*?)\s*>>%^^^^a id="$1"~~~~^^^^/a~~~~%gs;
3922
    $x =~ s%<<link:(.*?)(:\s+(.*?))?\s*>>%qq(^^^^a href="$1"~~~~).(defined($3)?$3:$1).'^^^^/a~~~~'%gsex;
3923
    $x =~ s/\(\*\*\*(.*?)\)//gs;
3924
 
3925
    if ($pdflag{'autoformat'} == 1) {
3926
	# function and email detection
3927
	#       1        12            2 3             3  4              4  5         5
3928
	$x =~ s{(\A|\s|\()([a-z0-9_:]+=)?([a-z0-9_.:-]+)\(([a-z0-9_:, -]*)\)([,.!?\)]?)(?=\s|\Z)}{$1.html_format_func($2,$3,$4).$5}gisex;
3929
	#       1           12            2  3             34           4
3930
	$x =~ s{(\A|\s|\(|\<)([a-z0-9_.-]+)\@([a-z0-9_.-]+?)([,.!?\)\>]?)(?=\s|\Z)}{$1.html_format_email($2,$3).$4}gisex;
3931
 
3932
	# URL and domain name detection
3933
	#       1        12                                     23         3
3934
	$x =~ s{(\A|\s|\()([a-z]+://[a-z0-9][a-z0-9_.:/?&=+%\#-]+)([,.!?\)]?)(?=\s|\Z)}{$1.html_format_url($2,"proto2://$3/").$3}gisex;
3935
	#       1        12                                            23         3
3936
	$x =~ s{(\A|\s|\()(www\.[a-z0-9_-]+\.[a-z0-9][a-z0-9_.:/?&=+%-]+)([,.!?\)]?)(?=\s|\Z)}{$1.html_format_url($2,'www').$3}gisex;
3937
	#       1        12                                            23         3
3938
	$x =~ s{(\A|\s|\()(ftp\.[a-z0-9_-]+\.[a-z0-9][a-z0-9_.:/?&=+%-]+)([,.!?\)]?)(?=\s|\Z)}{$1.html_format_url($2,'ftp').$3}gisex;
3939
	#       1        12                                 3                   3 24         4
3940
	$x =~ s{(\A|\s|\()([a-z0-9][a-z0-9_.-]+[a-z0-9]\.com(/[a-z0-9_.:/?&=+%-]+)?)([,.!?\)]?)(?=\s|\Z)}{$1.html_format_url($2,'com').$4}gisex;
3941
	$x =~ s{(\A|\s|\()([a-z0-9][a-z0-9_.-]+[a-z0-9]\.net(/[a-z0-9_.:/?&=+%-]+)?)([,.!?\)]?)(?=\s|\Z)}{$1.html_format_url($2,'net').$4}gisex;
3942
	$x =~ s{(\A|\s|\()([a-z0-9][a-z0-9_.-]+[a-z0-9]\.org(/[a-z0-9_.:/?&=+%-]+)?)([,.!?\)]?)(?=\s|\Z)}{$1.html_format_url($2,'org').$4}gisex;
3943
 
3944
	#       1        12                              3          34                   4 25         5
3945
	$x =~ s{(\A|\s|\()([a-z0-9][a-z0-9_.-]+[a-z0-9]\.([a-z][a-z])(/[a-z0-9_.:/?&=+%-]+)?)([,.!?\)]?)(?=\s|\Z)}{$1.html_format_country_url($2,$3,"cc_url($5)").$5}gisex;
3946
	#warn "==[$x]==";
3947
 
3948
	# file path detection
3949
	#       1        12                                 23             3
3950
	$x =~ s{(\A|\s|\()(~?[a-z0-9_./-]*\.[a-z][a-z0-9_]*?)([,.!?\)]{0,2})(?=\s|\Z)}{$1.html_format_path($2,"path1($3)").$3}gisex;
3951
	#       1        12                             23             3
3952
	$x =~ s{(\A|\s|\()(~?[a-z0-9_.-]*/[a-z0-9_./-]*?)([,.!?\)]{0,2})(?=\s|\Z)}{$1.html_format_path($2,"path2($3)").$3}gisex;
3953
	#       1        12                   23             34  term 4    URN detect
3954
	$x =~ s{(\A|\s|\()(urn:[a-z0-9_./:-]*?)([,.!?\)]{0,2})(?=\s|\Z)}{$1.html_format_path($2,"urn($3)").$3}gisex;
3955
	#       1        12             23             3
3956
	$x =~ s{(\A|\s|\()(\d+\.[\d./*]+)([,.!?\)]{0,2})(?=\s|\Z)}{$1.html_format_ip($2,"ip($3)").$3}gisex;
3957
    }
3958
 
3959
    #         1    2  34     5       6     7     8
3960
    $x =~ s%<<(\S*?(\.((gif)|(jpe?g)|(svg)|(png)|(e?ps))))>>%^^^^img href="$1"/~~~~%gsx;
3961
    $x =~ s%<<tt:\s*(.*?)>>%html_format_tt($1)%gsex;
3962
    $x =~ s%<<italic:\s*(.*?)>>%^^^^i~~~~$1^^^^/i~~~~%gs;
3963
    $x =~ s%<<bold:\s*(.*?)>>%^^^^b~~~~$1^^^^/b~~~~%gs;
3964
    $x =~ s%<<br:\s*>>%^^^^br~~~~%gs;
3965
    $x =~ s%<<seeix:\s*(\S[^:>]*):\s*(\S[^>]*)>>%^^^^a href="#$1"~~~~$2^^^^/a~~~~%gs;  # Combined index and ref
3966
 
3967
    # Fredrik Jonsson: Store reference as <see:ref> in html document for future resolving
3968
    $x =~ s%<<see:\s*(\S[^>]*?)(?::\s+(\S[^>]*))?>>%"^^^^see:?:". fold_label($1) . "=$2~~~~"%gse;
3969
 
3970
    $x =~ s%<<ix:\s*([^>]+)>>%$1%gs; # index entry
3971
    $x =~ s%<<ixx:\s*([^>]+)>>%%gs;  # hidden index entry
3972
    $x =~ s%<<ref:\s*([^:]+): (.*?)>>%$2%gs;   # *** should do proper ref
3973
    $x =~ s|<(/?\w.*?/?)>|^^^^$tag_tag~~~~<$1>^^^^/$tag_tag~~~~|gs;
3974
    $x =~ s%((?<!\S)\@[a-z0-9-]+)%html_format_tt($1)%gsexi;  # XML or HTML @attribute
3975
    $x =~ s|&|&amp;|g;
3976
    $x =~ s|<|&lt;|g;
3977
    $x =~ s|>|&gt;|g;
3978
    $x =~ s|\\\\|^^^^br~~~~|g;
3979
    $x =~ s|''''|.|g;
3980
    $x =~ s|""""|/|g;
3981
 
3982
    $x =~ s|\*(\S.*?\S)\*|^^^^b~~~~$1^^^^/b~~~~|gs;                         # bold
3983
    $x =~ s{(\A|\s|\()\+([a-z].*?[\w.])\+}{$1^^^^i~~~~$2^^^^/i~~~~}gsi;     # italic
3984
    $x =~ s|(?<!~)~([/\#\$\w-].*?[\w\)\}:])~(?!~)|html_format_tt($1)|gsex;  # computer output
3985
    $x =~ s|\^\^\^\^\^\^\^\^RAWTEX: (.*?)~~~~~~~~||gse;
3986
    $x =~ s|\^\^\^\^\^\^\^\^RAWDBX: (.*?)~~~~~~~~||gse;
3987
    $x =~ s|\^\^\^\^\^\^\^\^RAWRTF: (.*?)~~~~~~~~||gse;
3988
    $x =~ s|\^\^\^\^\^\^\^\^RAWHTML: (.*?)~~~~~~~~|unhexit($1)|gse;
3989
    $x =~ s|\^\^\^\^|<|g;
3990
    $x =~ s|~~~~|>|g;
3991
 
3992
    #$x =~ s|~(\w.*?\w)~|<literal>$1</literal>|gs;
3993
    #$x =~ s|\+(\w.*?\w)\+|<command>$1</command>|gs;
3994
    #$x =~ s|!(\w.*?\w)!|<replaceable>$1</replaceable>|gs;
3995
    #$x =~ s|\[(\w.*?\w)\]|[<link linkend="$1">$1</link>]|gs;  # biblio refs
3996
    $x =~ s|\[(\w.*?[\w.])\]|html_biblio($1)|gsex;  # biblio refs
3997
    #$x =~ s|||gs;
3998
 
3999
    # convert LaTeX leftovers to something reasonable
4000
    $x =~ s|\\mu|µ|gs;
4001
    $x =~ s|\\acute\{a\}|á|gs;
4002
    $x =~ s|\\times| x |gs;
4003
    $x =~ s|\\:| |gs;
4004
    $x =~ s|(?<!\\)\^\{([^\{\}]+)\}|<sup>$1</sup>|gs if $x =~ /\$/;
4005
    $x =~ s|(?<!\\)\^(\w)|<sup>$1</sup>|gs if $x =~ /\$/;
4006
    $x =~ s|(?<!\\)_\{([^\{\}]+)\}|<sub>$1</sub>|gs if $x =~ /\$/;
4007
    $x =~ s|(?<!\\)_(\w)|<sub>$1</sub>|gs if $x =~ /\$/;
4008
    $x =~ s/!\\/\\/g;  # Backslash escape
4009
    $x =~ s|\$||gs;
4010
    $x =~ s|<dollari>|\$|gs;
4011
    $x =~ s|<ampersandi>|&|gs;
4012
    $x =~ s|\\pm |±|gs;
4013
    $x =~ s|\\isotope\{(\d+)\}\{(\w+)\}|<sup>$1</sup>$2|gs;
4014
    $x =~ s/\\[a-z]+(\[[^]]+\])*(\{[^}]+\})*//gsi;  # most LaTeX macros
4015
    $x =~ s/\\{/{/gs;
4016
    $x =~ s/\\}/}/gs;
4017
    $x =~ s%====%_%g;
4018
 
4019
    return $x;
4020
}
4021
 
4022
sub html_para {
4023
    my $x = &html_format;
4024
    return '' if $x =~ /^\s*$/s;
4025
    my $prepara = $para_started ? '' : '<p>';
4026
    return "$prepara$x</p>";
4027
}
4028
 
4029
 
4030
###
4031
### TeX Special Character Escaping
4032
###
4033
 
4034
sub tex_esc_verbatim {
4035
    my ($x) = @_;
4036
    local ($1,$2);
4037
    #$x =~ s/(\r?\n)+//s;   # *** only zap first CRNL?
4038
    return $x;
4039
    $x =~ s/([\&])/\\$1/g;   # fjon wants to abolish this
4040
    #$x =~ s/\\/\$\\backslash\$/g;  More useful to permit customization
4041
    $x =~ s/([\#\$\%\&\_\{\}])/\\$1/g;
4042
    $x =~ s/([~^])/\\$1\{\}/g;
4043
    $x =~ s/!\\/\$\\backslash\$/g;
4044
    return $x;
4045
}
4046
 
4047
sub tex_esc {
4048
    my ($x) = @_;
4049
    local ($1,$2);
4050
    $x =~ s/([\#\%\&\_\{\}])/\\$1/g;  # \$ is needed for math
4051
    $x =~ s/([~^])/\\$1\{\}/g;
4052
    $x =~ s/!\\/\$\\backslash\$/g;
4053
    return $x;
4054
}
4055
 
4056
sub tex_esc_tag {
4057
    return "\\".$_[0].'^^^^'.tex_esc($_[1]).'````';
4058
}
4059
 
4060
sub tex_esc_tt {
4061
    my ($x) = @_;
4062
    local ($1,$2);
4063
    #warn "escaping [$x]";
4064
    $x =~ s/([_\$\{\}\#])/\\$1/g;  # \&\%
4065
    $x =~ s/\[/~~~~/g;
4066
    $x =~ s/\]/\$\$\$\$/g;
4067
    $x =~ s/</::::/g;
4068
    $x =~ s/>/;;;;/g;
4069
    #$x =~ s/([~^])/\\$1\{\}/g;
4070
    #$x =~ s/!\\/\$\\backslash\$/g;
4071
    #warn "escaped [$x]";
4072
    return $x;
4073
}
4074
 
4075
sub tex_esc_tt_tag {
4076
    return "\\".$_[0].'^^^^'.tex_esc_tt($_[1]).'````';
4077
}
4078
 
4079
sub tex_format_func {
4080
    my ($ret, $func, $args) = @_;
4081
    my $proto = "$ret$func($args)";
4082
    return $proto if $not_a_path{$proto};
4083
    warn "func($func)\n";
4084
    $ret = tex_esc_tt($ret);
4085
    $func = tex_esc_tt($func);
4086
    $args = tex_esc_tt($args);
4087
    return '\\emph^^^^' . $ret . $func . '(' . $args . ")````\\index^^^^$func\@\\emph{$func()}````";
4088
}
4089
 
4090
sub tex_format_email {
4091
    my ($uid, $dom) = @_;
4092
    my $addr = "$uid\@$dom";
4093
    return $addr if $not_a_path{$addr} || $not_a_url{$addr};
4094
    warn "email uid($uid) dom($dom)\n";
4095
    $uid = tex_esc_tt($uid);
4096
    $dom = tex_esc_tt($dom);
4097
    $uid =~ s|\.|''''|g;
4098
    $dom =~ s|\.|''''|g;
4099
    return "\\texttt^^^^$uid\@$dom````\\index^^^^$uid\"\@$dom````";
4100
}
4101
 
4102
sub tex_format_url {
4103
    my ($url, $what) = @_;
4104
    return $url if $not_a_path{$url} || $not_a_url{$url};
4105
    warn "url($url) $what\n";
4106
    $url = tex_esc_tt($url);
4107
    $url =~ s|\.|''''|g;
4108
    $url =~ s|/|""""|g;
4109
    return '\\texttt^^^^' . $url . '````';
4110
}
4111
 
4112
sub tex_format_country_url {
4113
    my ($url, $cc, $what) = @_;
4114
    #warn "url($url) cc($cc) $what";
4115
    return $url if $not_a_country{$cc};
4116
    return $url if $not_a_path{$url} || $not_a_url{$url};
4117
    warn "url($url) cc($cc) $what\n";
4118
    return tex_format_url($url);
4119
}
4120
 
4121
sub tex_format_path {
4122
    my ($path,$what) = @_;
4123
    return $path if $not_a_path{$path};
4124
    return $path if $path=~m|^[0-9/.,-]+$|s;  # Avoid pure numbers like 12/34 or 1.2
4125
    warn "path($path) $what\n";
4126
    $path = tex_esc_tt($path);
4127
    $path =~ s|\.|''''|g;
4128
    $path =~ s|/|""""|g;
4129
    return '\\texttt^^^^' . $path . '````';
4130
}
4131
 
4132
sub tex_format_ip {
4133
    my ($path,$what) = @_;
4134
    return $path if $not_a_path{$path};
4135
    return $path if $path=~m|^\d+\.\d+\.?$|s;       # Avoid pure numbers like 1.2
4136
    return $path if $path=~m|^\d+\.\d+\.\d+\.?$|s;  # Avoid pure numbers like 1.2.3
4137
    warn "ip($path) $what\n";
4138
    $path = tex_esc_tt($path);
4139
    $path =~ s|\.|''''|g;
4140
    $path =~ s|/|""""|g;
4141
    return '\\texttt^^^^' . $path . '````';
4142
}
4143
 
4144
sub tex_format_ref {
4145
    my ($ref) = @_;
4146
    #$ref =~ s/^[+*~]//; $ref =~ s/[+*~]$//;
4147
    $ref =~ s/^\\[a-z]+\^\^\^\^(.*?)````/$1/gsi;
4148
    return "\\index^^^^$ref````";
4149
}
4150
 
4151
sub tex_format_infobox {
4152
    my ($id,$link,$tableargs,$content) = @_;
4153
    return $content;
4154
}
4155
 
4156
sub tex_esc_all {
4157
    my ($x) = @_;
4158
    $x = tex_esc_tt($x);
4159
    $x =~ s|\.|''''|g;
4160
    $x =~ s|/|""""|g;
4161
    return $x;
4162
}
4163
 
4164
sub tex_esc_underscore {
4165
    my ($x) = @_;
4166
    $x =~ s|_|!underscore|g;
4167
    return $x;
4168
}
4169
 
4170
sub tex_biblio {
4171
    my ($bibref) = @_;
4172
    return '['.$bibref.']' if $not_a_path{$bibref};
4173
    return '\\cite^^^^'.$bibref.'````\\index^^^^'.$bibref.'````';
4174
}
4175
 
4176
sub tex_format {
4177
    my $x = join ' ', @_;
4178
    return "\n" unless length $x;
4179
    local ($1,$2,$3,$4,$5,$6,$7,$8,$9);
4180
 
4181
    $x =~ s%<<e:\s*(.*?)>>%tex_esc_all($1)%gsex;
4182
    $x =~ s/\(\*\*\*(.*?)\)/push(@todo, $1),''/ges;
4183
 
4184
    #warn "--[$x]--";
4185
 
4186
    if ($pdflag{'autoformat'} == 1) {
4187
	# function and email detection
4188
	#       1        12            2 3             3  4              4  5         5
4189
	$x =~ s{(\A|\s|\()([a-z0-9_:]+=)?([a-z0-9_.:-]+)\(([a-z0-9_:, -]*)\)([,.!?\)]?)(?=\s|\Z)}{$1.tex_format_func($2,$3,$4).$5}gisex;
4190
	#       1           12            2  3             34           4
4191
	$x =~ s{(\A|\s|\(|\<)([a-z0-9_.-]+)\@([a-z0-9_.-]+?)([,.!?\)\>]?)(?=\s|\Z)}{$1.tex_format_email($2,$3).$4}gisex;
4192
 
4193
	# URL and domain name detection
4194
	#       1        12                                    23         3
4195
	$x =~ s{(\A|\s|\()([a-z]+://[a-z0-9][a-z0-9_.:/?&=+%\#-]+)([,.!?\)]?)(?=\s|\Z)}{$1.tex_format_url($2,"proto2://$3/").$3}gisex;
4196
	#       1        12                                            23         3
4197
	$x =~ s{(\A|\s|\()(www\.[a-z0-9_-]+\.[a-z0-9][a-z0-9_.:/?&=+%-]+)([,.!?\)]?)(?=\s|\Z)}{$1.tex_format_url($2,'www').$3}gisex;
4198
	#       1        12                                            23         3
4199
	$x =~ s{(\A|\s|\()(ftp\.[a-z0-9_-]+\.[a-z0-9][a-z0-9_.:/?&=+%-]+)([,.!?\)]?)(?=\s|\Z)}{$1.tex_format_url($2,'ftp').$3}gisex;
4200
	#       1        12                                 3                   3 24         4
4201
	$x =~ s{(\A|\s|\()([a-z0-9][a-z0-9_.-]+[a-z0-9]\.com(/[a-z0-9_.:/?&=+%-]+)?)([,.!?\)]?)(?=\s|\Z)}{$1.tex_format_url($2,'com').$4}gisex;
4202
	$x =~ s{(\A|\s|\()([a-z0-9][a-z0-9_.-]+[a-z0-9]\.net(/[a-z0-9_.:/?&=+%-]+)?)([,.!?\)]?)(?=\s|\Z)}{$1.tex_format_url($2,'net').$4}gisex;
4203
	$x =~ s{(\A|\s|\()([a-z0-9][a-z0-9_.-]+[a-z0-9]\.org(/[a-z0-9_.:/?&=+%-]+)?)([,.!?\)]?)(?=\s|\Z)}{$1.tex_format_url($2,'org').$4}gisex;
4204
 
4205
	#       1        12                              3          34                   4 25         5
4206
	$x =~ s{(\A|\s|\()([a-z0-9][a-z0-9_.-]+[a-z0-9]\.([a-z][a-z])(/[a-z0-9_.:/?&=+%-]+)?)([,.!?\)]?)(?=\s|\Z)}{$1.tex_format_country_url($2,$3,"cc_url($5)").$5}gisex;
4207
	#warn "==[$x]==" if $x =~ m%/var/wr/PQ%;
4208
 
4209
	# file path detection
4210
        #       1  pre   12    path.ext                     23 post        34 term  4
4211
        $x =~ s{(\A|\s|\()(~?[a-z0-9_./-]*\.[a-z][a-z0-9_]*?)([,.!?\)]{0,2})(?=\s|\Z)}{$1.tex_format_path($2,"path1($3)").$3}gisex;
4212
        #       1  pre   12   a/b or /a/b               23 post        34 term  4
4213
	$x =~ s{(\A|\s|\()(~?[a-z0-9_.-]*/[a-z0-9_./-]*?)([,.!?\)]{0,2})(?=\s|\Z)}{$1.tex_format_path($2,"path2($3)").$3}gisex;
4214
 
4215
        #       1        12                   23             34  term 4    URN detect
4216
        $x =~ s{(\A|\s|\()(urn:[a-z0-9_./:-]*?)([,.!?\)]{0,2})(?=\s|\Z)}{$1.tex_format_path($2,"urn($3)").$3}gisex;
4217
 
4218
        #       1        12             23             34 term  4
4219
        $x =~ s{(\A|\s|\()(\d+\.[\d./*]+)([,.!?\)]{0,2})(?=\s|\Z)}{$1.tex_format_ip($2,"ip($3)").$3}gisex;
4220
    }
4221
    #warn "..[$x]..";
4222
 
4223
    $x =~ s|\*(\S.*?\S)\*|\\textbf^^^^$1````|gs;  # bold
4224
    $x =~ s{(\A|\s|\()\+([a-z].*?[\w.])\+}{$1\\emph^^^^$2````}gsi;  # italic
4225
    $x =~ s|~([/\#\$\w-].*?[\w\)\}:])~|tex_esc_tt_tag('texttt', $1)|gsex; # computer output
4226
    #$x =~ s|\+(\w.*?\w)\+|\\textsf^^^^$1````|gs;  # command
4227
    #$x =~ s|!(\w.*?\w)!|\\textsf^^^^\\emph^^^^$1````````|gs;  # replaceable
4228
    $x =~ s%<<tt:\s*(.*?)>>%tex_esc_tt_tag('texttt', $1)%gsex;
4229
    $x =~ s%<<italic:\s*(.*?)>>%tex_esc_tag('emph', $1)%gsex;
4230
    $x =~ s%<<bold:\s*(.*?)>>%tex_esc_tag('textbf', $1)%gsex;
4231
    $x =~ s%<<br:\s*>>%\\\\%gs;
4232
    $x =~ s%<<seeix:\s*(\S[^:>]*):\s*(\S[^>]*)>>%"\\ref^^^^$1```` $2".tex_format_ref($2)%gsex;  # Combined index and ref
4233
    # Fredrik Jonsson: Don't do anything with references yet, resolve later
4234
    $x =~ s%<<see:\s*(\S[^>]*?)(?::\s+(\S[^>]*))?>>%'::::see:?:' . fold_label($1) . "=$2;;;;"%gse;
4235
 
4236
    $x =~ s%<<ix:\s*(\S[^>]*)>>%$1.tex_format_ref($1)%gsex;  # index entry
4237
    $x =~ s%<<ixx:\s*(\S[^>]*)>>%tex_format_ref($1)%gsex;    # hidden index entry
4238
    $x =~ s%<<ref:\s*([^:]+): (.*?)>>%$2%gs;                 # *** should do proper ref
4239
    $x =~ s%([a-z])-se(?![a-z0-9])%$1\\hifen se%gi;          # Portuguese ortography "faz-se"
4240
 
4241
    $x =~ s|\[(\w.*?[\w.])\]|tex_biblio($1)|gsex;  # biblio refs
4242
 
4243
    #warn "BEFORE($x)" if $x =~ /sensor/;
4244
    #$x =~ s|(\\[a-z]+)\{(.*?)\}|$1^^^^$2````|g;
4245
 
4246
    # Escape "TeXish" programming language hash and array constructs
4247
    #       foo{bar},  -->  foo\{bar\}
4248
    #       1        12   2  3       3  4          4
4249
    $x =~ s%(\A|\s|\()(\w+)\{([^\}]*?)\}([:,.!?\)]*)(?=\s|\Z)%$1$2\\\{$3\\\}$4%gs;
4250
    $x =~ s%(\A|\s|\()(\w+)\[([^\]]*?)\]([:,.!?\)]*)(?=\s|\Z)%$1$2\\\[$3\\\]$4%gs;
4251
 
4252
    if ($fn_style) {
4253
	$x =~ s%<<footnote:\s*(.*?)\s*>>%\\footnote{$1}%gs;
4254
    } else {
4255
	$x =~ s%<<footnote:\s*(.*?)\s*>>%%gs;
4256
    }
4257
    $x =~ s%<<feedbackopts:.*?>>%%gs;
4258
    $x =~ s%<<addfeedbacktop:.*?>>%%gs;
4259
    $x =~ s%<<addfeedbackbot:.*?>>%%gs;
4260
    $x =~ s%<<infobox:(\w+):([^:]*):([^:]*):\s*(.*?)\s*>>%tex_format_infobox($1,$2,$3,$4)%gse;
4261
    $x =~ s%<<label:\s*(.*?)\s*>>%\\label{$1}%gs;
4262
    $x =~ s%<<link:(.*?)(:\s+(.*?))?\s*>>%defined($3)?$3:$1%gsex;
4263
    $x =~ s%<<(\S*?)(\.((gif)|(jpe?g)|(svg)|(png)|(e?ps)))>>%
4264
    	\\begin{figure}[$tex_flt_place]$includegraphics\{$1\}\\end{figure}%gs;
4265
    $x =~ s%(</?[a-z][^>]*?/?>)%tex_esc_tt_tag('texttt', $1)%gsexi;  # XML or HTML <tag> or element
4266
    $x =~ s%((?<!\S)\@[a-z0-9-]+)%tex_esc_tt_tag('texttt', $1)%gsexi;  # XML or HTML @attribute
4267
    # \\ means line break but just by passing it thru LaTeX will do the right thing
4268
    $x =~ s|\^\^\^\^\^\^\^\^RAWTEX: (.*?)~~~~~~~~|unhexit($1)|gse;
4269
    $x =~ s|\^\^\^\^\^\^\^\^RAWDBX: (.*?)~~~~~~~~||gse;
4270
    $x =~ s|\^\^\^\^\^\^\^\^RAWRTF: (.*?)~~~~~~~~||gse;
4271
    $x =~ s|\^\^\^\^\^\^\^\^RAWHTML: (.*?)~~~~~~~~||gse;
4272
 
4273
    $x =~ s|([¹²³¼½¾©®±÷×°])|\$$1\$|g;   # Render Latin1 special chars in math mode
4274
 
4275
    # Late undo escaping on some special characters
4276
    $x =~ s|\^\^\^\^|{|g;
4277
    $x =~ s|````|}|g;
4278
    $x =~ s|::::|<|g;
4279
    $x =~ s|;;;;|>|g;
4280
    $x =~ s|~~~~|[|g;
4281
    $x =~ s|\$\$\$\$|]|g;
4282
    $x =~ s|''''|.|g;
4283
    $x =~ s|""""|/|g;
4284
    #       vvvvvvv------ negative lookbehind for backslash
4285
    $x =~ s/(?<!\\)([\#\%\&])/\\$1/g;  # \$ \{ \} \_ are needed for math. Be sure not to double esc.
4286
    $x =~ s/(?<!\\)_/\\_/g if $x !~ /\$/;
4287
    $x =~ s/(?<!\\)\^/\\^\{\}/g if $x !~ /\$/;
4288
    $x =~ s/!\\/\$\\backslash\$/g;  # special escape for backslash itself: !\
4289
    $x =~ s/!underscore/_/g;  # special escape to support preservation of _ in <<see: la_bel>>
4290
    $x =~ s/!star/*/g;  # special escape to support preservation of *
4291
 
4292
    # Index designated words (this gets pretty inefficient when there are hundreds of words)
4293
    #warn "Start indexing";
4294
    my $w;
4295
    for $w (@ix) {
4296
	#warn "  Index [$w]";
4297
	# Regexs gets recompiled every single time. Tough.
4298
	if (1) {
4299
	    $x =~ s/\\((emph)|(texttt)|(textbf))\{$w\}/\\$1\{$w\}\\index\{$ix{$w}\}/g;
4300
	    $x =~ s/(\A|\s|\()$w([,.!?\)]?)(?=\s|\Z)/$1$w\\index\{$ix{$w}\}$2/g;
4301
	} else {
4302
	    $x =~ s/\\((emph)|(texttt)|(textbf))\{$w\}/"\\$1\{$w\}".debug_ix($w)/ge;
4303
	    $x =~ s/(\A|\s|\()$w([,.!?\)]?)(?=\s|\Z)/$1.$w.debug_ix($w).$2/ge;
4304
	}
4305
    }
4306
    #warn "End indexing";
4307
    return $x;
4308
}
4309
 
4310
sub debug_ix {
4311
    my ($w) = @_;
4312
    my $r = "\\index\{$ix{$w}\}";
4313
    warn "word($w) ix($r)";
4314
    return $r;
4315
}
4316
 
4317
sub tex_para {
4318
    return &tex_format . "\n\n";
4319
}
4320
 
4321
sub para {
4322
    print DBX   &dbx_para  . "\n";
4323
    print NONL  &nonl_para  . "\n\n";
4324
    print PDSEAL &pdseal_para  . "\n\n";
4325
    print RTF   &rtf_para  . "\n\n";
4326
    print HTML  &html_para . "\n\n";
4327
    print HTML2 &html_para . "\n\n";
4328
    print TEX   &tex_para;
4329
    $para_started = 0;
4330
    return ();
4331
}
4332
 
4333
# sub format {
4334
#     if (!$para_started) {
4335
# 	print DBX   "<para>";
4336
# 	print HTML  "<p>";
4337
# 	print HTML2 "<p>";
4338
#     }
4339
#     $para_started = 1;
4340
#     print DBX   &dbx_format  . "\n\n";
4341
#     print HTML  &html_format . "\n\n";
4342
#     print HTML2 &html_format . "\n\n";
4343
#     print TEX   &tex_format;
4344
# }
4345
 
4346
###
4347
### Image handling
4348
###
4349
 
4350
sub filenewer {
4351
    my ($a, $b) = @_;
4352
    my $a_m = (stat $a)[9] + 0;
4353
    my $b_m = (stat $b)[9] + 0;
4354
    #warn "filenewer a($a)=$a_m b($b)=$b_m";
4355
    return $a_m > $b_m;
4356
}
4357
 
4358
sub fix_dia_eps_export {
4359
    my ($path) = @_;
4360
    my $x = readall("$path.eps");
4361
    # Add to this table any other translations you need (open *-utf-8.eps file w/emacs)
4362
    $x =~ s/í/í/g;    # iacute
4363
    $x =~ s/ó/ó/g;    # oacute
4364
    $x =~ s/ú/ú/g;    # uacute
4365
    $x =~ s/ç/ç/g;    # ccedil
4366
    $x =~ s/ã/ã/g;    # atilde
4367
 
4368
    #$x =~ s%/Courier-BoldOblique-latin1\n\s+/Courier-BoldOblique findfont\n.*?\ndefinefont pop\n%%gs;
4369
    writeall("$path.eps", $x);
4370
}
4371
 
4372
sub extract_dia_layers {
4373
    my ($path,$layers) = @_;
4374
    my $epspath = $path.'-'.$layers;
4375
    if (!-r "$path.dia") {
4376
	warn "x-x-x-DIA file($path.dia) missing. No conversion possible for($epspath)\n";
4377
	return $epspath;
4378
    }
4379
 
4380
    if ((($imggen eq 'force')
4381
	 || filenewer("$path.dia", "tex/$epspath.eps") && filenewer("$path.dia", "tex/$epspath.pdf"))) {
4382
	warn "-----Automatic conversion of DIA $path.dia to EPS $epspath.eps\n";
4383
	unless ($dryrun) {
4384
	    system('dia', '-t', 'eps-builtin', '-e', "tex/$epspath.eps", '-L', $layers, "$path.dia");
4385
	    fix_dia_eps_export("tex/$epspath");
4386
	}
4387
    }
4388
    return $epspath;
4389
}
4390
 
4391
sub system_cmd {
4392
    if (1 || $trace) {
4393
	my ($pkg, $file, $line) = caller;
4394
	my $cmd = join ' ', @_;
4395
	print STDERR "$file:$line: SYSTEM($cmd)\n";
4396
    }
4397
    return system @_ unless $dryrun;
4398
}
4399
 
4400
$gs_antialias = '-DDOINTERPOLATE -dTextAlphaBits=4 -dGraphicsAlphaBits=4';
4401
 
4402
sub epstopng {
4403
    my ($eps, $png) = @_;
4404
    my $f = readall($eps);
4405
    my ($x, $y, $m, $n) = $f =~ m{%%BoundingBox:\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)};
4406
    $m -= $x;
4407
    $n -= $y;
4408
    # -r144x144
4409
    # Effect correct page size and translation. Especially latter is tricky: the -c flag
4410
    # causes some PostScript code to be evaluated before the eps file so origin is shifted.
4411
    $cmd = "gs -q -dSAFER -dNOPAUSE -dBATCH -sDEVICE=png256 $gs_antialias -g${m}x${n} -sOutputFile=$png -c $x neg $y neg translate -- $eps >/dev/null 2>&1";
4412
    system_cmd($cmd);
4413
}
4414
 
4415
sub gen_img {
4416
    my ($path, $hint) = @_;
4417
    #warn "GEN($path) pwd(" . `pwd` . ") imggen($imggen)";
4418
    if (-r "$path.pdf"
4419
	&& (($imggen eq 'force')
4420
	    || filenewer("$path.pdf", "tex/$path.pdf"))) {
4421
	writeall("tex/$path.pdf", readall("$path.pdf"));
4422
	#warn "wrote(tex/$path.pdf)";
4423
	return;
4424
    }
4425
    return if !$imggen;  # -nogen
4426
    if ($imggen eq 'safe') {
4427
	return if -r "$path.pdf";
4428
    }
4429
 
4430
    if (-r "$path.dot"
4431
	     && (($imggen eq 'force')
4432
		 || filenewer("$path.dot", "tex/$path.eps") && filenewer("$path.dot", "tex/$path.pdf"))) {
4433
	# apt-get install graphviz
4434
	warn "-----Automatic conversion of DOT $path.dot to PS\n";
4435
	system_cmd('dot', '-Tps2', "$path.dot", '-o', "tex/$path.eps");
4436
    } elsif (-r "$path.gp"
4437
	     && (($imggen eq 'force')
4438
		 || filenewer("$path.gp", "tex/$path.eps") && filenewer("$path.gp", "tex/$path.pdf"))) {
4439
	warn "-----Automatic conversion of GNUPLOT $path.gp to EPS\n";
4440
	# N.B. gnuplot file itself must be set up to produce EPS output
4441
	system_cmd("cd tex && gnuplot ../$path.gp");
4442
    } elsif (-r "$path.gnuplot"
4443
	     && (($imggen eq 'force')
4444
		 || filenewer("$path.gnuplot", "tex/$path.eps") && filenewer("$path.gnuplot", "tex/$path.pdf"))) {
4445
	warn "-----Automatic conversion of GNUPLOT $path.gnuplot to EPS\n";
4446
	# N.B. gnuplot file itself must be set up to produce EPS output
4447
	system_cmd("cd tex && gnuplot ../$path.gnuplot");
4448
    } elsif (-r "$path.dia"
4449
	     && (($imggen eq 'force')
4450
		 || filenewer("$path.dia", "tex/$path.eps") && filenewer("$path.dia", "tex/$path.pdf"))) {
4451
	warn "-----Automatic conversion of DIA $path.dia to EPS\n";
4452
	unless ($dryrun) {
4453
	    system_cmd('dia', '-t', 'eps-builtin', '-e', "tex/$path.eps", "$path.dia");
4454
	    fix_dia_eps_export("tex/$path");
4455
	}
4456
    } elsif (-r "$path.png"
4457
	     && (($imggen eq 'force')
4458
		 || filenewer("$path.png", "tex/$path.eps") && filenewer("$path.png", "tex/$path.pdf") && filenewer("$path.png", "tex/$path.ppm"))) {
4459
	warn "-----Automatic conversion of IMAGE $path.png to PPM\n";
4460
	#system("cp $path.png tex/$path.png");   # fjon wants direct copy!
4461
	system_cmd("pngtopnm $path.png >tex/$path.ppm");
4462
	system_cmd("cp $path.png ${htmldir}i-$path.png");
4463
    } elsif (-r "$path.jpg"
4464
	     && (($imggen eq 'force')
4465
		 || filenewer("$path.jpg", "tex/$path.eps")
4466
		    && filenewer("$path.jpg", "tex/$path.pdf")
4467
		    && filenewer("$path.jpg", "tex/$path.ppm"))) {
4468
	warn "-----Automatic conversion of IMAGE $path.jpg to EPS\n";
4469
	#system("cp $path.jpg tex/$path.jpg");      # fjon wants direct copy!
4470
	#system("cp $path.jpg ${htmldir}i-$path.jpg");   # fjon wants direct copy!
4471
	system_cmd("djpeg -pnm $path.jpg >tex/$path.ppm");
4472
    } elsif (-r "$path.gif"
4473
	     && (($imggen eq 'force')
4474
		 || filenewer("$path.gif", "tex/$path.eps") && filenewer("$path.gif", "tex/$path.pdf") && filenewer("$path.gif", "tex/$path.ppm"))) {
4475
	warn "-----Automatic conversion of IMAGE $path.gif to EPS\n";
4476
	#system("giftopnm -pnm $path.gif >$path.ppm") unless $dryrun;
4477
	system_cmd("gif2ps $path.gif >tex/$path.ps");
4478
    }
4479
 
4480
    if (-r "$path.ppm"
4481
	&& (($imggen eq 'force')
4482
	    || filenewer("$path.ppm", "tex/$path.eps") && filenewer("$path.ppm", "tex/$path.pdf"))) {
4483
	warn "-----Automatic conversion of IMAGE $path.ppm to EPS\n";
4484
	system_cmd("pnmtops -noturn $path.ppm >tex/$path.eps"); # output $path.eps
4485
    }
4486
    if (-r "tex/$path.ppm"
4487
	&& (($imggen eq 'force')
4488
	    || filenewer("tex/$path.ppm", "tex/$path.eps")
4489
	    && filenewer("tex/$path.ppm", "tex/$path.pdf"))) {
4490
	warn "-----Automatic conversion of IMAGE $path.ppm to EPS\n";
4491
	system_cmd("pnmtops -noturn tex/$path.ppm >tex/$path.eps");  # output $path.eps
4492
    }
4493
 
4494
    if (-r "$path.eps"
4495
	&& (($imggen eq 'force')
4496
	    || filenewer("$path.eps", "tex/$path.pdf"))) {
4497
	warn "+++++Automatic conversion of EPS $path.eps to PDF\n";
4498
	my $x = readall("$path.eps");
4499
	if ($x !~ /^%%BoundingBox: /m && !$dryrun) {
4500
	    warn "++++++++Missing BoundingBox in EPS $path.eps. Running gs to determine it.\n";
4501
	    system_cmd "gs -q -dSAFER -dNOPAUSE -dBATCH -sDEVICE=bbox $path.eps >/dev/null 2>bbox";
4502
	    my $bbox = readall('bbox');
4503
	    if ($bbox =~ /^%%BoundingBox: /m) {
4504
		rename "$path.eps" => "$path-nobbox.eps";
4505
		$x =~ s/^(%%EndComments)/$bbox$1/m;
4506
		writeall("$path.eps", $x);
4507
	    } else {
4508
		warn "Determination of BoundingBox failed: $bbox";
4509
	    }
4510
	}
4511
	# apt-get install texlive-font-utils
4512
	system_cmd("cd tex && epstopdf ../$path.eps");
4513
	#if(!$dryrun){                            # fjon
4514
	#    system("epstopdf $path.eps");
4515
	#    system("mv $path.pdf tex/");
4516
	#}
4517
 
4518
	warn "-----Automatic conversion of EPS $path.eps to PNG\n";
4519
	# *** FJ 070613 - Image should always be copied if mod'd, no need to check if image exist
4520
	#system("convert -density 100x100 $path.eps ${htmldir}i-$path.png") unless $dryrun;
4521
	if (-r "${htmldir}i-$path.png") {
4522
	    warn "++ Image already copied ++\n";
4523
	} else {
4524
	    #system("convert -density 70x70 $path.eps ${htmldir}i-$path.png") unless $dryrun; # fjon
4525
	    epstopng("$path.eps", "${htmldir}i-$path.png") unless $dryrun;
4526
	}
4527
	return;
4528
    } elsif (-r "$path.ps"
4529
	&& (($imggen eq 'force')
4530
	    || filenewer("$path.ps", "tex/$path.pdf"))) {
4531
	warn "+++++Automatic conversion of PS $path.ps to PDF\n";
4532
	#system('ps2pdf', "$path.ps", "tex/i-$path.pdf") unless $dryrun;  # fjon
4533
	system_cmd('ps2pdf', "$path.ps", "tex/$path.pdf");
4534
	warn "-----Automatic conversion of PS $path.ps to PNG\n";
4535
	if (-r "${htmldir}i-$path.png") {
4536
		warn "++ Image already copied ++\n";
4537
	} else {
4538
		epstopng("$path.ps", "${htmldir}i-$path.png") unless $dryrun;
4539
	}
4540
	return;
4541
    }
4542
 
4543
    if (-r "tex/$path.eps"
4544
	&& (($imggen eq 'force')
4545
	    || filenewer("tex/$path.eps", "tex/$path.pdf"))) {
4546
	warn "+++++Automatic conversion of EPS tex/$path.eps to PDF\n";
4547
	my $x = readall("tex/$path.eps");
4548
	if ($x !~ /^%%BoundingBox: /m && !$dryrun) {
4549
	    warn "++++++++Missing BoundingBox in EPS $path.eps. Running gs to determine it.\n";
4550
	    system_cmd "gs -q -dSAFER -dNOPAUSE -dBATCH -sDEVICE=bbox $path.eps >/dev/null 2>bbox";
4551
	    my $bbox = readall('bbox');
4552
	    if ($bbox =~ /^%%BoundingBox: /m) {
4553
		rename "$path.eps" => "$path-nobbox.eps";
4554
		$x =~ s/^(%%EndComments)/$bbox$1/m;
4555
		writeall("tex/$path.eps", $x);
4556
	    } else {
4557
		warn "Determination of BoundingBox failed: $bbox";
4558
	    }
4559
	}
4560
	system_cmd("cd tex && epstopdf $path.eps");
4561
	warn "-----Automatic conversion of EPS tex/$path.eps to PNG\n";
4562
	if (-r "${htmldir}i-$path.png") {
4563
		warn "++ Image already copied ++\n";
4564
	} else {
4565
		epstopng("tex/$path.eps", "${htmldir}i-$path.png") unless $dryrun;
4566
	}
4567
	# Old way (has problem in that it rotates landscape graphics)
4568
	#system("cd tex && pstopnm -ppm $path.eps") unless $dryrun;  # invokes gs
4569
	#system("pnmtopng tex/$path.eps001.ppm >${htmldir}i-$path.png") unless $dryrun;
4570
	#unlink "tex/$path.eps001.ppm";  # these are huge so it behooves to rm them quickly
4571
	return;
4572
    } elsif (-r "tex/$path.ps"
4573
	&& (($imggen eq 'force')
4574
	    || filenewer("tex/$path.ps", "tex/$path.pdf"))) {
4575
	warn "+++++Automatic conversion of PS tex/$path.ps to PDF\n";
4576
	system_cmd('ps2pdf', "tex/$path.ps", "tex/$path.pdf");
4577
	warn "-----Automatic conversion of PS $path.ps to PNG\n";
4578
	if (-r "${htmldir}i-$path.png") {
4579
		warn "++ Image already copied ++\n";
4580
	} else {
4581
		epstopng("tex/$path.ps", "${htmldir}i-$path.png") unless $dryrun;
4582
	}
4583
	return;
4584
    }
4585
    warn "*****Missing image `tex/$path.pdf' or conversion to pdf failed ($hint) pd[$i]: $pd[$i]"
4586
	unless -r "tex/$path.pdf";
4587
}
4588
 
4589
 
4590
sub massage_image {
4591
    my ($path, $layers, $hint) = @_;
4592
    if ($layers) {
4593
       $path = extract_dia_layers($path, $layers);
4594
    }
4595
    gen_img($path, $hint);
4596
    if ((!-r "tex/$path.pdf")
4597
	&& (!-r "tex/$path.jpg") && (!-r "tex/$path.png")  # fjon
4598
	) {
4599
       warn "*****Missing image tex/$path.pdf";
4600
       $path = "MISSING GRAPHIC ($path)";
4601
    }
4602
    return $path;
4603
}
4604
 
4605
%tex_img_sizes = (
4606
  n  => 'keepaspectratio,', # "natural"
4607
  'dbx90' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,',
4608
  'dbx80' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,',
4609
  'dbx70' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,',
4610
  'dbx60' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,',
4611
  'dbx50' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,',
4612
  'dbx40' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,',
4613
  'dbx30' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,',
4614
  'dbx20' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,',
4615
  'dbx10' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,',
4616
  1  => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,',
4617
  15 => 'width=0.67\\textwidth,height=0.67\\textheight,keepaspectratio,',
4618
  2  => 'width=0.5\\textwidth,height=0.5\\textheight,keepaspectratio,',
4619
  3  => 'width=0.33\\textwidth,height=0.33\\textheight,keepaspectratio,',
4620
  4  => 'width=0.25\\textwidth,height=0.25\\textheight,keepaspectratio,',
4621
  8  => 'width=0.125\\textwidth,height=0.125\\textheight,keepaspectratio,',
4622
  10 => 'width=1.0\\textwidth,height=0.1\\textheight,keepaspectratio,',
4623
  20 => 'width=1.0\\textwidth,height=0.2\\textheight,keepaspectratio,',
4624
  30 => 'width=1.0\\textwidth,height=0.3\\textheight,keepaspectratio,',
4625
  40 => 'width=1.0\\textwidth,height=0.4\\textheight,keepaspectratio,',
4626
  50 => 'width=1.0\\textwidth,height=0.5\\textheight,keepaspectratio,',
4627
  60 => 'width=1.0\\textwidth,height=0.6\\textheight,keepaspectratio,',
4628
  70 => 'width=1.0\\textwidth,height=0.7\\textheight,keepaspectratio,',
4629
  75 => 'width=0.75\\textwidth,height=0.75\\textheight,keepaspectratio,',
4630
  80 => 'width=0.8\\textwidth,height=0.8\\textheight,keepaspectratio,',
4631
  85 => 'width=0.85\\textwidth,height=0.85\\textheight,keepaspectratio,',
4632
  90 => 'width=0.90\\textwidth,height=0.9\\textheight,keepaspectratio,',
4633
  95 => 'width=0.95\\textwidth,height=0.95\\textheight,keepaspectratio,',
4634
  120 => 'width=1.2\\textwidth,height=1.0\\textheight,keepaspectratio,',
4635
  130 => 'width=1.3\\textwidth,height=1.1\\textheight,keepaspectratio,',
4636
  140 => 'width=1.4\\textwidth,height=1.2\\textheight,keepaspectratio,',
4637
  150 => 'width=1.5\\textwidth,height=1.3\\textheight,keepaspectratio,',
4638
  );
4639
 
4640
%dbx_img_sizes = (
4641
  n  => '', # "natural"
4642
  'dbx90' => 'scale="90"',  #  scalefit="1"
4643
  'dbx80' => 'scale="80"',
4644
  'dbx70' => 'scale="70"',
4645
  'dbx60' => 'scale="60"',
4646
  'dbx50' => 'scale="50"',
4647
  'dbx40' => 'scale="40"',
4648
  'dbx30' => 'scale="30"',
4649
  'dbx20' => 'scale="20"',
4650
  'dbx10' => 'scale="10"',
4651
  1  => 'scale="100"',
4652
  15 => 'scale="67"',
4653
  2  => 'scale="50"',
4654
  3  => 'scale="33"',
4655
  4  => 'scale="25"',
4656
  8  => 'scale="12.5"',
4657
  10 => 'scale="10"',
4658
  20 => 'scale="20"',
4659
  30 => 'scale="30"',
4660
  40 => 'scale="40"',
4661
  50 => 'scale="50"',
4662
  60 => 'scale="60"',
4663
  70 => 'scale="70"',
4664
  75 => 'scale="75"',
4665
  80 => 'scale="80"',
4666
  85 => 'scale="85"',
4667
  90 => 'scale="90"',
4668
  95 => 'scale="95"',
4669
  );
4670
 
4671
%tex_units = (
4672
	      tw => '\\textwidth',
4673
	      th => '\\textheight',
4674
	      );
4675
 
4676
sub tex_graphics {
4677
    my ($siz, $path) = @_;
4678
    return $path if $path =~ /^MISS/;
4679
    return qq(\\includegraphics[$siz]{$path});
4680
}
4681
 
4682
sub tex_caption {
4683
    my ($caption) = @_;
4684
    return '' if !$caption;
4685
    my $tex_caption = tex_format($caption);
4686
    return "\\caption{\\small $tex_caption}";
4687
}
4688
 
4689
sub image {
4690
    my ($path, $caption, $pos, $siz, $trim, $layers) = @_;
4691
    $path = massage_image($path, $layers, 'image');
4692
 
4693
    my $star = '';
4694
    my ($w, $w_unit, $h, $h_unit, $k, $label, $tex_graphics, $tex_caption, $dbx_siz);
4695
    $pos ||= $tex_flt_place;
4696
    if ($pos =~ s/\*//) {
4697
	#warn "POS HAS A STAR pos($pos)";
4698
	$star = '*';
4699
    }
4700
    $siz = 1 if !$siz;
4701
    warn "SIZ($siz)";
4702
    #                                                    1width.d 2Unit X3height.d4Unit 5stretch
4703
    if (($w, $w_unit, $h, $h_unit, $stretch) = $siz =~ /^([0-9.]*)([^0-9.X]*?)X([0-9.]*)(\w*?)(S?)$/) {
4704
	$siz = '';
4705
	if ($w) {
4706
	    $w_unit = $tex_units{$w_unit} if $tex_units{$w_unit};
4707
	    $siz .= "width=$w$w_unit,";
4708
	}
4709
	if ($h) {
4710
	    $h_unit = $tex_units{$h_unit} if $tex_units{$h_unit};
4711
	    $siz .= "height=$h$h_unit,";
4712
	}
4713
	$siz .= 'keepaspectratio,' unless $stretch;
4714
	chop $siz;
4715
	warn "SIZ($siz)";
4716
    } else {
4717
	$dbx_siz = $dbx_img_sizes{$siz};
4718
	$siz = $tex_img_sizes{$siz};
4719
	warn "Bad size spec `$siz' in `<<img: $path\[...\]: $caption>>'" unless $siz;
4720
    }
4721
    $siz ||= $tex_img_sizes{1};
4722
    if ($trim) {
4723
	#warn "TRIM TRIM TRIM [$trim]";
4724
	my ($trim_left, $trim_bot, $trim_right, $trim_top) =
4725
	    $trim =~ /L(-?\d+)B(-?\d+)R(-?\d+)T(-?\d+)/;
4726
	$siz .= "trim=$trim_left $trim_bot $trim_right $trim_top,";
4727
    }
4728
    #chop $siz;
4729
    $siz .= 'clip';
4730
    $label = fold_label($path);
4731
    $tex_graphics = tex_graphics($siz, $path);
4732
 
4733
    if(-e "${htmldir}i-$path.jpg"){       # fjon
4734
       $filename = "i-$path.jpg";
4735
    } else {
4736
       $filename = "i-$path.png";
4737
    }
4738
 
4739
    ++$n_images;
4740
    ++$cap_n_images;
4741
    print TEX "\\message{===FIG $label}";
4742
    if ($caption) {
4743
	my $dbx_caption = dbx_format($caption);
4744
	++$img_no;
4745
	$refname = "fig:$label";
4746
	$reflist{$refname} = $img_no;
4747
	$refhtmlpage{$refname} = $html2;
4748
 
4749
	print NONL "Figure $img_no: $caption\n";
4750
	print PDSEAL "Figure $img_no: $caption\n";
4751
	print DBX <<DBX;
4752
<figure id="$label" label="$img_no">
4753
  <title>$dbx_caption</title>
4754
  <mediaobject>
4755
    <imageobject><imagedata fileref="$path.eps" $dbx_siz/></imageobject>
4756
  </mediaobject>
4757
</figure>
4758
DBX
4759
;
4760
	my $html_caption = html_format($caption);
4761
	print HTML qq(<p><a id="$label"><img src="$filename"></a><br>Fig-$img_no: $html_caption</p>);
4762
	print HTML2 qq(<p><a id="$label"><img src="$filename"></a><br>Fig-$img_no: $html_caption</p>);
4763
	$tex_caption = tex_caption($caption);
4764
	if ($pos =~ /^W(\d+)/) {
4765
	    print TEX qq(\\begin{floatingfigure}{${1}cm}$tex_graphics$tex_caption\\vspace{3mm}\\label{fig:$label}\\end{floatingfigure});
4766
	} else {
4767
	    print TEX qq(\\begin{figure$star}[$pos]\\centering$tex_graphics$tex_caption\\label{fig:$label}\\end{figure$star});
4768
	}
4769
    } else {
4770
	print DBX qq(<mediaobject><imageobject><imagedata fileref="$path.eps" $dbx_siz/></imageobject></mediaobject>);
4771
	print HTML qq(<p><a id="$label"><img src="$filename"></a></p>);
4772
	print HTML2 qq(<p><a id="$label"><img src="$filename"></a></p>);
4773
	if ($pos =~ /^W(\d+)/) {
4774
	    print TEX qq(\\begin{floatingfigure}{${1}cm}$tex_graphics\\end{floatingfigure});
4775
	} elsif ($pos eq 'R') {
4776
	    print TEX qq($tex_graphics\n);
4777
	} else {
4778
	    print TEX qq(\\begin{figure$star}[$pos]\\centering$tex_graphics \\end{figure$star}\n);
4779
	}
4780
    }
4781
    ++$sec_float_obj;
4782
}
4783
 
4784
$doubleimage_half_siz = 'width=0.5\textwidth,height=0.5\textheight,keepaspectratio';
4785
 
4786
#  <<doubleimg: ref-tag,posspec: Text for legend
4787
#  image-file1: Sublegend for image 1 (will be labelled a)
4788
#  image-file2: Sublegend for image 2 (will be labelled b)
4789
#  >>
4790
 
4791
sub doubleimage {
4792
    my ($label,	$caption, $pos,             # ref-tag,posspec: Text for legend
4793
	$path1, $layers1, $legend1,         # image-file1: Sublegend for image 1
4794
	$path2, $layers2, $legend2) = @_;   # image-file2: Sublegend for image 2
4795
    #warn "pos1($pos)";
4796
    $path1 = massage_image($path1, $layers1, 'doubleimage 1');
4797
    $path2 = massage_image($path2, $layers2, 'doubleimage 2');
4798
 
4799
    my ($w, $w_unit, $h, $h_unit, $k, $tex_graphics, $tex_caption);
4800
    $pos ||= $tex_flt_place;
4801
    $label = fold_label($label);
4802
    my $tex_graphics1 = tex_graphics($doubleimage_half_siz, $path1);
4803
    my $tex_graphics2 = tex_graphics($doubleimage_half_siz, $path2);
4804
 
4805
    my $dbx_caption = dbx_format($caption);
4806
    ++$n_images;
4807
    ++$cap_n_images;
4808
    ++$img_no;
4809
    $refname = "fig:$label";
4810
    $reflist{$refname} = $img_no;
4811
    $refhtmlpage{$refname} = $html2;
4812
    print TEX "\\message{===DBLFIG $label}";
4813
    print DBX <<DBX;
4814
<figure id="$label" label="$img_no">
4815
  <title>$dbx_caption</title>
4816
  <mediaobject>
4817
    <imageobject><imagedata fileref="i-$path1.png"/></imageobject>
4818
    <imageobject><imagedata fileref="i-$path2.png"/></imageobject>
4819
  </mediaobject>
4820
</figure>
4821
DBX
4822
;
4823
    my $html_caption = html_format($caption);
4824
    my $html_dual_fig = <<HTML;
4825
<table border=0>
4826
<tr><td><img src="i-$path1.png"><br>(a) $legend1</td>
4827
    <td><img src="i-$path2.png"><br>(b) $legend2</td></tr>
4828
<tr><td colspan=2><a id="$label">Fig-$img_no</a>: $html_caption</td></tr>
4829
</table>
4830
HTML
4831
;
4832
    print HTML $html_dual_fig;
4833
    print HTML2 $html_dual_fig;
4834
 
4835
    $tex_caption = tex_caption($caption);
4836
    my $tex_dbl_subfig = qq(\\mbox{\\subfigure[\\small $legend1]{$tex_graphics1}\\quad\\subfigure[\\small $legend2]{$tex_graphics2}});
4837
    if ($pos =~ /^W(\d+)/) {
4838
	print TEX qq(\\begin{floatingfigure}{${1}cm}$tex_dbl_subfig$tex_caption\\vspace{3mm}\\label{fig:$label}\\end{floatingfigure});
4839
    } else {
4840
	print TEX qq(\\begin{figure}[$pos]\\centering$tex_dbl_subfig$tex_caption\\label{fig:$label}\\end{figure});
4841
    }
4842
}
4843
 
4844
###
4845
### Preamble and Output phase
4846
###
4847
 
4848
$cvsid =~ s/\$//g;
4849
$dbx_credit = '';
4850
for $x (@credits) {
4851
    next if $x =~ /^\s*$/;
4852
    $y = dbx_para_raw($x);
4853
    $dbx_credit .= qq(<othercredit><surname>$y</surname></othercredit>\n);
4854
}
4855
 
4856
if ($history_ena eq '1:') {
4857
    $dbx_history = '<revhistory>';
4858
    for ($j=0; $j<$#history; $j+=4) {
4859
	$x = $history[$j+3];
4860
	$dbx_revdesc = dbx_para_raw($x);
4861
	$dbx_revdesc =~ s%^\s+\*%</para><para>%gm;
4862
	$x = $history[$j+2];
4863
	$dbx_auth = dbx_entity_escape($x);  # Lib simplified DocBook forbids markup
4864
	$dbx_history .= <<HISTORY;
4865
<revision>
4866
<revnumber>$history[$j]</revnumber>
4867
<date>$history[$j+1]</date>
4868
<authorinitials>$dbx_auth</authorinitials>
4869
<revdescription>
4870
<para>
4871
$dbx_revdesc
4872
</para>
4873
</revdescription>
4874
</revision>
4875
HISTORY
4876
;
4877
    }
4878
    $dbx_history =~ s%<para>\s*</para>%%g;
4879
    $dbx_history .= '</revhistory>';
4880
} else {
4881
    $dbx_history = '';
4882
}
4883
 
4884
@dbx_authors = split /(?:,?\s+and\s+)|\n/, $author;
4885
for $a (@dbx_authors) {
4886
    $dbx_author .= '<editor><surname>' . dbx_format($a) . "</surname></editor>\n";
4887
}
4888
 
4889
$author_squash = $author;
4890
$author_squash =~ s/ä/a/g;
4891
 
4892
#<?xml-stylesheet type="text/xsl" href="../../src/xsl/_html.xsl"?>
4893
#<affiliation><orgname></orgname></affiliation>
4894
print DBX <<DBX;
4895
$dbxpreamble
4896
<!-- WARNING: Do not edit! This file was generated on $curdate from original
4897
     PlainDoc (.pd) source using pd2tex of Sampo Kellomaki (sampo\@iki.fi).
4898
     All edits to this file will be lost when it is generated next time. -->
4899
<!-- \$Id\$ -->
4900
<!-- Original id: $cvsid -->
4901
<!-- Author: $author_squash -->
4902
<article id="$sec_id[0]" class="specification" status="draft">
4903
 
4904
<articleinfo>
4905
<title>$doctitle</title>
4906
<date>$curdate</date>
4907
<edition role="Version">$version</edition>
4908
<authorgroup>
4909
$dbx_author
4910
$dbx_credit
4911
</authorgroup>
4912
<abstract>
4913
$dbx_abstract
4914
</abstract>
4915
$additionalarticleinfodbx
4916
$dbx_history
4917
</articleinfo>
4918
DBX
4919
    ;
4920
 
4921
### See http://latex2rtf.sourceforge.net/RTF-Spec-1.0.txt
4922
# http://www.boumphrey.com/rtf/rtf_tutorial_2.php
4923
 
4924
# Preamble and font table: f0 = sans serif, f1 = serif, f2 = monospaced
4925
print RTF '{\rtf1 \ansi \deff0
4926
{\fonttbl
4927
{\f0\fRoman Time New Roman;}
4928
{\f1\fswiss Arial;}
4929
{\f2\fmodern Courier New;}
4930
}
4931
{\stylesheet
4932
';
4933
 
4934
for $k (sort keys %rtf_styles) {
4935
print RTF "{\\$k $rtf_styles{$k}}\n";
4936
$rtf_styles{$k} =~ s/\s+[a-z0-9]+;$//si;  # Chop off style name
4937
}
4938
 
4939
print RTF '}
4940
\plain \sa220 \fs24 \widowctrl \hyphauto \qj
4941
 
4942
{\footer \pard\qc\plain\f22 \chpgn \par}
4943
 
4944
';
4945
print RTF "$rtf_tabs\n";
4946
 
4947
#{\fonttbl{\f0\froman\fprq2\fcharset0 Bitstream Vera Serif;}{\f1\froman\fprq2\fcharset0 Bitstream Vera Serif;}{\f2\fswiss\fprq2\fcharset0 Bitstream Vera Sans;}{\f3\fnil\fprq0\fcharset2 StarSymbol{\*\falt Arial Unicode MS};}{\f4\fnil\fprq2\fcharset0 Bitstream Vera Sans;}{\f5\fnil\fprq2\fcharset0 Mincho{\*\falt msmincho};}{\f6\fnil\fprq2\fcharset0 Lucidasans;}{\f7\fnil\fprq0\fcharset0 Lucidasans;}}
4948
 
4949
print RTF '{\stylesheet{\s0\snext0\nowidctlpar{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\cf0\kerning1\hich\af3\langfe2052\dbch\af4\afs24\lang1081\loch\f0\fs24\lang1033 Normal;}
4950
{\s1\sbasedon16\snext17\ilvl0\outlinelevel0\sb240\sa120\keepn\b\hich\af3\dbch\af4\afs32\ab\loch\f2\fs32 Heading 1;}
4951
{\s2\sbasedon16\snext17\ilvl1\outlinelevel1\sb240\sa120\keepn\i\b\hich\af3\dbch\af4\afs28\ai\ab\loch\f2\fs28 Heading 2;}
4952
{\s3\sbasedon16\snext17\ilvl2\outlinelevel2\sb240\sa120\keepn\b\hich\af3\dbch\af4\afs28\ab\loch\f2\fs28 Heading 3;}
4953
{\*\cs15\snext15 Numbering Symbols;}
4954
{\s16\sbasedon0\snext17\sb240\sa120\keepn\hich\af3\dbch\af4\afs28\loch\f2\fs28 Heading;}
4955
{\s17\sbasedon0\snext17\sb0\sa120 Text body;}
4956
{\s18\sbasedon17\snext18\sb0\sa120\dbch\af5 List;}
4957
{\s19\sbasedon0\snext19\sb120\sa120\noline\i\dbch\af5\afs24\ai\fs24 Caption;}
4958
{\s20\sbasedon0\snext20\noline\dbch\af5 Index;}
4959
{\s21\sbasedon16\snext22\qc\sb240\sa120\keepn\b\hich\af3\dbch\af4\afs36\ab\loch\f2\fs36 Title;}
4960
{\s22\sbasedon16\snext17\qc\sb240\sa120\keepn\i\hich\af3\dbch\af4\afs28\ai\loch\f2\fs28 Subtitle;}
4961
}
4962
'  if 0;
4963
 
4964
# Summary, like title
4965
print RTF "\\ftnbj\n{\\info {\\title $doctitle}{\\author $author}}
4966
 
4967
{\\pard $rtf_styles{'s14'} \\s14\n$doctitle\\par}
4968
 
4969
{\\pard $rtf_styles{'s15'} \\s15\n$author\\par}
4970
 
4971
{\\pard $rtf_styles{'s16'} \\s16\n$rtf_abstract\\par}";
4972
 
4973
print NONL "$doctitle\n\n";
4974
print PDSEAL "$doctitle\n\n";
4975
print NONL "$author\n\n" if $author && $author ne 'N.N.';
4976
print PDSEAL "$author\n\n" if $author && $author ne 'N.N.';
4977
if ($nonl_abstract) {
4978
   $nonl_abstract =~ s/\r?\n\r?\n/<<PAR>>/g;
4979
   $nonl_abstract =~ s/\s*\r?\n/ /g;
4980
   $nonl_abstract =~ s/<<PAR>>/\n\n/g;
4981
   print NONL "$nonl_abstract\n\n";
4982
   print PDSEAL "$nonl_abstract\n\n";
4983
}
4984
 
4985
###
4986
 
4987
#warn "doctitle($doctitle)";
4988
#<meta http-equiv="Content-type" content="text/html; charset=utf-8">
4989
 
4990
print HTML $htmlpreamble ? $htmlpreamble : <<HTML unless $nohtmlpreamb;
4991
<title>$doctitle</title>
4992
<link type="text/css" rel="stylesheet" href="$base.css">
4993
<body bgcolor=white>
4994
<H1>$doctitle</H1>
4995
HTML
4996
    ;
4997
 
4998
print HTML2 <<HTML unless $nohtmlpreamb;
4999
<title>$doctitle</title>
5000
<body bgcolor=white>
5001
<link type="text/css" rel="stylesheet" href="$base.css">
5002
<H1>$doctitle</H1>
5003
HTML
5004
    ;
5005
 
5006
if ($author && $author ne 'N.N.') {
5007
    $html_author = html_format($author);
5008
    print HTML "<i>$html_author</i>\n";
5009
    print HTML2 "<i>$html_author</i>\n";
5010
}
5011
 
5012
if ($abstract) {
5013
    print HTML "<blockquote>$html_abstract</blockquote>\n";
5014
    print HTML2 "<blockquote>$html_abstract</blockquote>\n";
5015
}
5016
 
5017
# See also: \overlay{image} for background image, or \background{color}, or \emblema{logoimg}
5018
# in pdfscreen section (sec 4.8, p. 80 of lshort.pdf).
5019
 
5020
#$tex_1st = tex_para($first_page);
5021
#warn "###".$first_page."###\n";
5022
#warn "###".$tex_1st."###\n";
5023
 
5024
if ($makeindex) {
5025
    $tex_index = ($makeindex == 2) ? "\\usepackage{makeidx,showidx}" : "\\usepackage{makeidx}";
5026
    $tex_index .= "\n\\makeindex\n";
5027
}
5028
 
5029
# N.B. Add \\hbadness=10000 to disable 90% of the warnings
5030
 
5031
print TEX <<LATEX;
5032
% Generated on $curdate using pd2tex of Sampo Kellomaki (sampo\@iki.fi)
5033
% Do not edit this file: your changes will be lost next time this is regenerated.
5034
LATEX
5035
    ;
5036
 
5037
# If the $moremoretexpreamble wants to use the enumitem package, then
5038
# the enumerate must get used after that (must be done in $moremoretexpreamble).
5039
# Thus we need to prevent premature use of enumerate here.
5040
$usepackage_enumerate = '\\usepackage{enumerate}'
5041
    unless $moremoretexpreamble =~ /\\usepackage\{enumerate\}/;
5042
 
5043
print TEX $texpreamble ? $texpreamble : <<LATEX;
5044
$tex_doc_class
5045
\\usepackage{floatflt}
5046
\\usepackage{pslatex}
5047
\\usepackage[T1]{fontenc}
5048
\\usepackage[latin1]{inputenc}
5049
$usepackage_enumerate
5050
\\usepackage{amssymb}
5051
\\usepackage{subfigure}
5052
$lineno
5053
\\usepackage{longtable}
5054
\\usepackage[bookmarks=true,bookmarksnumbered=true,pdftex]{hyperref}
5055
\\usepackage{supertabular,lscape}   % fjon
5056
\\usepackage{fancyvrb}              % fjon
5057
$vmargin
5058
$pagestyle
5059
\\usepackage[pdftex]{color,graphicx}
5060
\\pdfpagewidth=\\paperwidth
5061
\\pdfpageheight=\\paperheight
5062
\\hbadness=$hbadness
5063
\\newcommand{\\hifen}{\\discretionary{-}{-}{-}}
5064
$tex_index
5065
\\author{$author}
5066
\\title{$doctitle}
5067
$moretexpreamble
5068
$linespace
5069
$moremoretexpreamble
5070
\\begin{document}
5071
$maketitle
5072
LATEX
5073
    ;
5074
 
5075
print TEX "\\begin{slide}\n" if $class eq 'slide';
5076
 
5077
sec();  # recursively processes the entire document
5078
 
5079
print DBX qq(</article>\n);
5080
print RTF "}";
5081
print TEX "\\end{slide}\n" if $class eq 'slide';
5082
print TEX qq(\\end{document}\n);
5083
close TEX;
5084
close DBX;
5085
close RTF;
5086
 
5087
$amb = $htmlpostamble;
5088
$amb =~ s/!\?!TITLE/$doctitle: $sec_no$x/gs;
5089
$amb =~ s/!\?!BASE/$base/gs;
5090
$amb =~ s/!\?!PREV/$prevprev/gs;
5091
$amb =~ s/!\?!NEXT/$html2/gs;
5092
print HTML $amb;
5093
close HTML;
5094
 
5095
$amb = $htmlpostamble2;
5096
$amb =~ s/!\?!TITLE/$doctitle: $sec_no$x/gs;
5097
$amb =~ s/!\?!BASE/$base/gs;
5098
$amb =~ s/!\?!PREV/$prevprev/gs;
5099
$amb =~ s/!\?!NEXT/$html2/gs;
5100
print HTML2 $amb;
5101
close HTML2;
5102
 
5103
@months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
5104
@weekDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
5105
($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek) = localtime();
5106
$year = 1900 + $yearOffset;
5107
$today = "$months[$month] $dayOfMonth, $year";
5108
# $today = join(' ', @today);
5109
 
5110
if ($html1) {  # ToC for monolith document
5111
    open HTML, ">$htmldir$base-toc1.html" or die "Can't open $htmldir$base-toc1.html for writing: $!";
5112
    warn "Writing $htmldir$base-toc1.html";
5113
    print HTML <<HTML;
5114
<title>$doctitle TOC</title>
5115
<link type="text/css" rel="stylesheet" href="$base.css">
5116
<body bgcolor=white>
5117
<H1>$doctitle</H1>
5118
$today<br><br>
5119
<a href="$base.pdf" target="_top">Download as pdf</a><br>
5120
<a href="index1.html" target="_top">Multi page</a>
5121
<H3>Table of Contents (monolithic)</H3>
5122
HTML
5123
    ;
5124
    for ($i = 0; $i <= $#html_toc_title; ++$i) {
5125
	print HTML qq(<a href="$html1\#$html_toc_link[$i]" target=c>$html_toc_title[$i]</a><br>\n);
5126
    }
5127
    close HTML;
5128
}
5129
 
5130
if ($html2) {  # ToC for multipage document
5131
    open HTML2, ">$htmldir$base-toc.html" or die "Can't open $htmldir$base-toc.html for writing: $!";
5132
    warn "Writing $htmldir$base-toc.html";
5133
    print HTML2 <<HTML2;
5134
<title>$doctitle TOC</title>
5135
<link type="text/css" rel="stylesheet" href="$base.css">
5136
<body bgcolor=white>
5137
<H1>$doctitle</H1>
5138
$today<br><br>
5139
<a href="$base.pdf" target="_top">Download as pdf</a><br>
5140
<a href="index.html" target="_top">Single page</a>
5141
<H3>Table of Contents</H3>
5142
HTML2
5143
    ;
5144
    for ($i = 0; $i <= $#html_toc_title; ++$i) {
5145
	print HTML2 qq(<a href="$html2_toc_link[$i]" target=c>$html_toc_title[$i]</a><br>\n);
5146
    }
5147
    close HTML2;
5148
}
5149
 
5150
###
5151
### Recommended stylesheet (if you do not have one, one will be created for you)
5152
###
5153
 
5154
$css = <<CSS
5155
BODY,H1,H2,H3,H4,H5,H6,P,CENTER,TD,TH,UL,DL,DIV {
5156
       font-family: Geneva, Arial, Helvetica, sans-serif;
5157
}
5158
BODY,TD {
5159
       font-size: 100%;
5160
}
5161
BODY {
5162
       background-color: white;
5163
       color: black;
5164
       margin-right: 20px;
5165
       margin-left: 20px;
5166
}
5167
H1 {
5168
       text-align: left;
5169
       font-size: 160%;
5170
}
5171
H2 { font-size: 120%; }
5172
H3 { font-size: 100%; }
5173
PRE {
5174
       border: 1px solid #CCCCCC;
5175
       background-color: #f5f5f5;
5176
       padding-top: 4px; padding-bottom: 4px; padding-left: 6px; padding-right: 6px;
5177
       margin-top:  4px; margin-bottom:  4px; margin-left:  2px; margin-right:  8px;
5178
}
5179
a {
5180
       color: #1A41A8;
5181
}
5182
a:visited {
5183
       color: #2A3798;
5184
}
5185
HR { height: 1px;
5186
     border: none;
5187
     border-top: 1px solid black;
5188
}
5189
 
5190
TH {
5191
       background-color: #C0C0CA;
5192
       text-align     : left;
5193
       vertical-align : bottom;
5194
       font-weight    : bold;
5195
       padding-top: 2px; padding-bottom: 2px; padding-left: 10px; padding-right: 10px;
5196
       margin-top:  2px; margin-bottom:  2px; margin-left:  0px;  margin-right:  0px;
5197
       border: 1px solid #CCCCCC;
5198
}
5199
TD {
5200
       background-color: #e8eef2;
5201
       padding-top: 2px; padding-bottom: 2px; padding-left: 10px; padding-right: 10px;
5202
       margin-top:  2px; margin-bottom:  2px; margin-left:  0px;  margin-right:  0px;
5203
       border: 1px solid #CCCCCC;
5204
}
5205
TD.eqn {
5206
       background-color: white;
5207
       vertical-align : middle;
5208
       padding-top: 2px; padding-bottom: 2px; padding-left: 10px; padding-right: 10px;
5209
       margin-top:  2px; margin-bottom:  2px; margin-left:  0px;  margin-right:  0px;
5210
       border: 0px solid white;
5211
}
5212
CSS
5213
    ;
5214
 
5215
if(!-f "$htmldir$base.css") {
5216
    open (CSS,">$htmldir$base.css") or die "Can't open $htmldir$base.css for write:$!";
5217
    warn "Writing $htmldir$base.css";
5218
    print CSS $css;
5219
    close CSS;
5220
}
5221
 
5222
###
5223
### Create HTML index and framesets as expected
5224
###
5225
 
5226
if (!-f "${htmldir}index1.html") {
5227
    open(HTML,">${htmldir}index1.html") or die "Can't open(${htmldir}index1.html) for write:$!";
5228
    warn "Writing ${htmldir}index1.html";
5229
    print HTML <<HTML;
5230
<title>$doctitle</title>
5231
<frameset cols="300,*">
5232
<frame name=toc src="$base-toc.html">
5233
<frame name=c src="$base-front-matter.html">
5234
</frameset>
5235
HTML
5236
    ;
5237
    close HTML;
5238
}
5239
 
5240
if (!-f "${htmldir}index.html") {
5241
    open(HTML,">${htmldir}index.html") or die "Can't open(${htmldir}index.html) for write:$!";
5242
    warn "Writing ${htmldir}index.html";
5243
    print HTML "<title>$doctitle</title>\n".
5244
	"<frameset cols=\"300,*\">\n".
5245
	"<frame name=toc src=\"$base-toc1.html\">\n".
5246
	"<frame name=c src=\"$base.html\">".
5247
	"</frameset>\n";
5248
    close HTML;
5249
}
5250
 
5251
if ($pipemode) {
5252
    warn "Waiting for pdflatex process (pid $texpid) to complete.\n";
5253
    waitpid $texpid,0;
5254
    if ($?) {
5255
	warn "### pdflatex error. Exit value=".($? >> 8).", sig=".($? & 0x7f).".\n";
5256
    } else {
5257
	warn "--- pdflatex completed with success.\n";
5258
    }
5259
}
5260
 
5261
warn "Total figures: $n_images\nFigures in last chapter: $cap_n_images\n";
5262
 
5263
exit if $nopdf;
5264
 
5265
### Post processing to generate the pdf document
5266
 
5267
# *** need to check and process picture dependencies here!
5268
 
5269
resolve_file_tex("$texdir$base.tex") unless $notex;
5270
 
5271
chdir $texdir;
5272
unless ($dryrun || $pipemode) {
5273
    warn "pdflatex -file-line-error-style $base.tex";
5274
    system ('pdflatex', '-file-line-error-style', "$base.tex");
5275
    system ("cp $base.pdf ../$htmldir");   # fjon
5276
    ##system ("mv $base.pdf ..");         # fjon
5277
    #system('latex', "../$base.tex");     # fjon
5278
    #system('dvipdf', "$base.dvi", "../$base.pdf");  # fjon
5279
 
5280
    if ($makeindex) {
5281
	# Fix spurious whitespace in formatted index entries generated from table
5282
	$idx = readall("$base.idx");
5283
	$idx =~ s/\@\\((emph)|(texttt)|(textbf))\s+\{/\@\\$1\{/g;
5284
	writeall("$base.idx", $idx);
5285
	system ('makeindex', '-q', "$base.idx");
5286
    }
5287
}
5288
system ('acroread', "$base.pdf") if $acroread;
5289
chdir '..';   # so further post processing will work! (fjon)
5290
 
5291
### Post process: Resolve references in html files
5292
unless ($nohtml || $noref) {
5293
    warn "\nResolving html references\n-------------------------\n";
5294
    resolve_file_html("$htmldir$base.html", 0);
5295
    for (<${htmldir}*.html>) {
5296
	resolve_file_html($_, 1);
5297
    }
5298
}
5299
 
5300
###
5301
### Functions to resolve references (from fjon)
5302
###
5303
 
5304
sub resolve_ref {
5305
    my ($ref, $see_caption, $quiet) = @_;
5306
    my($caption, $found, $page, $key, $value);
5307
 
5308
    $ref = fold_label($ref);
5309
    $page = "";
5310
    if ($reflist{$ref}) {
5311
	$caption = $reflist{$ref};
5312
	$page = $refhtmlpage{$ref};
5313
    } else {
5314
	$found = 0;
5315
	while (($key, $value) = each(%reflist)) {
5316
           if($key =~ "$ref"){
5317
               ++$found;
5318
               if ($found == 1){
5319
                   warn "Note: Not exact reference. '$ref' match '$key'" if !$quiet;
5320
                   $ref = $key;
5321
                   $caption = $value;
5322
                   $page = $refhtmlpage{$ref};
5323
               } else {
5324
                   warn "Error: Ambigous reference. '$ref' also match '$key'" if !$quiet;
5325
               }
5326
           }
5327
       }
5328
 
5329
       if (!$found) {
5330
           warn "Error: Missing reference:$ref" if !$quiet;
5331
           $caption = "?$ref?";
5332
       }
5333
    }
5334
    return ($ref, $see_caption || $caption, $page);
5335
}
5336
 
5337
sub format_ref_html {
5338
    my ($guess, $caption, $quiet) = @_;
5339
    my ($ref, $caption, $page) = resolve_ref($guess, $caption, $quiet);
5340
    if ($quiet) {
5341
       return "<a href=\"$page#$ref\">$caption</a>";
5342
    } else {
5343
       return "<a href=\"#$ref\">$caption</a>";
5344
    }
5345
}
5346
 
5347
sub resolve_file_html {
5348
    my($filename, $quiet) = @_;
5349
 
5350
    open F, $filename or die "Can not read($filename)";
5351
    my($x) = <F>;
5352
    close F;
5353
 
5354
    #Resolve links
5355
    $x =~ s/<see:\?:\s*([^>]+?)(?:=([^>]*))?>/format_ref_html($1, $2, $quiet)/gse;
5356
 
5357
    #Print errors
5358
    if ($quiet) {
5359
       $x =~ s/<error:\s*([^>]+)>//gse;
5360
    } else {
5361
       $x =~ s/<error:\s*([^>]+)>/print "Error: $1\n"/gse;
5362
    }
5363
    writeall($filename, $x);
5364
}
5365
 
5366
# Reference resolution pass. Read in almost ready file and fix references, then write it out!
5367
 
5368
sub format_ref_tex {
5369
    my ($see, $see_caption) = @_;
5370
    my ($ref, $caption) = resolve_ref($see, $caption, 1);
5371
    warn "see($see:$ref:$caption)";
5372
    return "$see_caption\\ref{$ref}";
5373
}
5374
 
5375
sub resolve_file_tex {
5376
    my($filename) = @_;
5377
    my $x = readall($filename);
5378
    $x =~ s/<see:\?:([^>]+?)(?:=([^>]*))?>/format_ref_tex($1,$2)/gse;
5379
    writeall($filename, $x);
5380
}
5381
 
5382
#EOF