| 0,0 → 1,5382 |
|---|
| #!/usr/bin/perl |
| # Copyright (c) 2002-2014 Sampo Kellomaki (sampo@iki.fi). All Rights Reserved. |
| # This is free software. You may distribute under GPL. NO WARRANTY. |
| # |
| # PlainDoc to LaTeX, DocBook, and HTML converter |
| # http://zxid.org/plaindoc/pd.html |
| # |
| # $Id: pd2tex,v 1.55 2009-11-10 23:28:31 sampo Exp $ |
| # xx.xx.1999, created, Sampo Kellomaki <sampo@iki.fi> |
| # 3.2.2002, complete rewrite --Sampo |
| # (snip -- see ChangeLog) |
| # 10.11.2009, patch from Octavio Alvarez <alvarezp.at.alvarezp.com> |
| # 12.1.2010, Improvements to the blogging system and multipage HTML --Sampo |
| # 29.1.2011, Tweaks and minor bug fixes --Sampo |
| # 29.3.2011, Added a <<csv: >> feature --Sampo |
| # 2.2.2012, Render Latin1 special chars using math mode --Sampo |
| # 30.1.2013, Moved .tex and spell.words temp files to tex/ subdirectory --Sampo |
| # 8.2.2013, Fixed RTF support --Sampo |
| # 27.4.2013, .nonl support and added <<multicol*: >> construct --Sampo |
| # 21.2.2014, Added pdseal support --Sampo |
| # |
| # Usage: ./pd2tex foo.pd |
| # |
| # Document contains (document can be considered as a special top level section) |
| # - <<special: constructs>> |
| # - anything that a section can contain |
| # |
| # Sections and subsections can contain |
| # - lower level subsections (identified by underlining) |
| # - anything that body can contain |
| # - direct descendants must be top level lists |
| # |
| # List items are identified by level of indent and can contain |
| # - anything that body can contain |
| # - list can contain only lower level lists (more indent) |
| # - list can never contain sections or subsections. Appearence of a section terminates list |
| # - decrease in level of indent terminates list |
| # - list items can be single line or multiline, with same indent |
| # |
| # Body text can contain |
| # - lists (no list can not span (sub)sections) |
| # - * bulleted lists |
| # - 1. number lists |
| # - a. alpha lists |
| # - definition:: lists (subsequent lines must be indented by 4 chars) |
| # - <<table: Caption text ...>> |
| # - <<img: file.eps: Caption text>> |
| # N.B. The best way to produce diagram drawings is to use dia for drawing |
| # and export as .eps. Then run `epstopdf file.eps'. Only problem with this |
| # method is that there is no control of image size. Thus the eps must already |
| # be the correct size. Apparently the best way to accomplish this is to |
| # use the dia File->Page Setup->Scale option to reduce the image (e.g. 70%). |
| # - code, identified by indent |
| # - para, if nothing special indicates otherwise |
| # - body terminates if |
| # - indent level decreases |
| # - something looking like section is found |
| # |
| # Table contains cells defined by special syntax. Each cell content is treated as a para |
| # |
| # Para can contain |
| # - *bold*, +italic+, ~code~ |
| # - inline <<image.gif>> |
| # - www.foo.com and email@foo.com links (autodetected) |
| # - [references] |
| # - paragraphs are separated by empty lines (and special constructs?) |
| # |
| # Code section starts at given level of indent and continues until less indented |
| # line. Lines in between may be more indented if needed. |
| # |
| # Lists and indent (| = current indent, : = parent's indent; lesser indent terminates construct) |
| # 1.: parent list |
| # :a.|same level |
| # :b.|same level |
| # : |* sublist |
| # : |* sub |
| # :c.|same level (terminates sub) |
| # : |* sub |
| # 2.: next parent item |
| # |
| # Book printing |
| # pd2tex r-slim.pd |
| # pdftops |
| # psbook r-slim.ps r-slim-book.ps # omit -s for best result |
| # mpage -o -2 -j1%2 -P r-slim-book.ps # odd sheets |
| # # HP4100: rotate output by 180 degrees and put in input tray with image up (p. 1) |
| # mpage -o -2 -j2%2 -P r-slim-book.ps # even sheets |
| # # invert order of output, fold, and staple in middle |
| # |
| # http://www.biblioscape.com/rtf15_spec.htm |
| # |
| # Latex tips |
| # ========== |
| # Too deeply nested Apparently this really means what it says. Maybe something not closing? |
| # Float too large Picture or table is too large to fit in available space on page. Ignore. |
| # Overfull \vbox Means that something didn't really fit. May cause misformatting. Ignore. |
| # Missing $ inserted Automatic switch to math mode: char (e.g. under score) only allowed |
| # in math mode was seen and LaTeX "helpfully" switches to math mode. |
| # \usepackage{lineno} \linenumbers: Use 'lineno' as moreopt parameter of <<class: >> |
| # \hspace{\fill} Right align rest of line |
| |
| $usage = <<USAGE; |
| Usage: pd2tex mydoc.pd # Generate mydoc.tex, mydoc.pdf, mydoc.dbx, and mydoc.html |
| pd2tex -acroread mydoc.pd # Regenerate document and preview it |
| pd2tex <mydox.pd >mydoc.tex # filter mode |
| pd2tex -dbx <mydoc.pd >mydoc.dbx # filter mode for DocBook |
| pd2tex -verify <plaintext # Verify PDSEAL |
| |
| Options: |
| -dbx Invokes DocBook filter mode |
| -html Invokes HTML filter mode (must make subdirectory html) |
| -gensafe Convert images from ps, eps, dot, or dia to pdf only if no pdf (default) |
| -gendep Convert from ps, eps, dot, or dia to pdf based on time stamps |
| -genforce Force conversion of images from ps, eps, dot, or dia to pdf |
| -nogen Prevent conversion of images from ps, eps, dot, or dia to pdf |
| -notex Prevent .tex output in normal mode. Also prevents .pdf output. |
| -nopdf Prevent .pdf output in normal mode (.tex is still generated). |
| -nodbx Prevent .dbx output in normal mode |
| -nohtml Prevent .html output in normal mode |
| -nohtml2 Prevent multipage .html output in normal mode |
| -nortf Prevent .rtf output in normal mode (.rtf is only poorly supported) |
| -noref Skip expensive reference resolution pass. |
| -nohtmlpreamb Prevent HTML preamble from being added |
| -nosecnum Prevent automatic section numbering |
| |
| -p Same as -pdfonly |
| -pdfonly Only generate .tex and .pdf output (no .dbx, .html, or .rtf) |
| -htmlonly Only generate .html output (no .tex, .dbx, or .rtf) |
| -html2only Only generate multipage html (no .tex, .dbx, or .rtf) |
| |
| -fn Omit footnotes. |
| -FN Force footnotes even on dbx (some dbx tools are broken wrt footnotes in lists) |
| -n Dry run. Do not alter files on disk. |
| -acroread Automatically launch acroread after processing the document |
| -d DIR Change current working directory to DIR |
| -o path Specify output path different from input |
| -DMACRO=VAL Define a macro to have a value |
| -verify Verify a PDSEAL (e.g. paste text from PDF to stdin) |
| -init Create typical directory hierarchy used by pd2tex (tex, html, tmp, review) |
| USAGE |
| ; |
| |
| ### Configure |
| |
| $trace = 0; |
| $number = 0; # Should sections and lists be explicitly numbered in dbx |
| $tex_col_wid_factor = 1.8; # TeX: tweak the table/column width (mm per equals sign in underline) |
| $dbx_col_wid_factor = 0.08; # DocBook: tweak the table/column width (inches per equals sign) |
| $hbadness = 2000; # Do not warn for hbadness below this. See also tables which set this to 10000. |
| $imggen = 'safe'; |
| $pipemode = 0; |
| $html2_split_threshold = 99; # 99 = Always split |
| $fn_style = 1; # 0 = omit (-fn), 1 = tex ok, dbx inline, 3 = both tex and dbx footnotes (-FN) |
| $maxlogline = 77; |
| $htmldir = 'html/'; |
| $texdir = 'tex/'; |
| $dbxdir = 'tex/'; |
| $rtfdir = 'tex/'; |
| $pdflag{'autoformat'} = 1; # <<pdflags: autoformat=0>> |
| $pdflag{'showsgasxsd'} = 0; # <<pdflags: showsgasxsd=1>> |
| $pdflag{'stripsecnum'} = 1; # <<pdflags: stripsecnum=0>> |
| $pdflag{'secnum'} = 1; # <<pdflags: secnum=0>> |
| |
| ### Process command line options |
| |
| while ($ARGV[0] =~ /^-/) { |
| $f = $ARGV[0]; |
| if ($f eq '-acroread') { shift; $acroread = 1; next; } |
| if ($f eq '-dbx') { shift; $dbx_filter = 1; next; } |
| if ($f eq '-html') { shift; $html_filter = 1; next; } |
| if ($f eq '-gensafe') { shift; $imggen = 'safe'; next; } |
| if ($f eq '-gendep') { shift; $imggen = 'dep'; next; } |
| if ($f eq '-genforce') { shift; $imggen = 'force'; next; } |
| if ($f eq '-pdfonly' || $f eq '-p') { shift; $nodbx=$nortf=$nohtml=$nohtml2=1; next; } |
| if ($f eq '-htmlonly') { shift; $nodbx=$nortf=$notex=$nohtml2=1; next; } |
| if ($f eq '-html2only'){ shift; $nodbx=$nortf=$nohtml=$notex=1; next; } |
| if ($f eq '-nogen') { shift; $imggen = ''; next; } |
| if ($f eq '-notex') { shift; $notex = 1; next; } |
| if ($f eq '-nopdf') { shift; $nopdf = 1; next; } |
| if ($f eq '-nodbx') { shift; $nodbx = 1; next; } |
| if ($f eq '-nohtml') { shift; $nohtml = 1; next; } |
| if ($f eq '-nohtml2') { shift; $nohtml2 = 1; next; } |
| if ($f eq '-nortf') { shift; $nortf = 1; next; } |
| if ($f eq '-noref') { shift; $noref = 1; next; } |
| if ($f eq '-nopipe') { shift; $pipemode = 0; next; } |
| if ($f eq '-pipe') { shift; $pipemode = 1; next; } |
| if ($f eq '-nosecnum') { shift; $pdflag{'secnum'} = 0; next; } |
| if ($f eq '-nohtmlpreamb') { shift; $nohtmlpreamb = 1; next; } |
| if ($f eq '-htmldir') { shift; $htmldir = shift; next; } |
| if ($f eq '-epstopng') { shift; epstopng($ARGV[0], $ARGV[1]); exit; } |
| if ($f eq '-n') { shift; $dryrun = 1; next; } |
| if ($f eq '-fn') { shift; $fn_style = 0; next; } # omit footnotes |
| if ($f eq '-FN') { shift; $fn_style = 3; next; } # force dbx footnotes |
| if ($f eq '-t') { shift; ++$trace; next; } |
| if ($f eq '-d') { shift; chdir shift; next; } |
| if ($f eq '-o') { shift; $base = shift; next; } |
| if ($f =~ /^-D(\w+)(?:=(.*))?$/) { $mac{$1} = $cmdline_mac{$1} = $2; shift; next; } |
| if ($f eq '-init') { |
| #mkdir "corners"; |
| mkdir '.pd'; # Private temp files (like tmp, but newer) |
| mkdir 'tex'; |
| mkdir $htmldir; |
| mkdir 'review'; |
| mkdir 'tmp'; # See also .pd |
| exit; |
| } |
| if ($f eq '-verify') { |
| undef $/; |
| $x = <STDIN>; |
| ($pdseal,$sha1) = $x =~ /(PDSEAL1([A-Za-z0-9_.-]+))/; |
| $x =~ s/PDSEAL1[A-Za-z0-9_.-]+//; |
| die "pdseal($pdseal) is wrong length" if length $pdseal != 7+28; |
| $x = pdseal1($x); |
| die "pdseal($pdseal) mismatch($x) normalized_form($pdseal_norm)" if $pdseal ne $x; |
| warn "OK: pdseal($pdseal) matches.\n"; |
| exit; |
| } |
| die "Unknown argument `$f'\n$usage"; |
| } |
| |
| if (@ARGV) { # Not filter mode: input file name is an argument |
| $file = shift; |
| $base ||= $file; |
| $base =~ s/\.pdf?$//i; |
| $base =~ s/tex\///i; |
| open STDIN,"<$file" or die "Cannot read input file $file: $!"; |
| open NONL,">$texdir$base.nonl"; # output where newlines are stripped to ease importing to Word |
| open PDSEAL,">$texdir$base.seal"; # output in pdseal hashable format |
| if ($notex || $dryrun) { |
| open TEX,">/dev/null"; |
| open BIB,">/dev/null"; |
| $nopdf = 1; |
| } else { |
| unlink "$texdir$base.tex"; # in case stray pipe was left over from previous iteration |
| if ($pipemode) { |
| # Since LaTeX apparently does not support reading input from stdin, we fool |
| # it by creating a named pipe. This allows us to interperse the pd2tex error |
| # output with the messages from LaTeX. |
| if ($enabib) { |
| open BIB,">$texdir$base.bib" or die "Cannot write $texdir$base.bib: $!"; |
| } |
| open TEX,">$texdir$base.tex" or die "Cannot write $texdir$base.tex: $!"; |
| warn "Writing $texdir$base.tex"; |
| if (-d 'tex') { |
| select TEX; $| = 1; select STDOUT; |
| if (!($texpid = fork)) { |
| die "fork (for pdflatex) failed: $!" if !defined($texpid); |
| chdir $texdir; |
| select(undef,undef,undef,0.250); |
| warn "pdflatex -file-line-error-style -interaction=errorstopmode $base.tex"; |
| exec "pdflatex -file-line-error-style -interaction=errorstopmode $base.tex"; |
| die "exec pdflatex failed: $!"; |
| } |
| } else { |
| warn "WARNING: For pdflatex post processing tex subdirectory is needed. Create using pd2tex -init (or mkdir tex)\n"; |
| } |
| #open TEX,"|pdflatex -file-line-error-style -interaction=errorstopmode - >$base.pdf" |
| # or die "Cannot open pipe to pdflatex: $!"; |
| } else { |
| ### This is the normal case when you invoke: pd2text foo.pd |
| if ($enabib) { |
| open BIB,">$texdir$base.bib" or die "Cannot write $texdir$base.bib: $!"; |
| } |
| open TEX,">$texdir$base.tex" or die "Cannot write $texdir$base.tex: $!"; |
| warn "Writing $texdir$base.tex"; |
| } |
| } |
| if ($nohtml || $dryrun) { |
| open HTML,">/dev/null"; |
| } else { |
| if (!length($htmldir) || -d $htmldir) { |
| $html1 = "$base.html"; |
| open HTML,">$htmldir$html1" or die "Cannot write $htmldir$html1: $!"; |
| warn "Writing $htmldir$html1"; |
| } else { |
| warn "WARNING: For HTML conversion to work, you must create subdirectory called html. E.g. pd2tex -init (or mkdir html)"; |
| open HTML,">/dev/null"; |
| $html1 = undef; |
| } |
| } |
| if ($nohtml2 || $dryrun) { |
| open HTML2,">/dev/null"; |
| $html2 = undef; |
| } else { |
| if (!length($htmldir) || -d $htmldir) { |
| $html2 = "$base-front-matter.html"; |
| open HTML2,">$htmldir$html2" or die "Cannot write $htmldir$html2: $!"; |
| warn "Writing $htmldir$html2"; |
| } else { |
| warn "WARNING: For HTML conversion to work, you must create subdirectory called html. E.g. mkdir html"; |
| open HTML2,">/dev/null"; |
| $html2 = undef; |
| } |
| } |
| if ($nodbx || $dryrun) { |
| open DBX,">/dev/null"; |
| } else { |
| open DBX,">$dbxdir$base.dbx" or die "Cannot write $dbxdir$base.dbx: $!"; |
| warn "Writing $dbxdir$base.dbx"; |
| } |
| if ($nortf || $dryrun) { |
| open RTF,">/dev/null"; |
| } else { |
| open RTF,">$rtfdir$base.rtf" or die "Cannot write $rtfdir$base.rtf: $!"; |
| warn "Writing $rtfdir$base.rtf"; |
| } |
| } else { |
| if ($dbx_filter) { |
| open BIB,">/dev/null"; |
| open TEX,">/dev/null"; |
| open DBX,">&STDOUT"; |
| open RTF,">/dev/null"; |
| open NONL,">/dev/null"; |
| open PDSEAL,">/dev/null"; |
| open HTML,">/dev/null"; |
| open HTML2,">/dev/null"; |
| $html2 = undef; |
| } elsif ($html_filter) { |
| open BIB,">/dev/null"; |
| open TEX,">/dev/null"; |
| open DBX,">/dev/null"; |
| open RTF,">/dev/null"; |
| open NONL,">/dev/null"; |
| open PDSEAL,">/dev/null"; |
| open HTML,">&STDOUT"; |
| open HTML2,">/dev/null"; |
| $html2 = undef; |
| } else { |
| open BIB,">/dev/null"; |
| open TEX,">&STDOUT"; |
| open DBX,">/dev/null"; |
| open RTF,">/dev/null"; |
| open NONL,">/dev/null"; |
| open PDSEAL,">/dev/null"; |
| open HTML,">/dev/null"; |
| open HTML2,">/dev/null"; |
| $html2 = undef; |
| } |
| $nopdf = 1; |
| } |
| |
| # Exceptions to the two letter country code recognition |
| %not_a_country = ( pl=>'perl', cc=>'c++', hh=>'c++ hdr', sh=>'Shell', |
| ds=>'DirectoryScript', pd=>'PlainDoc', so=>'Shared Object' ); |
| |
| # Exceptions to dot designates path rule |
| %not_a_path = ( 'i.e'=>1, 'e.g'=>1, 'p.ex'=>1, 'E.U'=>1, 'U.E'=>1, 'U.S'=>1, |
| 'and/or'=>1, 'AND/OR'=>1, 'e/ou'=>1, 'ja/tai'=>1, |
| 'c.d'=>1, 'n.b' => 1, 'N.B'=>1, 'S.A'=>1, 'n/a'=>1); |
| |
| $encoding = 'UTF-8'; # only for dbx |
| #$encoding = 'Latin1'; |
| #$code_tag = 'literallayout'; |
| $code_open_tag = '<programlisting format="non-normative-code"><computeroutput>'; # used for indented code blocks |
| $code_close_tag = '</computeroutput></programlisting>'; # used for indented code blocks |
| $tag_tag = 'command'; |
| %dbx_list_open = ( |
| '1' => qq(<orderedlist>\n), |
| 'a' => qq(<orderedlist numeration="loweralpha">\n), |
| 'A' => qq(<orderedlist numeration="upperalpha">\n), |
| 'i' => qq(<orderedlist numeration="loweralpha">\n), |
| 'I' => qq(<orderedlist numeration="loweralpha">\n), |
| '*' => qq(<itemizedlist mark="bullet">\n), |
| '-' => qq(<itemizedlist mark="hyphen">\n), |
| '+' => qq(<itemizedlist mark="plus">\n), |
| 'o' => qq(<itemizedlist mark="opencircle">\n), |
| ':' => qq(<variablelist>\n), # termlength="20" |
| ); |
| %dbx_list_close = ( |
| '1' => qq(</orderedlist>\n\n), |
| 'a' => qq(</orderedlist>\n\n), 'A' => qq(</orderedlist>\n\n), |
| 'i' => qq(</orderedlist>\n\n), 'I' => qq(</orderedlist>\n\n), |
| '*' => qq(</itemizedlist>\n\n), '-' => qq(</itemizedlist>\n\n), |
| '+' => qq(</itemizedlist>\n\n), 'o' => qq(</itemizedlist>\n\n), |
| ':' => qq(</variablelist>\n\n), |
| ); |
| |
| # html |
| |
| %html_list_open = ( |
| '1' => qq(<ol>\n), |
| 'a' => qq(<ol>\n), 'A' => qq(<ol>\n), |
| 'i' => qq(<ol>\n), 'I' => qq(<ol>\n), |
| '*' => qq(<ul>\n), '-' => qq(<ul>\n), |
| '+' => qq(<ul>\n), 'o' => qq(<ul>\n), |
| ':' => qq(<dl>\n), |
| ); |
| %html_list_close = ( |
| '1' => qq(</ol>\n\n), |
| 'a' => qq(</ol>\n\n), 'A' => qq(</ol>\n\n), |
| 'i' => qq(</ol>\n\n), 'I' => qq(</ol>\n\n), |
| '*' => qq(</ul>\n\n), '-' => qq(</ul>\n\n), |
| '+' => qq(</ul>\n\n), 'o' => qq(</ul>\n\n), |
| ':' => qq(</dl>\n\n), |
| ); |
| |
| # rtf |
| |
| %ord_mark = ( |
| '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) ], |
| '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) ], |
| '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) ], |
| 'i' => [ qw(i ii iii iv v vi vii viii ix x xi xii xiii xiv xv xvi xvii xviii xix xx) ], |
| 'I' => [ qw(I II III IV V VI VII VIII IX X XI XII XIII XIV XV XVI XVII XVIII XIX XX) ], |
| ); |
| |
| $rtf_tabs = '\tx720 \tx1440 \tx2160 \tx2880'; |
| |
| %rtf_styles = ( |
| 'ds1' => 'SEC1;', |
| 'ds2' => 'SEC2;', |
| 'ds3' => 'SEC3;', |
| 'ds4' => 'SEC4;', |
| 'ds5' => 'SEC5;', |
| 'ds6' => 'SEC6;', |
| |
| 's1' => '\sa360 \keepn \fs48 \b H1;', |
| 's2' => '\sa320 \keepn \fs36 \b H2;', |
| 's3' => '\sa280 \keepn \fs30 \b H3;', |
| 's4' => '\sa220 \keepn \fs24 \b H4;', |
| 's5' => '\sa220 \keepn \fs24 \b H5;', |
| 's6' => '\sa220 \keepn \fs24 \b H6;', |
| |
| 's10' => '\sa360 para;', |
| 's14' => '\qc \sa360 \fs56 \b Title;', |
| 's15' => '\qc \sa360 \i Author;', |
| 's16' => '\qj \sa360 \li720 \ri720 \i Abstract;', |
| |
| 's21' => '\sa180 \qj \li360 \ri360 blockquote1;', |
| 's22' => '\sa180 \qj \li720 \ri720 blockquote2;', |
| 's23' => '\sa180 \qj \li1080 \ri1080 blockquote3;', |
| 's24' => '\sa180 \qj \li1440 \ri1440 blockquote4;', |
| |
| 's31' => $rtf_tabs . ' \sa180 \li720 \ri180 \fi-720 list1;', |
| 's32' => $rtf_tabs . ' \sa180 \li1440 \ri180 \fi-720 list2;', |
| 's33' => $rtf_tabs . ' \sa180 \li2160 \ri180 \fi-720 list3;', |
| 's34' => $rtf_tabs . ' \sa180 \li2880 \ri180 \fi-720 list4;', |
| ); |
| |
| %rtf_list_item = ( |
| '1' => qq({\\pn \\pnlvl!!N !!M. ), |
| 'a' => qq({\\pn \\pnlvl!!N !!M. ), 'A' => qq({\\pn \\pnlvl!!N !!M. ), |
| 'i' => qq({\\pn \\pnlvl!!N !!M. ), 'I' => qq({\\pn \\pnlvl!!N !!M. ), |
| #'*' => qq({\\par \\pard \\bullet ), '-' => qq(\\par \\pard - ), |
| '*' => qq({\\pn \\pnlvl!!N \\pnlvlblt {\\pntxtb \\bullet} ), '-' => qq({\\pn \\pnlvl!!N \\pnlvlblt {\\pntxtb -} ), |
| '+' => qq({\\pn \\pnlvl!!N \\pnlvlblt {\\pntxtb +} ), 'o' => qq({\\pn \\pnlvl!!N \\pnlvlblt {\\pntxtb o} ), |
| ) if 0; |
| |
| %rtf_list_item = ( |
| '1'=>"{\\pard !!S \\s3!!N\n!!M.\\tab ", |
| 'a'=>"{\\pard !!S \\s3!!N\n!!M.\\tab ", 'A'=>"{\\pard !!S \\s3!!N\n!!M.\\tab ", |
| 'i'=>"{\\pard !!S \\s3!!N\n!!M.\\tab ", 'I'=>"{\\pard !!S \\s3!!N\n!!M.\\tab ", |
| '*'=>"{\\pard !!S \\s3!!N\n\\'b7\\tab ", '-'=>"{\\pard !!S \\s3!!N\n-\\tab ", |
| '+'=>"{\\pard !!S \\s3!!N\n+\\tab ", 'o'=>"{\\pard !!S \\s3!!N\no\\tab ", |
| ) if 1; |
| |
| $enum = 'enumerate'; |
| #$enum = 'denseenum'; |
| $itemize = 'itemize'; |
| #$itemize = 'denseitemize'; |
| |
| %tex_list_open = ( |
| '1' => qq(\\begin{$enum}[1.]\n), |
| 'a' => qq(\\begin{$enum}[a.]\n), 'A' => qq(\\begin{$enum}[A.]\n), |
| 'i' => qq(\\begin{$enum}[i.]\n), 'I' => qq(\\begin{$enum}[I.]\n), |
| '*' => qq(\\begin{$itemize}\n), '-' => qq(\\begin{$itemize}\n), |
| '+' => qq(\\begin{$itemize}\n), 'o' => qq(\\begin{$itemize}\n), |
| ':' => qq(\\begin{description}\n), |
| ); |
| %tex_list_item = ( |
| '1' => qq(\\item ), |
| 'a' => qq(\\item ), 'A' => qq(\\item ), |
| 'i' => qq(\\item ), 'I' => qq(\\item ), |
| '*' => qq(\\item ), '-' => qq(\\item[-] ), |
| '+' => qq(\\item[+] ), 'o' => qq(\\item[o] ), |
| ':' => qq(\\item[notused]\n), |
| ); |
| %tex_list_close = ( |
| '1' => qq(\\end{$enum}\n\n), |
| 'a' => qq(\\end{$enum}\n\n), 'A' => qq(\\end{$enum}\n\n), |
| 'i' => qq(\\end{$enum}\n\n), 'I' => qq(\\end{$enum}\n\n), |
| '*' => qq(\\end{$itemize}\n\n), '-' => qq(\\end{$itemize}\n\n), |
| '+' => qq(\\end{$itemize}\n\n), 'o' => qq(\\end{$itemize}\n\n), |
| ':' => qq(\\end{description}\n\n), |
| ); |
| |
| %tex_align = ( l => '', r => '\\hfill ', c => '\\centering' ); # , '' => ' \\raggedright' |
| %th_align = ( l => ' align=left', r => ' align=right', c => '' ); |
| %td_align = ( l => '', r => ' align=right', c => ' align=center' ); |
| |
| $class = 'article'; |
| $tex_doc_class = "\\documentclass[12pt]{article}\n"; |
| |
| # See also <<texsections: ignore section* subsection* subsubsection* subsubsubsection* paragraph*>> |
| # N.B. subsubsubsection does not exist in all LaTeX document styles |
| # ==== ---- ~~~~ ^^^^ |
| @tex_sec_article = qw( ignore section subsection subsubsection textbf paragraph ); |
| @tex_sec_slide = qw( ignore section* subsection* subsubsection* subsubsubsection* paragraph* ); |
| @tex_sec_book = qw( ignore chapter section subsection subsubsection subsubsubsection paragraph ); |
| @tex_sec = @tex_sec_article; |
| #$tex_flt_place = '!hbp'; |
| $tex_flt_place = '!hbt'; #Removed p because you usually do not want all the images in one page at the end of the chapter |
| $includegraphics = '\\includegraphics[width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio]'; |
| $maketitle = '\\maketitle'; |
| $moretexpreamble = <<LATEX; |
| \\setlength\\parskip{\\medskipamount} |
| \\setlength\\parindent{0pt} |
| \\lfoot{\\today} |
| \\cfoot{!?!AUTHOR} |
| \\rfoot{!?!HEADER_TITLE, p. \\thepage !?!AFTER_PAGE} |
| LATEX |
| ; |
| $moretexpreamble_empty = <<LATEX; |
| \\setlength\\parskip{\\medskipamount} |
| \\setlength\\parindent{0pt} |
| LATEX |
| ; |
| #\\lhead{} |
| #\\chead{} |
| #\\rhead{} |
| #\\lfoot{} |
| #\\cfoot{} |
| #\\rfoot{} |
| #LATEX |
| # ; |
| |
| $moretexpreamble_clean = <<LATEX; |
| \\setlength\\parskip{\\medskipamount} |
| \\setlength\\parindent{0pt} |
| \\lhead{} |
| \\chead{} |
| \\rhead{} |
| \\lfoot{} |
| \\cfoot{} |
| \\rfoot{} |
| \\pagestyle{empty} |
| LATEX |
| ; |
| |
| $moretexpreamble_confidential = <<LATEX; |
| \\setlength\\parskip{\\medskipamount} |
| \\setlength\\parindent{0pt} |
| \\lfoot{\\today\\\\Proprietary and Confidential. May contain privileged information.} |
| \\cfoot{\\copyright !?!COPYRIGHT} |
| \\rfoot{!?!HEADER_TITLE, p. \\thepage !?!AFTER_PAGE} |
| LATEX |
| ; |
| |
| $tex_boxed_tab = 1; |
| if ($tex_boxed_tab) { |
| $tex_tab_hdr_sep = "\\\\\n\\hline\n\\hline\n"; |
| $tex_tab_line_sep = "\\\\\n\\hline\n"; |
| $tex_left_bar = '|'; |
| $tex_top_line = "\\hline\n"; |
| $tex_bot_line = "\\\\\n\\hline\n"; |
| } else { |
| $tex_tab_hdr_sep = "\\\\\n\\hline\n"; |
| $tex_tab_line_sep = "\\\\\n"; |
| $tex_left_bar = ''; |
| $tex_top_line = ''; |
| $tex_bot_line = ''; |
| } |
| |
| $toc_enable = ''; |
| |
| $dbxpreamble = <<DBX; # <!ENTITY legalnotice SYSTEM "../legal/legalnotice-sg-1.0.dbx"> |
| <?xml version="1.0" encoding="$encoding"?> |
| <!DOCTYPE article SYSTEM "../../src/dtd/libdocbook.dtd" [ |
| <!ENTITY % xinclude SYSTEM "../../src/dtd/xinclude.mod"> |
| %xinclude; |
| <!ENTITY legalnotice SYSTEM "../legal/legalnotice-wsf-2.0.dbx"> |
| ]> |
| DBX |
| ; |
| |
| # N.B. in the following !?! indicates a variable that will be substituted near end of processing |
| |
| $htmlpreamble2 = <<HTML2; |
| <title>!?!TITLE</title> |
| <link type="text/css" rel="stylesheet" href="!?!BASE.css"> |
| <body bgcolor=white> |
| [<a href="!?!PREV">Prev</a>]<hr> |
| HTML2 |
| ; |
| $htmlpostamble2 = qq(<hr>[<a href="!?!PREV" class=prevBut>Prev</a> | <a href="!?!NEXT" class=nextBut>Next</a>]<hr>\n); |
| |
| ### End configure |
| |
| use Data::Dumper; |
| use POSIX qw(strftime); |
| $curdate = strftime "%e %b %Y", gmtime; |
| $yyyy = 1900 + (gmtime)[5]; |
| |
| ### Expand all %include_pd() and %include_code() sections |
| |
| sub readall { |
| my ($f, $dont_die_on_unfound) = @_; |
| unless (open X, "<$f") { |
| if ($dont_die_on_unfound) { |
| warn "$i: Missing include file <<$f>>: $!"; |
| warn `pwd`; |
| return "***missing file $f***"; |
| } else { |
| die "Cant read($f): $!"; |
| } |
| } |
| undef $/; # warning: global effect |
| my $x = <X>; |
| close X; |
| return $x; |
| } |
| |
| sub writeall { |
| my ($f,$x) = @_; |
| open X, ">$f" or die "Cant write $f: $!"; |
| warn "Writing $f"; |
| print X $x; |
| close X; |
| } |
| |
| sub include { |
| my ($prefix,$path,$ext) = @_; |
| return "$prefix<<$path$ext>>" if $path =~ /^\w+:/; # Specials |
| if ($ext =~ /^\.(svg)|(e?ps)|(png)|(gif)|(jpe?g)$/i) { # Images |
| warn(('-'x$inc_iter)." image: $path$ext\n"); |
| return "$prefix<<$path$ext>>"; |
| } |
| #my $x = readall(($path=~m%^/%s) ? "$path$ext":"../$path$ext", 1); |
| my $x = readall("$path$ext", 1); |
| warn(('-'x$inc_iter)." <<include: $path$ext>> got ".length($x)." chars\n"); |
| $x =~ s/\r?\n<<EOF: .*?>>.*$//s; |
| if ($prefix =~ /^\s+$/) { # Verbatim block? |
| $x =~ s/\n/\n$prefix/g; |
| return $prefix . $x; |
| } else { |
| return $x; |
| } |
| } |
| |
| sub incl_range { |
| my ($prefix,$path,$ext,$start,$end) = @_; |
| my $x = readall($path.$ext, 1); |
| my @lines = split /\r?\n/, $x; |
| warn(('-'x$inc_iter)." <<includerange:$path$ext: $start-$end>> got ".length($x)." chars, $#lines lines\n"); |
| @lines = splice @lines, $start, $end-$start; |
| $x = join "\n", @lines; |
| if ($prefix =~ /^\s+$/) { # Verbatim block? |
| $x =~ s/\n/\n$prefix/g; |
| return $prefix . $x; |
| } else { |
| return $x; |
| } |
| } |
| |
| sub hexit { |
| my ($x,$tag) = @_; |
| $x =~ s/(.)/sprintf("%02x",ord($1))/ges; |
| return "^^^^^^^^$tag: $x~~~~~~~~" if $tag; |
| return $x; |
| } |
| |
| sub unhexit { |
| my ($x) = @_; |
| $x =~ s/(..)/chr(hex($1))/gsex; |
| return $x; |
| } |
| |
| sub def_macro { |
| my ($name, $value) = @_; |
| #die "def_macro($name,$value)"; |
| $mac{$name} = $value unless defined $cmdline_mac{$name}; |
| return ''; |
| } |
| |
| sub def_specific_macro { |
| my ($name, $tex, $dbx, $htm, $rtfl) = @_; |
| #warn "SPECIFIC MACRO tex($tex) dbx($dbx) html($html)"; |
| $mac{$name} = ''; |
| $mac{$name} .= hexit($tex, 'RAWTEX') if $tex; |
| $mac{$name} .= hexit($dbx, 'RAWDBX') if $dbx; |
| $mac{$name} .= hexit($rtf, 'RAWRTF') if $rtf; |
| $mac{$name} .= hexit($html,'RAWHTML') if $html; |
| #$tex_mac{$name} = $tex; |
| #$dbx_mac{$name} = $dbx; |
| #$html_mac{$name} = $html; |
| return ''; |
| } |
| |
| sub extract_macros { |
| # <<define: MACRO!value>> <<define: MACRO=value>> |
| # 1 1 2 2 |
| $pd =~ s|\n<<define:\s+(\w+)[=!]([^>]+)>>|def_macro($1, $2)|gex; |
| #$pd =~ s|\n<<define:\s+\w+.*?>>\s*\n|HErE|sg; |
| # 1 1 2 tex 2 3 dbx 3 4 html 4 |
| #$pd =~ s/\n<<definespecific: (\w+)(?:!([^!>]+)(?:!([^!>]+)(?:!([^!>]+))?)?)?>>/def_specific_macro($1, $2, $3, $4)/gex; |
| # 1 1 2 tex 2 3 dbx 3 4 html 4 |
| $pd =~ s/\n<<definespecific:\s+(\w+)[!=]([^!]+)!([^!]+)!([^!]+?)>>/def_specific_macro($1, $2, $3, $4)/gex; |
| $pd =~ s|\n<<default:\s+(\w+)!([^>]+)>>|def_macro($1, $2) if !defined $mac{$1}|gex; |
| } |
| |
| ### |
| ### Read in file, expand includes, process conditionals |
| ### |
| |
| undef $/; |
| $pd = <STDIN>; |
| warn "original input: ".length($pd)." chars\n"; |
| $pd =~ s|\n<<define1st:\s+(\w+)[=!]([^>]+)>>|def_macro($1, $2)|gex; |
| #extract_macros(); # First iteration, only -D macros are valid |
| for ($inc_iter = 1; $inc_iter <= 5; ++$inc_iter) { # 5 levels of include nesting |
| #Remove lines beginning with % (by Fredrik Jonsson 070708) |
| # Unfortunately this seems to interfere with verbatim includes, esp. sg --Sampo |
| #$/ = "\n"; # Disable Slurp mode to find beginning of lines |
| #$pd =~ s/^%.*//gm; # % means TeX comment |
| #undef $/; # Enable Slurp mode again |
| |
| # 1 1 2 path 23 ext 3 4 4 5 5 |
| $pd =~ s{^(.*?)<<includerange: ([^\n>:]+?)(\.\w+)?:\s+(\d+)-(\d+)>>} |
| {incl_range($1,$2,$3,$4,$5)}gem; |
| $pd =~ s/^(.*?)<<([^\n>]+?)(\.\w+)?>>/include($1,$2,$3)/gem; |
| $pd =~ s/<<ignore:\s+.*?>>[ \t]*//sg; # Ignore blocks are omitted (eat trailing spaces, too) |
| |
| # Conditional processing (n.b. only macros from -D flags or <<define1st: >> can be tested) |
| # 1 1 2 2 3 3 |
| $pd =~ s/<<if:\s+(\w+)>>(.*?)<<else:\s+>>(.*?)<<fi:\s+>>/$mac{$1}?$2:$3/gsex; |
| |
| extract_macros(); |
| } |
| warn "input after includes and conditionals: ".length($pd)." chars\n"; |
| |
| ### Figure out document class |
| |
| $pagestyle = "\\usepackage{fancyhdr}\n\\pagestyle{fancy}\n"; |
| |
| ($class, $optarg, $lang, $header_title, $after_page, $moreopt) = |
| $pd =~ m/<<class:\s+(\w+)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*))?)?)?)?)?>>/s; |
| if ($class) { |
| #warn "class($class) optarg($optarg) lang($lang) hdrtit($header_title) after_page($after_page) [$&]"; |
| $pd =~ s/<<class:\s+.*?>>//s; |
| if ($class eq 'book') { |
| warn "BOOK"; |
| @tex_sec = @tex_sec_book; |
| } elsif ($class eq 'empty') { |
| warn "EMPTY"; |
| $class = 'article'; |
| $moretexpreamble = $moretexpreamble_empty; |
| } elsif ($class eq 'clean') { |
| warn "CLEAN"; |
| $class = 'article'; |
| $moretexpreamble = $moretexpreamble_clean; |
| } elsif ($class eq 'confidential') { |
| warn "CONFIDENTIAL"; |
| $class = 'article'; |
| $moretexpreamble = $moretexpreamble_confidential; |
| } elsif ($class eq 'slide') { |
| warn "SLIDE"; |
| @tex_sec = @tex_sec_slide; |
| $class = 'article'; |
| $optarg ||= '12pt'; |
| $paper = 'custom'; |
| $wid = '400pt'; |
| $ht = '300pt'; |
| $new_slide = "\n\\newpage\n\n"; # force page break before each section |
| $lm = '5mm'; |
| $tm = '3mm'; |
| $rm = '5mm'; |
| $bm = '7mm'; # tall enough for 8mm logo art in footer |
| $hh = '12pt'; |
| $hs = '5pt'; |
| $fh = '12pt'; |
| $fs = '14pt'; |
| } |
| $tex_doc_class = "\\documentclass[$optarg]{$class}\n"; |
| $tex_doc_class .= "\\usepackage[$lang]{babel}\n\\selectlanguage{$lang}\n" if $lang; |
| } |
| |
| if ($moreopt eq 'lineno') { |
| $lineno = "\\usepackage{lineno}\n\\linenumbers"; |
| } |
| |
| ### Custom paper size and margins (See LaTeX companion pp.89-90 (vmargin replaces vpage)) |
| # <<papersize: empty!a4!landsacpe>> |
| # <<papersize: fancy!a4>> |
| # <<papersize: fancy!custom!dummy!WIDTHpt!HEIGHTpt!LM!TM!RM!BM!HEAD-HEIGHT!HEAD-SKIP!FOOT-HEIGHT!FOOT-SKIP>> |
| # <<papersize: fancy!custom!dummy!210mm!297mm!25mm!10mm!25mm!10mm!7mm!5mm!7mm!5mm>> |
| |
| ($headfootstyle, $paper2, $orient, $wid2, $ht2, $lm2, $tm2, $rm2, $bm2, $hh2, $hs2, $fh2, $fs2) = |
| $pd =~ m/<<papersize:\s+(\w+)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*)(?:!([^!>]*))?)?)?)?)?)?)?)?)?)?)?)?>>/s; |
| $pd =~ s/<<papersize:\s+.*?>>//s; |
| |
| $paper = $paper2 if $paper2; |
| $wid = $wid2 if $wid2; |
| $ht = $ht2 if $ht2; |
| |
| $lm = $lm2 if $lm2; # left margin |
| $tm = $tm2 if $tm2; # top margin |
| $rm = $rm2 if $rm2; # right margin |
| $bm = $bm2 if $bm2; # bottom margin |
| $hh = $hh2 if $hh2; # head height |
| $hs = $hs2 if $hs2; # head sep |
| $fh = $fh2 if $fh2; # foot height |
| $fs = $fs2 if $fs2; # foot skip |
| |
| if ($paper || $orient) { |
| $vmargin ||= "\\usepackage{vmargin}\n"; |
| $paper ||= "Afour"; |
| if ($paper eq 'custom') { |
| $vmargin .= "\\setpapersize{custom}{$wid}{$ht}\n"; |
| } else { |
| $orient = "[$orient]" if $orient; |
| $vmargin .= "\\setpapersize${orient}{$paper}\n"; |
| } |
| } |
| |
| if ($lm || $tm || $rm || $bm) { |
| $lm ||= '0mm'; # left margin |
| $tm ||= '0mm'; # top margin |
| $rm ||= '0mm'; # right margin |
| $bm ||= '0mm'; # bottom margin |
| $hh ||= '0mm'; # head height |
| $hs ||= '0mm'; # head sep |
| $fh ||= '0mm'; # foot height |
| $fs ||= '0mm'; # foot skip |
| $vmargin ||= "\\usepackage{vmargin}\n"; |
| $vmargin .= "\\setmarginsrb{$lm}{$tm}{$rm}{$bm}{$hh}{$hs}{$fh}{$fs}\n"; |
| } |
| |
| warn "vmargin($vmargin)"; |
| |
| if ($headfootstyle && $headfootstyle ne 'fancy') { |
| $pagestyle = "\\pagestyle{$headfootstyle}\n"; # e.g. empty or plain |
| } |
| |
| ### Tweak paragraph and line spacing: <<linespace: LINESPACING!PARINDENT!PARSKIP>> |
| |
| ($linespacing, $parindent, $parskip) = |
| $pd =~ m/<<linespace:\s+([^!>]*)(?:!([^!>]*)(?:!([^!>]*))?)?>>/s; |
| $pd =~ s/<<linespace:\s+.*?>>//s; |
| |
| $linespace .= "\\renewcommand{\\baselinestretch}{$linespacing}\n" if $linespacing; |
| $linespace .= "\\setlength\\parindent{$parindent}\n" if $parindent; |
| $linespace .= "\\setlength\\parskip{$parskip}\n" if $parskip; |
| |
| #die "pd($pd)"; |
| |
| $pd =~ s/<<cvsid:\s+(.*?)>>/$cvsid.="$1\n",''/ge; |
| ($cvsfile, $cvsrevision, $cvsdate, $cvstime, $cvsuser) = |
| $cvsid =~ /^\$Id:\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+/; |
| def_macro('CVSID', $cvsid); |
| def_macro('CVSFILE', $cvsfile); |
| def_macro('CVSREVISION', $cvsrevision); |
| def_macro('CVSDATE', $cvsdate); |
| def_macro('CVSTIME', $cvstime); |
| def_macro('CVSUSER', $cvsuser); |
| |
| ($author) = $pd =~ m/<<author:\s+(.*?)>>/; |
| $pd =~ s/<<author:\s+.*?>>//; |
| $author ||= 'N.N.'; |
| #warn "author($author)"; |
| def_macro('AUTHOR', $author); |
| |
| ($copyright) = $pd =~ m/<<copyright:\s+(.*?)>>/; |
| $pd =~ s/<<copyright:\s+.*?>>//; |
| $copyright ||= $author; |
| def_macro('COPYRIGHT', $copyright); |
| |
| ($top_id , $version) = $pd =~ m/<<version:(?:([\w-]+):)?\s+(.*?)>>/; |
| $pd =~ s/<<version:.*?>>//; |
| def_macro('VERSION', $version); |
| |
| ### Substitute macros |
| |
| $pd =~ s/!!(\w+)(?:\?([^!]*)\?)?/$mac{$1}||$2/ge; |
| |
| ### Extract some special <<components>> |
| |
| ($x) = $pd =~ s%<<notapath:\s+(.*?)>>%for $x (split /[,\s]+/,$1) { $not_a_path{$x}=1; }%gse; |
| ($x) = $pd =~ s%<<notaurl:\s+(.*?)>>%for $x (split /[,\s]+/,$1) { $not_a_url{$x}=1; }%gse; |
| ($x) = $pd =~ s%<<notacountry:\s+(.*?)>>%for $x (split /[,\s]+/,$1) { $not_a_country{$x}=1; }%gse; |
| |
| ($abstract) = $pd =~ m/<<abstract:\s+(.*?)>>/s; |
| #warn "abstract $abstract" if $trace;; |
| #$tex_abstract = "\\begin{quote} Abstract: ".tex_para($abstract)."\\end{quote}\n\n" if $abstract; |
| $tex_abstract = "\\begin{abstract}\n".tex_para($abstract)."\\end{abstract}\n\n" if $abstract; |
| $rtf_abstract = rtf_format($abstract) if $abstract; |
| $rtf_abstract =~ s/\n/\n /sg; |
| $nonl_abstract = $abstract; |
| $pdseal_abstract = $abstract; |
| $abstract =~ s%\r?\n\r?\n%^^^^/para~~~~\n^^^^para~~~~%sg; |
| $dbx_abstract = dbx_para($abstract); |
| $abstract =~ s%^^^^/para~~~~\n^^^^para~~~~%\n^^^^p~~~~%sg; |
| $html_abstract = html_para($abstract); |
| |
| $pd =~ s/<<abstract:\s+.*?>>/<<tex:\n$tex_abstract>>/s; |
| |
| ($first_page) = $pd =~ m/<<1stpage:\s+(.*?)>>/s; |
| $pd =~ s/<<1stpage:\s+.*?>>//s; |
| |
| ($keywords) = $pd =~ m/<<keywords:\s+(.*?)>>/s; |
| $pd =~ s/<<keywords:\s+.*?>>//s; |
| $keywords =~ s{,\s*}{</keyword>\n<keyword>}gs; |
| |
| ($x) = $pd =~ m/<<texpreamble:\s+(.*?)>>/s; |
| $pd =~ s/<<texpreamble:\s+.*?>>//s; |
| $texpreamble = $x if $x; |
| $texpreamble =~ s/!\?!AUTHOR/$author/; |
| $texpreamble =~ s/!\?!HEADER_TITLE/$header_title/; |
| $texpreamble =~ s/!\?!AFTER_PAGE/$after_page/; |
| $texpreamble =~ s/!\?!COPYRIGHT/$copyright/; |
| $texpreamble =~ s/!\?!VERSION/$version/; |
| $texpreamble =~ s/!\?!TITLE/$doctitle/; # *** $doctitle not defined yet |
| |
| if ($pd =~ m/<<moretexpreamble:\s+.*?>>/s) { |
| $moretexpreamble = ''; |
| $pd =~ s/<<moretexpreamble:\s+(.*?)>>/$moretexpreamble.=$1,''/gse; |
| } |
| $moretexpreamble =~ s/!\?!AUTHOR/$author/; |
| $moretexpreamble =~ s/!\?!HEADER_TITLE/$header_title/; |
| $moretexpreamble =~ s/!\?!AFTER_PAGE/$after_page/; |
| $moretexpreamble =~ s/!\?!COPYRIGHT/$copyright/; |
| $moretexpreamble =~ s/!\?!VERSION/$version/; |
| $moretexpreamble =~ s/!\?!TITLE/$doctitle/; # *** $doctitle not defined yet |
| |
| if ($pd =~ m/<<moremoretexpreamble:\s+.*?>>/s) { |
| $pd =~ s/<<moremoretexpreamble:\s+(.*?)>>/$moremoretexpreamble.=$1,''/gse; |
| } |
| |
| ($x) = $pd =~ m/<<dbxpreamble:\s+(.*?)>>/s; |
| $pd =~ s/<<dbxpreamble:\s+.*?>>//s; |
| $dbxpreamble = $x if $x; |
| |
| ($x) = $pd =~ m/<<htmlpreamble:\s+(.*?)>>/s; |
| $pd =~ s/<<htmlpreamble:\s+.*?>>//s; |
| $htmlpreamble = $x if $x; |
| $htmlpreamble =~ s/!\?!AUTHOR/$author/; |
| $htmlpreamble =~ s/!\?!HEADER_TITLE/$header_title/; |
| $htmlpreamble =~ s/!\?!AFTER_PAGE/$after_page/; |
| $htmlpreamble =~ s/!\?!COPYRIGHT/$copyright/; |
| $htmlpreamble =~ s/!\?!VERSION/$version/; |
| $htmlpreamble =~ s/!\?!TITLE/$doctitle/; # *** $doctitle not defined yet |
| |
| ($x) = $pd =~ m/<<htmlpostamble:\s+(.*?)>>/s; |
| $pd =~ s/<<htmlpostamble:\s+.*?>>//s; |
| $htmlpostamble = $x if $x; |
| $htmlpostamble =~ s/!\?!AUTHOR/$author/; |
| $htmlpostamble =~ s/!\?!HEADER_TITLE/$header_title/; |
| $htmlpostamble =~ s/!\?!AFTER_PAGE/$after_page/; |
| $htmlpostamble =~ s/!\?!COPYRIGHT/$copyright/; |
| $htmlpostamble =~ s/!\?!VERSION/$version/; |
| $htmlpostamble =~ s/!\?!TITLE/$doctitle/; # *** $doctitle not defined yet |
| |
| ($x) = $pd =~ m/<<htmlpreamble2:\s+(.*?)>>/s; |
| $pd =~ s/<<htmlpreamble2:\s+.*?>>//s; |
| $htmlpreamble2 = $x if $x; |
| $htmlpreamble2 =~ s/!\?!AUTHOR/$author/; |
| $htmlpreamble2 =~ s/!\?!HEADER_TITLE/$header_title/; |
| $htmlpreamble2 =~ s/!\?!AFTER_PAGE/$after_page/; |
| $htmlpreamble2 =~ s/!\?!COPYRIGHT/$copyright/; |
| $htmlpreamble2 =~ s/!\?!VERSION/$version/; |
| $htmlpreamble2 =~ s/!\?!TITLE/$doctitle/; # *** $doctitle not defined yet |
| |
| ($x) = $pd =~ m/<<htmlpostamble2:\s+(.*?)>>/s; |
| $pd =~ s/<<htmlpostamble2:\s+.*?>>//s; |
| $htmlpostamble2 = $x if $x; |
| $htmlpostamble2 =~ s/!\?!AUTHOR/$author/; |
| $htmlpostamble2 =~ s/!\?!HEADER_TITLE/$header_title/; |
| $htmlpostamble2 =~ s/!\?!AFTER_PAGE/$after_page/; |
| $htmlpostamble2 =~ s/!\?!COPYRIGHT/$copyright/; |
| $htmlpostamble2 =~ s/!\?!VERSION/$version/; |
| $htmlpostamble2 =~ s/!\?!TITLE/$doctitle/; # *** $doctitle not defined yet |
| |
| ($additionalarticleinfodbx) = $pd =~ m/<<additionalarticleinfodbx:\s+(.*?)>>/s; |
| $pd =~ s/<<additionalarticleinfodbx:\s+.*?>>//s; |
| |
| ($odt_name, $x) = $pd =~ m/<<odtpreamble:\s+(\w+)\n(.*?)>>/s; |
| if ($x) { |
| $pd =~ s/<<odtpreamble:\s+.*?>>//s; |
| open ODT, ">$odt_name/content.xml" or die "Can not write ODT file '$odt_name/content.xml': $!"; |
| warn "Writing $odt_name/content.xml"; |
| print ODT $x; |
| } else { |
| open ODT,">/dev/null"; |
| } |
| |
| ($history_ena, $history_title, $x) = $pd =~ m/<<history:(\d:)?\s*(\S[^\n]*)?(.*?)>>/s; |
| $history = $x if $x; # 2 dd mm yy 3 auth 12.10.2005 |
| @history = split qr{^([\d.-]+):: (\d+[./-]\d+[./-]\d+),\s+(.*?)\s*$}m, $history; |
| shift @history; |
| if (!@history) { |
| # 2 dd mm yy 12. October, 2005 |
| @history = split /^([\d.-]+):: (\d+\.\s+\w+,?\s+\d+),\s+(.*?)\s*$/m, $history; |
| shift @history; |
| } |
| |
| if ($history) { |
| if ($history_title =~ /^\d/) { |
| # *** Process "2.4.2005, description, --Author" style history |
| } |
| $tex_history = $history_title ? "\\subsubsection*{$history_title}" : ''; |
| $tex_history .= qq({\\small\n\\begin{description}); |
| for ($j=0; $j<$#history; $j+=4) { |
| $tex_revdesc = $history[$j+3]; |
| $tex_revdesc =~ s%^\s+\*%\\item%gm; |
| |
| $tex_history .= qq(\\item[$history[$j]] $history[$j+1] $history[$j+2]\n); |
| $tex_history .= qq(\\begin{itemize}\n$tex_revdesc\n\\end{itemize}\n) |
| unless $tex_revdesc =~ /^\s*$/s; |
| } |
| $tex_history .= qq(\\end{description}}); |
| } |
| |
| if ($history_ena eq '1:') { |
| $pd =~ s/<<history:(\d:)?\s+.*?>>/<<tex:\n$tex_history\n>>/sg; |
| } else { |
| $pd =~ s/<<history:(\d:)?\s+.*?>>//sg; |
| } |
| |
| ($credit_title, $x) = $pd =~ m/<<credit:([^\n]*)(.*?)>>/s; |
| $credit = $x if $x; |
| |
| if ($credit) { |
| @credits = split /\n/, $credit; |
| $credit_title =~ s/^\s+//; |
| $tex_credit = "\\textbf{$credit_title}\\\\"; |
| for $x (@credits) { |
| $tex_credit .= tex_para($x); |
| } |
| } |
| $pd =~ s/<<credit:\s+.*?>>/<<tex:\n$tex_credit>>/sg; |
| |
| ### Generate index entries |
| |
| @ix = (); # Words to index |
| |
| sub add_to_index { |
| my ($x) = @_; |
| my ($w,$ws,@ws,$ww); |
| for $ws (split /\n/, $x) { |
| next if $ws =~ /^\s*$/s; |
| $ws =~ s/^\s+//; |
| $ws =~ s/\s+$//; |
| @ws = split /\s*!\s*/, $ws; |
| for $w (@ws) { |
| ($ww,undef) = split /\@/, $w; |
| next if $ww =~ /^\s*$/s; |
| $ix{$ww} = $ws[0]; |
| } |
| } |
| } |
| |
| $pd =~ s/<<wordix:(.*?)>>/add_to_index($1)/seg; |
| $pd =~ s/<<conceptix:(.*?)>>/add_to_index($1)/seg; |
| $pd =~ s/<<peopleix:(.*?)>>/add_to_index($1)/seg; |
| @ix = keys %ix; |
| |
| ($makeindex) = $pd =~ m/<<makeindex:\s+(\d*)(.*?)>>/s; |
| $pd =~ s/<<makeindex:\s+.*?>>/$makeindex?'<<tex: \\printindex>>':''/se; |
| ($maketoc) = $pd =~ m/<<maketoc:\s+(\d*)(.*?)>>/s; |
| $pd =~ s/<<maketoc:\s+.*?>>/$maketoc?'<<tex: \\tableofcontents>>':''/se; |
| ($makelof) = $pd =~ m/<<makelof:\s+(\d*)(.*?)>>/s; |
| $pd =~ s/<<makelof:\s+.*?>>/$makelof?'<<tex: \\listoffigures>>':''/se; |
| ($makelot) = $pd =~ m/<<makelot:\s+(\d*)(.*?)>>/s; |
| $pd =~ s/<<makelot:\s+.*?>>/$makelot?'<<tex: \\listoftables>>':''/se; |
| #warn "makeindex($makeindex) maketoc($maketoc) makelof($makelof) makelot($makelot)"; |
| |
| ($mktit) = $pd =~ m/<<maketitle:\s+(\d*)(.*?)>>/s; |
| if (defined($mktit)) { |
| $maketitle = $mktit ? "\\maketitle\n" : ''; |
| } |
| $pd =~ s/<<maketitle:\s+.*?>>//s; |
| |
| $pd =~ s/^\#.*?-\*-pd-\*-.*?\n//s; |
| ($doctitle,$ul) = $pd =~ m/^(\w..+?)\r?\n(\#\#\#+)\r?\n\r?\n/s; |
| #($doctitle,$version,$ul) = $pd =~ m/^(\w..+?)\nVersion: ([0-9]+\.[0-9]+-[0-9][0-9])\n(\#\#\#+)\n\n/s; |
| |
| $pd =~ s/^\w..+?\r?\n\#\#\#+\r?\n\r?\n//s; |
| warn "Wrong length underline" if length($doctitle) != length($ul); |
| |
| $pd =~ s%<<rawtex:\s*(.*?)>>%hexit($1, 'RAWTEX')%gse; |
| $pd =~ s%<<rawdbx:\s*(.*?)>>%hexit($1, 'RAWDBX')%gse; |
| $pd =~ s%<<rawrtf:\s*(.*?)>>%hexit($1, 'RAWRTF')%gse; |
| $pd =~ s%<<rawhtml:\s*(.*?)>>%hexit($1, 'RAWHTML')%gse; |
| |
| writeall("pd.dump.$$", $pd) if $trace; # Dump file after special tags have been extracted |
| |
| if (1) { |
| $x = $pd; |
| $x =~ s/\\\w+(\[.*?\])*(\{.*?\})*/ /gs; |
| $x =~ s/\$.{1,100}?\$/ /gs; |
| $x =~ s/<<\w+:\s+.*?>>/ /sg; # All special blocks are omitted |
| $x =~ s/\[.+?\]/ /gs; |
| $x =~ s/\d+/ /gs; |
| $x =~ s|[.,;:!?+*&/%\"\'°º()<>{}^~=-]| |g; # *** primero, segunda |
| my @spell = split /\s+/s, $x; |
| my %spell; |
| for $x (@spell) { ++$spell{$x}; } |
| open SPELL, ">${texdir}spell.words" or die "Can't write dump file ${texdir}spell.words: $!"; |
| warn "Writing ${texdir}spell.words"; |
| @spell = sort keys %spell; |
| for $x (@spell) { |
| print SPELL "$x\n" unless $x =~ /^[A-Z]+$/; |
| } |
| close SPELL; |
| # aspell --encoding=iso8859-1 --lang=pt list <spell.words >miten.meni *** ei toimi hyvin |
| # aspell --encoding=iso8859-1 --lang=en_GB-ize --personal=./spell.right list <spell.words |
| # aspell --encoding=iso8859-1 --lang=en_US --personal=./spell.right list <tex/spell.words |
| # First line of spell.right: personal_ws-1.1 en 350 iso8859-1 |
| # ispell -d portugues -p oikein.dict -l <spell.words >miten.meni # Toimii |
| # cd /var/lib/ispell; unzip /t/en_GB-oed.zip; buildhash [-s] dict affix hash # syntax err :-( |
| } |
| |
| ### Split into lines and do line processing |
| |
| @pd = split /\r?\n/, $pd; |
| $i = 0; |
| #die Dumper \@pd; |
| |
| $sec_id[0] = $top_id || $doctitle; |
| $sec_id[0] =~ tr[A-Za-z0-9][_]c; |
| $sec_level = 0; # The section nesting level (0 = doc, 1=sec, 2=subsec, 3=subsubsec, ...) |
| |
| sub sec { |
| my ($la, $j, $nndbx, $given_id, $short_title, $new_sec_level, @n_sec); |
| while ($i <= $#pd) { |
| warn "$i: sec $sec_level" if $trace; |
| body('',''); |
| if ($i > $#pd) { # end |
| close_dbx_sections(); |
| return; |
| } |
| |
| # Ok, now body has detected a section |
| |
| $short_title = $given_id = undef; |
| $_ = $pd[$i]; # section title |
| # 12 2 1 3 3 4 4 5 5 |
| if (/^<<((sub)*)sec:(?:(\w+):(?:([^:>]+):)?)? (.*?)>>/) { # <<sec:ID:short tit: Title>> |
| warn "$i: section detected list_level=$list_level" if $trace; |
| $new_sec_level = (length($1) / 3) + 1; |
| $given_id = $3; |
| $short_title = "[$4]"; |
| $_ = $5; |
| } else { |
| $la = $pd[$i+1]; # underline lookahead |
| warn "underline length does not match" if length $_ != length $la; # Sec candidate |
| if ($la =~ /^====+$/) { $new_sec_level = 1; # Section (Chapter) |
| } elsif ($la =~ /^----+$/) { $new_sec_level = 2; # Subsection (Section) |
| } elsif ($la =~ /^~~~~+$/) { $new_sec_level = 3; # Subsubsection (Subsection) |
| } elsif ($la =~ /^\^\^\^+$/) { $new_sec_level = 4; # Subsubsubsection |
| } else { warn "false alarm, wrong underline type"; } |
| } |
| s/^[\d.]* //s if $pdflag{'stripsecnum'}; |
| |
| if ($new_sec_level == $sec_level) { |
| print DBX ( (' 'x$sec_level) . "</section><!--$sec_id[$sec_level]-->\n\n\n"); |
| #print RTF "\\sect}\n\n\n"; |
| if ($sec_level < 1) { |
| warn "Figures in the previous section: $cap_n_images. Total figures thus far: $n_images.\n"; |
| $cap_n_images = 0; |
| } |
| } elsif ($new_sec_level > $sec_level) { |
| warn "Section level can only ever increase by one ($i:$pd[$i]) ($sec_level $new_sec_level)" if $sec_level != ($new_sec_level-1); |
| $sec_level = $new_sec_level; |
| $n_sec[$sec_level] = 0; |
| } else { # section level decreases (by arbitrary amount) |
| if ($sec_level < 1) { |
| warn "Figures in the previous section: $cap_n_images. Total figures thus far: $n_images.\n"; |
| $cap_n_images = 0; |
| } |
| for ($j = $sec_level; $j >= $new_sec_level; --$j) { |
| print DBX ((' 'x$j) . "</section><!--$sec_id[$sec_level]-->\n\n\n"); |
| #print RTF "\\sect}\n\n\n"; |
| } |
| $sec_level = $new_sec_level; |
| } |
| |
| ++$n_sec[$sec_level]; |
| $sec_id[$sec_level] = $given_id || $_; |
| $sec_id[$sec_level] =~ s/[^A-Za-z0-9]//gs; |
| $sec_id = join '-', @sec_id[0..$sec_level]; |
| $nn = ''; |
| for ($j = 1; $j <= $sec_level; ++$j) { |
| $nn .= $n_sec[$j] . '.'; |
| } |
| chop $nn; |
| |
| $link = $sec_id; |
| ##$link = $nn; |
| ##$link =~ s/[^\w.-]//gs; |
| ##$link =~ s/[.]/-/gs; |
| #$link = fold_label($_); # fjon |
| |
| $sec_no = $pdflag{'secnum'} ? $nn.' ' : ''; |
| $sec_no_dbx = $sec_no if $number; |
| #while ($sec_id_used{$sec_id}) { $sec_id++; } $sec_id_used{$sec_id} = 1; |
| $x = dbx_format($_); |
| print DBX ( (' 'x$sec_level) . qq(<section id="$sec_id">\n<title>$sec_no_dbx$x</title>\n)); |
| |
| print NONL "$_\n\n"; |
| print PDSEAL "$sec_no$_\n\n"; |
| |
| $x = rtf_format($_); |
| #print RTF "{\\sectd \\tc\\tcf67\\tcl$sec_level \\ds$sec_level {\\s$sec_level $sec_no$x}\n"; |
| my $rtf_style = $rtf_styles{'s'.$sec_level}; |
| warn "----> sec_level=$sec_level style($rtf_style)" if $trace; |
| print RTF "{\\pard $rtf_style \\s$sec_level $sec_no$x\\par}\n"; |
| |
| $x = html_format($_); |
| print HTML ((' 'x$sec_level) . qq(<a id="$link"></a><h$sec_level>$sec_no$x</h$sec_level>\n)); |
| push @html_toc_title, $sec_level < 2 ? "<b>$sec_no$x</b>" : "$sec_no$x"; |
| push @html_toc_link, $link; |
| |
| if ($sec_level < $html2_split_threshold && $html2) { |
| $prevprev = $prev2; |
| $prev2 = $html2; |
| ($nn_dash = $nn) =~ s/[.]/-/gs; |
| $html2 = "$base-$nn_dash$sec_id.html"; |
| #$html2 = $nn.$x; |
| #$html2 =~ s/[^\w.-]//gs; |
| #$html2 =~ s/[.]/-/gs; |
| #$html2 = "$base-$html2.html"; |
| |
| if (!$nohtmlpreamb) { |
| my $amb = $htmlpostamble2; |
| $amb =~ s/!\?!TITLE/$doctitle: $sec_no$x/gs; |
| $amb =~ s/!\?!BASE/$base/gs; |
| $amb =~ s/!\?!PREV/$prevprev/gs; |
| $amb =~ s/!\?!NEXT/$html2/gs; |
| print HTML2 $amb; |
| } |
| close HTML2; |
| open HTML2, ">$htmldir$html2" or die "Can't open $htmldir$html2 for writing new HTML segment: $!"; |
| warn "Writing $htmldir$html2"; |
| if (!$nohtmlpreamb) { |
| my $amb = $htmlpreamble2; |
| $amb =~ s/!\?!TITLE/$doctitle: $sec_no$x/gs; |
| $amb =~ s/!\?!BASE/$base/gs; |
| $amb =~ s/!\?!PREV/$prev/gs; |
| $amb =~ s/!\?!NEXT/top-next-not-impl/gs; |
| print HTML2 $amb; |
| #warn "amb($amb) base($base)\n\n"; |
| } |
| } |
| $reflist{$link} = $nn; # Remember caption for later use |
| $refhtmlpage{$link} = $html2; |
| |
| print HTML2 ( (' 'x$sec_level) . qq(<a id="$link"></a><h$sec_level>$sec_no$x</h$sec_level>\n) ); |
| push @html2_toc_link, qq($html2\#$link); # if $sec_level < $html2_split_threshold; # fjon |
| |
| warn "--- SEC $nn $x\n"; |
| $x = tex_format($_); |
| #s/_/\\_/g; # Avoid TeX math mode: Missing $ inserted |
| print TEX $new_slide . '\\' . $tex_sec[$sec_level] . $short_title . "{$x}\\label{$sec_id}\n"; |
| print TEX "\\message{=== SEC $nn}\n"; # Progress reports in LaTeX source |
| $i += 2; |
| } |
| } |
| |
| $indent = 0; # current indent level |
| $list_level = 0; # Hierarchical level of current list |
| @list_indent = (0); # Indendation level of different lists |
| @list_type = (0); # 1 = numeric, a = alpha, * = bullet, : = definition, etc. |
| |
| sub body { |
| my ($ind, $first) = @_; |
| my ($itemstart, $bullet, $item, $la, @para); |
| my $ind_len = length($ind); |
| push @para, $first if $first; |
| while ($i <= $#pd) { |
| warn "BODY $i($pd[$i])" if $trace>1; |
| if ($pd[$i] =~ /^\s*$/) { # empty line --> close current paragraph |
| @para = para(@para); |
| ++$i; |
| warn "para done" if $trace>1; |
| next; |
| } |
| if (substr($pd[$i],0,$ind_len) ne $ind) { # lesser indent terminates current constuct |
| warn "$i: lesser indent >$ind< ind_len=$indlen list_level=$list_level" if $trace; |
| last; |
| } |
| if ($pd[$i]=~/^<<(sub)*sec:.*?>>/) { # section |
| warn "$i: section detected list_level=$list_level" if $trace; |
| last; |
| } |
| $la = $pd[$i+1]; |
| if ((length($pd[$i]) >= 4) && $la =~ /^[=~^-]{4,}$/) { # section |
| warn "Section underline wrong length\n$pd[$i]\n$la" if length($pd[$i]) != length($la); |
| warn "$i: section detected list_level=$list_level" if $trace; |
| last; |
| } |
| |
| $_ = $z = substr($pd[$i], $ind_len); # remove indent for rest of processing |
| ($itemstart, $item) = ($z =~ /^(\d+\.\s+)(.*)$/sx); # *** Debug |
| 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; |
| |
| if ((($itemstart, $bullet, $item) = /^(([*+-])\s+)(.*)$/) |
| && ($list_level || $pd[$i - 1] =~ /^\s*$/)) { # Start bulleted list |
| @para = para(@para); |
| $list_type[++$list_level] = $bullet; |
| $list_indent[$list_level] = $ind_len + length($itemstart); |
| warn "$i: bullet setting list_indent[$list_level] ind($ind) m1($itemstart) pd[i-1]($pd[$i-1])" if $trace; |
| list($ind_len + length($itemstart), $itemstart, $item); |
| warn "$i: bulleted list done" if $trace; |
| next; |
| } elsif ((($itemstart, $item) = /^(\d+\.\s+)(.*)$/s) |
| && ($list_level || $pd[$i - 1] =~ /^\s*$/)) { # Start ordered list |
| @para = para(@para); |
| $list_type[++$list_level] = '1'; |
| $n_list[$list_level] = 1; |
| warn "$i: ord setting list_indent[$list_level] ind($ind) m1=>$itemstart< pd[i-1]($pd[$i-1])" if $trace; |
| $list_indent[$list_level] = $ind_len + length($itemstart); |
| list($ind_len + length($itemstart), $itemstart, $item); |
| warn "$i: ord list done list_level=$list_level" if $trace; |
| next; |
| } elsif ((($itemstart, $item) = /^([a-hj-z][.\)]\s+)(.*)$/) |
| && ($list_level || $pd[$i - 1] =~ /^\s*$/)) { # Start lower alpha list |
| @para = para(@para); |
| $list_type[++$list_level] = 'a'; |
| $n_list[$list_level] = 'a'; |
| warn "$i: lower alpha setting list_indent[$list_level] ind=$ind m1=>$itemstart<" if $trace; |
| $list_indent[$list_level] = $ind_len + length($itemstart); |
| list($ind_len + length($itemstart), $itemstart, $item); |
| warn "$i: lower alpha list done list_level=$list_level" if $trace; |
| next; |
| } elsif ((($itemstart, $item) = /^([A-HJ-Z]\.\s+)(.*)$/) |
| && ($list_level || $pd[$i - 1] =~ /^\s*$/)) { # Start upper alpha list |
| @para = para(@para); |
| $list_type[++$list_level] = 'A'; |
| $n_list[$list_level] = 'A'; |
| $list_indent[$list_level] = $ind_len + length($itemstart); |
| list($ind_len + length($itemstart), $itemstart, $item); |
| warn "$i: upper alpha list done list_level=$list_level" if $trace; |
| next; |
| } elsif ((($itemstart, $item) = /^(i[.\)]\s+)(.*)$/) |
| && ($list_level || $pd[$i - 1] =~ /^\s*$/)) { # Start lower roman list |
| @para = para(@para); |
| $list_type[++$list_level] = 'i'; |
| $n_list[$list_level] = 'i'; |
| warn "$i: lower roman setting list_indent[$list_level] ind=$ind m1=>$itemstart<" if $trace; |
| $list_indent[$list_level] = $ind_len + length($itemstart); |
| list($ind_len + length($itemstart), $itemstart, $item); |
| warn "$i: lower roman list done list_level=$list_level" if $trace; |
| next; |
| } elsif ((($itemstart, $item) = /^(I\.\s+)(.*)$/) |
| && ($list_level || $pd[$i - 1] =~ /^\s*$/)) { # Start upper alpha list |
| @para = para(@para); |
| $list_type[++$list_level] = 'I'; |
| $n_list[$list_level] = 'I'; |
| $list_indent[$list_level] = $ind_len + length($itemstart); |
| list($ind_len + length($itemstart), $itemstart, $item); |
| warn "$i: upper Roman list done list_level=$list_level" if $trace; |
| next; |
| } elsif ((($itemstart, $bullet, $item) = /^(([^\n]+?)::\s+)(.*)$/) |
| && ($list_level || $pd[$i - 1] =~ /^\s*$/)) { # Start definition list |
| @para = para(@para); |
| $list_type[++$list_level] = ':'; |
| #$list_indent[$list_level] = $ind_len + length($itemstart); |
| $list_indent[$list_level] = $ind_len + 4; |
| varlist($ind_len + 4, $bullet, $item); |
| warn "$i: definition list done list_level=$list_level" if $trace; |
| next; |
| } |
| |
| if (/^> (.*?)$/) { # usenet quoted stuff is block quote |
| @para = para(@para); |
| blockquote($1); |
| next; |
| } |
| |
| if (/^\s+(.*?)$/) { # indented stuff is verbatim |
| @para = para(@para); |
| code($1); |
| next; |
| } |
| |
| if (/^<<texsections:\s+(.*?)>>$/) { |
| @para = para(@para); |
| @tex_sec = split /[,\s]+/, $1; |
| ++$i; |
| next; |
| } |
| if (/^<<pdflags:\s+(.*?)>>$/) { |
| @para = para(@para); |
| for $flag (split /[,\s]+/, $1) { |
| ($flagname, $flagvalue) = split /=/, $flag, 2; |
| $pdflag{$flagname} = $flagvalue; |
| } |
| ++$i; |
| next; |
| } |
| |
| # 1 2 2 3 3 4 4 5 legend |
| if (/^<<gnuplot:\s*(\S.*?)(?:\,(\S*?)(?:,(\S*?)(?:,(\S*?))?)?)?:\s*(.*)$/) { |
| @para = para(@para); |
| print NONL $_; |
| print PDSEAL $_; |
| |
| warn "-----creating temporary gnuplot file $1.gp\n"; |
| open GNUPLOT, ">$1.gp" or die "Can't create temprary file $1.gp: $!"; |
| warn "Writing $1.gp"; |
| print GNUPLOT "# Generated by pd2tex. DO NOT EDIT. CHANGES WILL BE LOST.\n"; |
| print GNUPLOT qq(set output "$1.eps"\n); |
| ++$i; |
| if ($pd[$i] !~ /^>>/) { |
| print GNUPLOT qq(set terminal postscript\n) unless $pd[$i] =~ /set\s+terminal/; |
| print GNUPLOT qq(set encoding iso_8859_1\n) unless $pd[$i] =~ /set\s+encoding/; |
| print GNUPLOT $pd[$i]."\n"; |
| for (++$i; $pd[$i] !~ /^>>/; ++$i) { |
| print GNUPLOT $pd[$i]."\n"; |
| } |
| } |
| close GNUPLOT; |
| image($1, $5, $2, $3, $4); |
| ++$i; |
| next; |
| } |
| |
| if (($name, $pos, $siz, $trim, $caption) = |
| # 1 1 2 2 3 3 4 4 5 5 |
| /^<<dot:\s*(\S.*?)(?:\,(\S*?)(?:,(\S*?)(?:,(\S*?))?)?)?:\s*(.*)$/) { |
| @para = para(@para); |
| |
| warn "-----creating temporary dot file $name.dot\n"; |
| open DOT, ">$name.dot" or die "Can't create temprary file $name.dot: $!"; |
| warn "Writing $name.dot"; |
| warn `pwd`; |
| print DOT "// Generated by pd2tex. DO NOT EDIT. CHANGES WILL BE LOST.\n"; |
| for (++$i; $pd[$i] =~ /^\s*\/\//; ++$i) { # comments |
| print DOT $pd[$i]."\n"; |
| } |
| #warn "DOT name($name) $i: $pd[$i]"; |
| if ($pd[$i] !~ /graph\s+\w+\s*\{/) { # not explicitly specified |
| ($name2 = $name) =~ s/[^a-z0-9]/_/gi; |
| print DOT "digraph $name2 {\n"; |
| $need_close_curly = 1; |
| } else { |
| $need_close_curly = 0; |
| } |
| for (; $pd[$i] !~ /^>>/; ++$i) { |
| print DOT $pd[$i]."\n"; |
| } |
| print DOT "}\n" if $need_close_curly; |
| close DOT; |
| image($name, $caption, $pos, $siz, $trim); |
| ++$i; |
| next; |
| } |
| |
| if (/<<epspdf:\s*(\S+)>>/) { # trigger image generation without rendering image in output |
| @para = para(@para); |
| gen_img($1, "$i epspdf: $pd[$i]"); |
| ++$i; |
| next; |
| } |
| |
| # path pos siz trim caption? |
| # 1 1 ,2 2 ,3 3 ,4 4 5: 6 65 |
| if (/^<<img:\s*(\S.*?)(?:\,(\S*?)(?:,(\S*?)(?:,(\S*?))?)?)?(:\s*(.*?))?>>/i) { |
| @para = para(@para); |
| #warn "IMG IMG IMG [$1/$2/$3/$4/$6]"; |
| print NONL $_; |
| print PDSEAL $_; |
| image($1, $6, $2, $3, $4); |
| ++$i; |
| next; |
| } |
| |
| # path pos siz trim layers caption |
| # 1 1 ,2 2 ,3 3 ,4 4 :5 56: 7 7 |
| if (/^<<dia:\s*(\S.*?)(?:\,(\S*?)(?:,(\S*?)(?:,(\S*?))?)?)?:([a-z0-9_,-]+)(:\s*(.*?))?>>/i) { |
| @para = para(@para); |
| print NONL $_; |
| print PDSEAL $_; |
| #warn "DIA DIA DIA [$1/$2/$3/$4/$5/$7]"; |
| image($1, $7, $2, $3, $4, $5); |
| ++$i; |
| next; |
| } |
| |
| # 1 1 2 2 3 3 |
| if (($ref, $posspec, $legend) = /^<<doubleimg:\s*(\S.*?)(?:\,(\S*?))?:\s*(.*)$/) { |
| my ($path1, $legend1, $path2, $legend2); |
| @para = para(@para); |
| print NONL $_; |
| print PDSEAL $_; |
| |
| ++$i; |
| if (($path1, $legend1) = ($pd[$i] =~ /^([^:>]+):\s*(.*)$/)) { |
| ++$i; |
| if (($path2, $legend2) = ($pd[$i] =~ /^([^:>]+):\s*(.*)$/)) { |
| ++$i; |
| } |
| } |
| for (; $pd[$i] !~ /^>>/; ++$i) { |
| warn "doubleimg: skipping excess input($pd[$i])"; |
| } |
| #warn "doubleimage($path1,$legend1,$path2,$legend2)"; |
| doubleimage($ref, $legend, $posspec, $path1, undef, $legend1, $path2, undef, $legend2); |
| ++$i; |
| next; |
| } |
| |
| # 1 1 2 2 3 3 |
| if (($ref, $posspec, $legend) = /^<<doubledia:\s*(\S.*?)(?:\,(\S*?))?:\s*(.*)$/) { |
| my ($path1, $legend1, $path2, $legend2); |
| @para = para(@para); |
| print NONL $_; |
| print PDSEAL $_; |
| |
| ++$i; |
| if (($path1, $layers1, $legend1) = ($pd[$i] =~ /^([^:>]+):([a-z0-9_,-]+):\s*(.*)$/i)) { |
| ++$i; |
| if (($path2, $layers2, $legend2) = ($pd[$i] =~ /^([^:>]+):([a-z0-9_,-]+):\s*(.*)$/i)) { |
| ++$i; |
| } |
| } |
| for (; $pd[$i] !~ /^>>/; ++$i) { |
| warn "doubledia: skipping excess input($pd[$i])"; |
| } |
| #warn "doubleimage($path1,$legend1,$path2,$legend2)"; |
| doubleimage($ref, $legend, $posspec, $path1, $layers1, $legend1, $path2, $layers2, $legend2); |
| ++$i; |
| next; |
| } |
| |
| # <<table: Legenda\n ...>> |
| # 123 4 5 2 1 6 7 76 |
| if (/^<<(((long)|(mini)|(raw))?table):(\s*([A-Za-z0-9\xa0-\xff].*))?$/) { |
| @para = para(@para); |
| table($7,$1); |
| next; |
| } |
| |
| #<<csv: file1,topleft2,botright3,options4: Legenda6>> |
| # 1 1 ,2 2 ,3 3 ,4 4 5: 6 65 |
| if (/^<<csv:\s*(\S.*?)(?:\,(\S*?)(?:,(\S*?)(?:,(\S*?))?)?)?(:\s*(.*?))?>>/i) { |
| @para = para(@para); |
| #warn "CSV [$1/$2/$3/$4/$6]"; |
| csv($1, $6, $2, $3, $4); |
| ++$i; |
| next; |
| } |
| |
| if (/^<<references(:\d)?:( (\w.*?))?\s*$/) { |
| @para = para(@para); |
| warn "Found references"; |
| references($3, $1); |
| next; |
| } |
| |
| # 1 1 2 3 32 |
| if (/^<<xmlfmt:([^:]*):(\s*([A-Za-z0-9\xa0-\xff].*))?$/) { |
| @para = para(@para); |
| xmlfmt($3,$1); |
| next; |
| } |
| |
| # 1file_1 2sec__2 3xsd__3 4Cap4 |
| if (/^<<sgfrag:([^:]*):([^:]*):([^:]*):\s*(.+?)\s*>>/) { |
| @para = para(@para); |
| sgfrag($1, $2, $3, $4); |
| ++$i; |
| next; |
| } |
| |
| # 12 2 1 3 4 43 |
| if (/^<<schema:((\S*):)?( (\w.*))?$/) { # XML schema verbatim listing |
| @para = para(@para); |
| print DBX qq(<programlisting format="schema"><computeroutput><!\[CDATA\[); |
| print RTF qq({\\f2); |
| print HTML qq(<pre>); |
| print HTML2 qq(<pre>); |
| print TEX qq(\\begin{verbatim}); |
| unindented_code($2, $4); # filespec, first |
| print TEX qq(\\end{verbatim}\n); |
| print DBX qq(\]\]></computeroutput></programlisting>); |
| print RTF qq(}); |
| print HTML "</pre>"; |
| print HTML2 "</pre>"; |
| ++$i; |
| next; |
| } |
| |
| # 12 2 1 3 4 43 |
| if (/^<<code:((\S*):)?( (\w.*))?$/) { # code verbatim listing |
| @para = para(@para); |
| print DBX qq(<programlisting format="code"><computeroutput><!\[CDATA\[); |
| print RTF qq({\\f2); |
| print HTML qq(<pre>); |
| print HTML2 qq(<pre>); |
| |
| #print TEX qq(\\begin{Verbatim}[fontsize=\\small]); |
| #unindented_code($2,$4); |
| #print TEX qq(\\end{Verbatim}\n); |
| |
| print TEX qq(\\begin{lstlisting}); |
| unindented_code($2, $4); |
| print TEX qq(\\end{lstlisting}\n); |
| |
| print DBX qq(\]\]></computeroutput></programlisting>); |
| print RTF qq(}); |
| print HTML "</pre>"; |
| print HTML2 "</pre>"; |
| ++$i; |
| next; |
| } |
| |
| # 12 2 1 3 4 43 |
| if (/^<<ccode:((\S*):)?( (\w.*))?$/) { # C-style code verbatim listing |
| @para = para(@para); |
| print DBX qq(<programlisting format="code"><computeroutput><!\[CDATA\[); |
| print RTF qq({\\f2); |
| print HTML qq(<pre>); |
| print HTML2 qq(<pre>); |
| |
| print TEX qq(\\begin{lstlisting}); |
| unindented_code($2, $4); |
| print TEX qq(\\end{lstlisting}\n); |
| |
| print DBX qq(\]\]></computeroutput></programlisting>); |
| print RTF qq(}); |
| print HTML "</pre>"; |
| print HTML2 "</pre>"; |
| ++$i; |
| next; |
| } |
| |
| # 12 2 1 3 4 43 |
| if (/^<<console:((\S*):)?( (\w.*))?$/) { # console output verbatim listing |
| @para = para(@para); |
| print DBX qq(<programlisting format="code"><computeroutput><!\[CDATA\[); |
| print RTF qq({\\f2); |
| print HTML qq(<pre>); |
| print HTML2 qq(<pre>); |
| |
| print TEX qq(\\begin{lstlisting}); |
| unindented_code($2, $4); |
| print TEX qq(\\end{lstlisting}\n); |
| |
| print DBX qq(\]\]></computeroutput></programlisting>); |
| print RTF qq(}); |
| print HTML "</pre>"; |
| print HTML2 "</pre>"; |
| ++$i; |
| next; |
| } |
| |
| # 12 2 1 3 4 43 |
| if (/^<<diffout:((\S*):)?( (\w.*))?$/) { # diff outoput verbatim listing |
| @para = para(@para); |
| print DBX qq(<programlisting format="code"><computeroutput><!\[CDATA\[); |
| print RTF qq({\\f2); |
| print HTML qq(<pre>); |
| print HTML2 qq(<pre>); |
| |
| print TEX qq(\\begin{lstlisting}); |
| unindented_code($2, $4); |
| print TEX qq(\\end{lstlisting}\n); |
| |
| print DBX qq(\]\]></computeroutput></programlisting>); |
| print RTF qq(}); |
| print HTML "</pre>"; |
| print HTML2 "</pre>"; |
| ++$i; |
| next; |
| } |
| |
| # 12 2 1 3 4 43 |
| if (/^<<email:((\S*):)?( (\w.*))?$/) { # email, bug tracker, or wiki post verbatim |
| @para = para(@para); |
| print DBX qq(<programlisting format="code"><computeroutput><!\[CDATA\[); |
| print RTF qq({\\f2); |
| print HTML qq(<pre>); |
| print HTML2 qq(<pre>); |
| |
| print TEX qq(\\begin{verbatim}); |
| unindented_code($2, $4); |
| print TEX qq(\\end{verbatim}\n); |
| |
| print DBX qq(\]\]></computeroutput></programlisting>); |
| print RTF qq(}); |
| print HTML "</pre>"; |
| print HTML2 "</pre>"; |
| ++$i; |
| next; |
| } |
| |
| # 12 2 1 3 4 43 |
| if (/^<<logoutput:((\S*):)?( (\w.*))?$/) { # logoutput verbatim listing |
| @para = para(@para); |
| print DBX qq(<programlisting format="logoutput"><computeroutput><!\[CDATA\[); |
| print RTF qq({\\f2); |
| print HTML qq(<pre>); |
| print HTML2 qq(<pre>); |
| print TEX qq(\\begin{verbatim}); |
| unindented_code($2, $4); |
| print TEX qq(\\end{verbatim}\n); |
| print DBX qq(\]\]></computeroutput></programlisting>); |
| print RTF qq(}); |
| print HTML "</pre>"; |
| print HTML2 "</pre>"; |
| ++$i; |
| next; |
| } |
| |
| if (/^<<newpage:.*?>>\s*$/) { |
| @para = para(@para); |
| if ($class eq 'slide') { |
| print DBX "\n<!--newpage-->\n"; |
| print NONL "\n\n"; |
| print PDSEAL "\n\n"; |
| print RTF "\n\\page\n"; |
| #print HTML "\n<hr><!--newpage-->\n"; |
| #print HTML2 "\n<hr><!--newpage-->\n"; |
| print HTML "\n<!--newpage-->\n"; |
| print HTML2 "\n<!--newpage-->\n"; |
| print TEX "\n\\end{slide}\n\n\\begin{slide}\n"; |
| } else { |
| print DBX "\n<!--newpage-->\n"; |
| print NONL "\n\n"; |
| print PDSEAL "\n\n"; |
| print RTF "\n\\page\n"; |
| #print HTML "\n<hr><!--newpage-->\n"; |
| #print HTML2 "\n<hr><!--newpage-->\n"; |
| print HTML "\n<!--newpage-->\n"; |
| print HTML2 "\n<!--newpage-->\n"; |
| print TEX "\n\\clearpage\n"; |
| } |
| warn "newpage done" if $trace; |
| ++$i; |
| next; |
| } |
| |
| if (/^<<closesec:.*?>>\s*$/) { |
| @para = para(@para); |
| close_dbx_sections(); |
| warn "closesec done" if $trace; |
| ++$i; |
| next; |
| } |
| |
| if (/<<eqn:(.*?):(.*?)>>/) { # direct TeX code for an equation (fjon) |
| @para = para(@para); |
| plot_eqn($1, $2, ++$eq_nr); |
| ++$i; |
| warn "eqn done" if $trace; |
| next; |
| } |
| if (/<<eqn:(.*?)>>/) { # direct TeX code for an equation |
| @para = para(@para); |
| ++$eq_nr; |
| plot_eqn($1, $eq_nr, $eq_nr); |
| #print TEX "\\begin{equation}$1\\end{equation}" if $1; |
| ++$i; |
| warn "eqn done" if $trace; |
| next; |
| } |
| if (/^<<eqn:( (.*?))?$/) { # direct TeX code for an equation |
| @para = para(@para); |
| ++$eq_nr; |
| print TEX "\\begin{equation}"; |
| print TEX $2 if $2; |
| for (++$i; $pd[$i] !~ /^>>/; ++$i) { |
| print TEX $pd[$i]."\n"; |
| } |
| print TEX "\\end{equation}"; |
| ++$i; |
| warn "eqn done" if $trace; |
| next; |
| } |
| |
| if (/<<comment:(.*?)>>/) { # Backend comment pass-thru |
| @para = para(@para); |
| #warn "=========== comment one($1)"; |
| print TEX "% $1\n"; |
| print NONL "# $1\n"; |
| #print PDSEAL ""; |
| print RTF "<!-- $1 -->\n"; |
| print DBX "<!-- $1 -->\n"; |
| print HTML "<!-- $1 -->\n"; |
| print HTML2 "<!-- $1 -->\n"; |
| ++$i; |
| warn "comment done" if $trace; |
| next; |
| } |
| if (/^<<comment:(.*?)$/) { # Backend comment pass-thru |
| warn "comment start i=$i ($pd[$i])" if $trace; |
| @para = para(@para); |
| #warn "=========== comment two($2)"; |
| print TEX "% $1\n"; |
| print NONL "# $1\n"; |
| #print PDSEAL ""; |
| print RTF "<!-- $1\n"; |
| print DBX "<!-- $1\n"; |
| print HTML "<!-- $1\n"; |
| print HTML2 "<!-- $1\n"; |
| for (++$i; $pd[$i] !~ /^>>/; ++$i) { |
| #warn "=========== comment two bis($pd[$i])"; |
| print TEX "% $pd[$i]\n"; |
| print NONL "# $pd[$i]\n"; |
| #print PDSEAL ""; |
| print RTF $pd[$i]."\n"; |
| print DBX $pd[$i]."\n"; |
| print HTML $pd[$i]."\n"; |
| print HTML2 $pd[$i]."\n"; |
| } |
| if ($pd[$i] =~ /^>>/) { |
| print RTF "-->\n"; |
| print DBX "-->\n"; |
| print HTML "-->\n"; |
| print HTML2 "-->\n"; |
| } |
| ++$i; |
| warn "comment done i=$i ($pd[$i])" if $trace; |
| next; |
| } |
| |
| # 1 2 3 4 5 6 7 8 |
| # <<feedback:0!7!20081107-2259!idtype!identifier!remote addr!user agent! Title>> body... <<endfeedback: >> |
| # 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 |
| if (/<<feedback:(\w+)!(\w+)!([^!]+)!([^!]*)!([^!]*)!([^!]*)!([^!]*)!\s*(.*?)\s*>>/) { # Blog feedback |
| @para = para(@para); |
| warn "=========== feedback($1,$2,$3,$4,$5,$6,$7,$8)"; |
| if ($1 eq '1') { |
| print TEX "% feedback: $1 $2 $3 $4 $5 $6 $7 $8\n"; |
| print NONL "# feedback: $1 $2 $3 $4 $5 $6 $7 $8\n"; |
| #print PDSEAL ""; |
| print RTF "<!-- feedback: $1 $2 $3 $4 $5 $6 $7 $8 -->\n"; |
| print DBX "<!-- feedback: $1 $2 $3 $4 $5 $6 $7 $8 -->\n"; |
| my $fb_class = ($2 && ($2 & 0x01)) ? 'pdblogfbo' : 'pdblogfb'; |
| my $num = $2 ? "#$2" : ''; |
| my $fb_html = <<HTML; |
| <p> |
| <table class=$fb_class> |
| <tr><th class=$fb_class> |
| <b class=${fb_class}t>$8</b><br class=${fb_class}t><i class=${fb_class}ts>$3, by $5</i> |
| </th><th class=${fb_class}num>$num</th></tr><tr><td class=$fb_class colspan=2> |
| <p class=$fb_class> |
| HTML |
| ; |
| print HTML $fb_html; |
| print HTML2 $fb_html; |
| #print HTML qq(<hr class=pdblogfb><b class=pdblogfbt>$8</b><br class=pdblogfbt><i class=pdblogfbts>$3, by $5</i><p class=pdblogfb>); |
| #print HTML2 qq(<hr class=pdblogfb><b class=pdblogfbt>$8</b><br class=pdblogfbt><i class=pdblogfbts>$3, by $5</i><p class=pdblogfb>); |
| ++$i; |
| warn "tex done" if $trace; |
| } else { |
| for (++$i; $pd[$i] !~ /<<endfeedback:/; ++$i) { |
| #warn "hidden feedback($pd[$i])"; |
| } |
| } |
| next; |
| } |
| if (/<<endfeedback:.*?>>/) { # Close feedback block |
| @para = para(@para); |
| warn "=========== endfeedback"; |
| print HTML "</td></tr></table>\n\n"; |
| print HTML2 "</td></tr></table>\n\n"; |
| ++$i; |
| next; |
| } |
| |
| if (/<<multicolstart:\s*(.*?)>>/) { # Open Multicolumn block |
| @para = para(@para); |
| my $wid = $1 || '70mm'; |
| print TEX "\\parbox[t]{$wid}{"; |
| print NONL "<!-- multicolstart($wid) -->\n"; |
| #print PDSEAL ""; |
| print RTF "<!-- multicolstart($wid) -->\n"; |
| print DBX "<!-- multicolstart($wid) -->\n"; |
| print HTML "<table><tr><td>\n"; |
| print HTML2 "<table><tr><td>\n"; |
| ++$i; |
| warn "mc1 done" if $trace; |
| next; |
| } |
| |
| if (/<<multicolnext:\s*(.*?)(,(.*?))?>>/) { # close prev, start next col |
| @para = para(@para); |
| my $wid = $1 || '70mm'; |
| my $sepwid = $3 || '5mm'; |
| print TEX "}\\rule{$sepwid}{0mm}\\parbox[t]{$wid}{"; |
| print NONL "<!-- multicolnext($wid) -->\n"; |
| #print PDSEAL ""; |
| print RTF "<!-- multicolnext($wid) -->\n"; |
| print DBX "<!-- multicolnext($wid) -->\n"; |
| print HTML "</td><td>\n"; |
| print HTML2 "</td><td>\n"; |
| ++$i; |
| warn "mc1 done" if $trace; |
| next; |
| } |
| |
| if (/<<multicolend:\s*>>/) { # Close Multicolumn block |
| @para = para(@para); |
| print TEX "}\n"; |
| print NONL "<!-- multicolend() -->\n"; |
| #print PDSEAL ""; |
| print RTF "<!-- multicolend() -->\n"; |
| print DBX "<!-- multicolend() -->\n"; |
| print HTML "</td></tr></table>\n\n"; |
| print HTML2 "</td></tr></table>\n\n"; |
| ++$i; |
| warn "mc1 done" if $trace; |
| next; |
| } |
| |
| if (/<<tex:(.*?)>>/) { # direct TeX code |
| @para = para(@para); |
| #warn "=========== tex one($1)"; |
| print TEX $1 if $1; |
| ++$i; |
| warn "tex done" if $trace; |
| next; |
| } |
| if (/^<<tex:(.*?)$/) { # direct TeX code |
| warn "tex start i=$i ($pd[$i])" if $trace; |
| @para = para(@para); |
| #warn "=========== tex two($2)"; |
| print TEX $1 if $1; |
| for (++$i; $pd[$i] !~ /^>>/; ++$i) { |
| #warn "=========== tex two bis($pd[$i])"; |
| print TEX $pd[$i]."\n"; |
| } |
| ++$i; |
| warn "tex done i=$i ($pd[$i])" if $trace; |
| next; |
| } |
| |
| if (/^<<dbx:\s*(.*)$/) { # direct DocBook code |
| @para = para(@para); |
| #warn "Entering dbx($1)"; |
| print DBX $1 if $1; |
| for (++$i; $pd[$i] !~ /^>>/; ++$i) { |
| #warn "dbx i=$i ($pd[$i])"; |
| print DBX $pd[$i]."\n"; |
| } |
| ++$i; |
| warn "dbx done" if $trace; |
| next; |
| } |
| |
| if (/^<<rtf:\s*(.*)$/) { # direct RTF code |
| @para = para(@para); |
| #warn "Entering dbx($1)"; |
| print RTF $1 if $1; |
| for (++$i; $pd[$i] !~ /^>>/; ++$i) { |
| #warn "rtf i=$i ($pd[$i])"; |
| print RTF $pd[$i]."\n"; |
| } |
| ++$i; |
| warn "rtf done" if $trace; |
| next; |
| } |
| |
| if (/^<<odt:\s*(.*)$/) { # direct ODT code |
| @para = para(@para); |
| #warn "Entering dbx($1)"; |
| print ODT $1 if $1; |
| for (++$i; $pd[$i] !~ /^>>/; ++$i) { |
| #warn "rtf i=$i ($pd[$i])"; |
| print ODT $pd[$i]."\n"; |
| } |
| ++$i; |
| warn "odt done" if $trace; |
| next; |
| } |
| |
| if (/^<<html:\s*(.*)$/) { # direct HTML code |
| @para = para(@para); |
| print HTML $2 if $1; |
| print HTML2 $2 if $1; |
| for (++$i; $pd[$i] !~ /^>>/; ++$i) { |
| print HTML $pd[$i]."\n"; |
| print HTML2 $pd[$i]."\n"; |
| } |
| ++$i; |
| warn "html done" if $trace; |
| next; |
| } |
| |
| if (/<<cvssig:(.*?)>>/) { |
| @para = para(@para); |
| open BZ, "|bzip2 -9>cvssig" or die "cvssig tag failed to invoke bzip2: $!"; |
| #print BZ $1; |
| print BZ $cvsid; |
| close BZ; |
| $cvssig = ''; |
| $cvssigraw = readall('cvssig'); |
| $cvssigraw =~ s/(.)(.)(.)/$cvssig.=b64enc($1,$2,$3),''/ges; |
| $cvssigraw =~ s/(.)/sprintf("%02x",ord($1))/ges; # last 0, 1, or 2 bytes |
| $cvssig =~ s/(.{64})/$1\n/g; # line wrap to 64 cols |
| print DBX "$cvssig=$cvssigraw"; |
| print NONL "$cvssig=$cvssigraw"; |
| print PDSEAL "$cvssig=$cvssigraw"; |
| print RTF "$cvssig=$cvssigraw"; |
| print HTML "$cvssig=$cvssigraw"; |
| print HTML2 "$cvssig=$cvssigraw"; |
| print TEX "$cvssig=$cvssigraw"; |
| ++$i; |
| warn "cvssig done" if $trace; |
| next; |
| } |
| |
| if (/<<pdseal:\s*(.*?)>>/) { |
| $salt=$1; |
| @para = para(@para); |
| close PDSEAL; |
| $pdseal = readall("$texdir$base.seal"); |
| $pdseal = pdseal1($pdseal); |
| writeall("$texdir$base.norm", $pdseal_norm); |
| print DBX $pdseal; |
| print NONL $pdseal; |
| print RTF $pdseal; |
| print HTML $pdseal; |
| print HTML2 $pdseal; |
| print TEX $pdseal; |
| ++$i; |
| warn "pdseal done" if $trace; |
| next; |
| } |
| |
| ### Special segments for EDDA. Added by Fredrik Jonsson |
| |
| # 1 1 2 3 32 |
| if (/^<<desvar:\s*([\w.\/]*)\s*(:(.*))?>>/) { |
| desvar($1,$3); |
| ++$i; |
| next; |
| } |
| if (/^<<plot:/) { |
| plot_waves(); |
| next; |
| } |
| if (/^<<data:/) { |
| print_data(); |
| next; |
| } |
| if (/^<<sch:/) { |
| plot_schematics(); |
| next; |
| } |
| |
| if (/^<<logfile:\s*([\w.\/]*)\s*(:(.*))?>>/) { |
| print DBX qq(<programlisting format="schema"><computeroutput><!\[CDATA\[); |
| print HTML qq(<pre>); |
| print HTML2 qq(<pre>); |
| print TEX qq(\\begin{Verbatim}[fontsize=\\small]\n); |
| #print TEX qq(\\begin{verbatim}\n); |
| |
| if(-r $1){ |
| $/ = "\n"; # Disable "slurp" mode |
| open(LOGFILE,$1); |
| while(<LOGFILE>){ |
| print DBX dbx_entity_escape_lite($_); |
| my $x = $_; |
| while(length($x) > $maxlogline){ |
| my $xx = substr($x,0,$maxlogline); |
| print TEX tex_esc_verbatim($xx)."\n"; |
| print HTML $xx."\n"; |
| print HTML2 $xx."\n"; |
| $x = substr($x, $maxlogline, length($x)); |
| } |
| print TEX tex_esc_verbatim($x); |
| print HTML $x; |
| print HTML2 $x; |
| } |
| close(LOGFILE); |
| undef $/; # Enable "slurp" mode again |
| } else { |
| warn("Unable to open $1"); |
| print HTML "Missing file $1\n"; |
| print HTML2 "Missing file $1\n"; |
| print TEX "Missing file $1\n"; |
| } |
| |
| print DBX qq(\]\]></computeroutput></programlisting>); |
| print HTML "</pre>"; |
| print HTML2 "</pre>"; |
| print TEX qq(\n\\end{Verbatim}\n); |
| #print TEX qq(\\end{verbatim}\n); |
| ++$i; |
| next; |
| } |
| |
| if (($name) = /^<<ect:\s*(.*)?/) { |
| @para = para(@para); |
| $name = $base if !$name; |
| open ECT, ">.pd/pd.lim" or die "Can't create temprary file .pd/pd.lim: $!"; |
| warn "Writing .pd/pd.lim"; |
| ++$i; |
| for (; $pd[$i] !~ /^>>/; ++$i) { |
| print ECT $pd[$i]."\n"; |
| } |
| close ECT; |
| system_cmd('pd_data'); # What command? Where? --Sampo |
| |
| my $ref = fold_label($name); |
| |
| if(-e ".pd/ectable.html"){ |
| my $x = readall('.pd/ectable.html'); |
| ++$table_no; |
| print HTML "<p><a id=\"$ref\"></a>Table $table_no:$name</p><br>"; |
| print HTML2 "<p><a id=\"$ref\"></a>Table $table_no:$name</p><br>"; |
| $reflist{$ref} = $table_no; |
| $refhtmlpage{$ref} = $html2; |
| } |
| if(-e ".pd/ectable.tex"){ |
| my $x = readall('.pd/ectable.tex'); |
| #print TEX "\\begin{landscape}\n"; |
| #print TEX "\\ref{$ref}\n"; |
| $x =~ s/!!REFERENCE/$ref/gse; |
| print TEX $x; |
| #print TEX "\\end{landscape}\n"; |
| } |
| |
| ++$i; |
| #++$sec_float_obj; |
| next; |
| } |
| # end EDDA |
| |
| if (/^<<EOF: .*?>>/) { |
| $i = $#pd + 1; |
| last; |
| } |
| |
| warn "push to para" if $trace>1; |
| push @para, "$_\n"; |
| ++$i; |
| } |
| warn "$i: end of body list_level=$list_level" if $trace; |
| para(@para); |
| return; |
| } |
| |
| ### Base64 encoder so we avoid dependency on MIME::Base64 module. |
| |
| sub b64enc { |
| my ($b1, $b2, $b3) = @_; |
| #warn "b1($b1) b2($b2) b3($b3)"; |
| my $x1 = (ord($b1) >> 2) & 0x3f; |
| my $x2 = (ord($b1) & 3) | ((ord($b2) >> 2) & 0x3c); |
| my $x3 = (ord($b2) & 0xf) | ((ord($b3) >> 2) & 0x30); |
| my $x4 = ord($b3) & 0x3f; |
| #warn "x1($x1) x2($x2) x3($x3) x4($x4)"; |
| my $b64str = '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-.'; # safish b64 |
| return substr($b64str,$x1,1).substr($b64str,$x2,1).substr($b64str,$x3,1).substr($b64str,$x4,1); |
| } |
| |
| sub pdseal_normalize { |
| my ($x) = @_; |
| #warn "INPUT for pdseal_normalize($x)"; |
| $x =~ s/[ \t]+/ /g; |
| $x =~ s/\r\n/\n/g; |
| $x =~ s/\r/\n/g; |
| $x =~ s/\n +/\n/g; |
| $x =~ s/ +\n/\n/g; |
| $x =~ s/\n{2,}/\n\n/g; |
| $x =~ s/([^\n])\n([^\n])/$1 $2/sg; # Single newlines are insignificant |
| $x =~ s/ +/ /g; |
| $x =~ s/^[ \n]+//s; # zap initial whitespace |
| $x =~ s/[ \n]+$/\n/s; # normalize to end in single newline |
| #warn "OUTPUT for pdseal_normalize($x)"; |
| return $x; |
| } |
| |
| sub pdseal1 { |
| my ($x) = @_; |
| $pdseal_norm = $x = pdseal_normalize($x); |
| require Digest::SHA1; |
| $x = Digest::SHA1::sha1($x); |
| $x .= '1'; # Make it 21 bytes so it will give 28 base64 chars with no padding |
| $x =~ s/(.)(.)(.)/b64enc($1,$2,$3)/ges; |
| return "PDSEAL1$x"; |
| } |
| |
| ### Process a definition list. The list has just been detected in body. Now we |
| ### need to proceed to next level of indent. |
| |
| sub varlist { |
| my ($ind_len, $prefix, $first) = @_; |
| print DBX ((' 'x$list_level) . $dbx_list_open{$list_type[$list_level]}); |
| #print RTF ((' 'x$list_level) . $rtf_list_open{$list_type[$list_level]}); |
| print HTML ((' 'x$list_level) . $html_list_open{$list_type[$list_level]}); |
| print HTML2 ((' 'x$list_level) . $html_list_open{$list_type[$list_level]}); |
| print TEX ((' 'x$list_level) . $tex_list_open{$list_type[$list_level]}); |
| while (1) { |
| warn "$i: start varlist $ind_len ($prefix) --[$first]-- list_level=$list_level" if $trace; |
| my $dbx_prefix = dbx_format($prefix); |
| print DBX ((' 'x$list_level) . qq(<varlistentry><term>$dbx_prefix</term><listitem>\n)); |
| print NONL "$prefix: "; |
| print PDSEAL "$prefix "; |
| my $rtf_prefix = rtf_format($prefix); |
| my $rtf_style = $rtf_styles{'s3'.$list_level}; |
| print RTF "{$rtf_style \\s3$list_level \\b\n$rtf_prefix\\par}\\fi0\n"; |
| my $html_prefix = html_format($prefix); # allow formatting in list item title |
| print HTML "<dt>$html_prefix<dd>"; |
| print HTML2 "<dt>$html_prefix<dd>"; |
| my $tex_prefix = tex_format($prefix); # allow formatting in list item title |
| #$prefix = tex_esc($prefix); |
| print TEX "\\item[$tex_prefix] "; |
| ++$i; |
| |
| body(' 'x$ind_len, $first); # Process paragraphs for this list item (the definition) |
| warn "$i: back from body --[$first]-- list_level=$list_level" if $trace; |
| print DBX ((' 'x$list_level) . "</listitem></varlistentry>\n"); |
| |
| $la = $pd[$i+1]; |
| if ((length($pd[$i]) == length($la)) && $la =~ /^[=~^-]{3,}$/) { # section |
| warn "$i: section detected list_level=$list_level" if $trace; |
| last; |
| } |
| |
| ### Can either be list item at same level or list item continuation at any |
| ### previous level (i.e. new paragraph) or new item at any previous level |
| |
| $_ = $pd[$i]; |
| ($indent) = /^(\s*)/; |
| $indent = length($indent); |
| warn "***** indent=$indent prev_indent=".$list_indent[$list_level-1]." level=$list_level" if $trace; |
| if ($indent == $list_indent[$list_level-1]) { |
| my $typ = $list_type[$list_level]; |
| warn "checking for another item at same level typ($typ) --[$_]--" if $trace; |
| if (($typ eq ':') && /^(\s*(([^\n]+?)::\s+))(.*)$/) { |
| $prefix = $3; |
| $first = $4; |
| warn "$i: another item list_level=$list_level --[$first]--" if $trace; |
| next; |
| } |
| warn "$i: same level didn't match --[$pd[$i]]--" if $trace; |
| } |
| last; # Was not an item of the same list |
| } |
| print DBX ((' 'x$list_level) . $dbx_list_close{$list_type[$list_level]}); |
| #print RTF ((' 'x$list_level) . $rtf_list_close{$list_type[$list_level]}); |
| print HTML ((' 'x$list_level) . $html_list_close{$list_type[$list_level]}); |
| print HTML2 ((' 'x$list_level) . $html_list_close{$list_type[$list_level]}); |
| print TEX ((' 'x$list_level) . $tex_list_close{$list_type[$list_level]}); |
| --$list_level; |
| warn "$i: list closed list_level=$list_level" if $trace; |
| } |
| |
| ### Process a list. The list has just been detected in body. Now we need to proceed |
| ### to next level of indent. |
| |
| sub list { |
| my ($ind_len, $prefix, $first) = @_; |
| print DBX ((' 'x$list_level) . $dbx_list_open{$list_type[$list_level]}); |
| #print RTF ((' 'x$list_level) . $rtf_list_open{$list_type[$list_level]}); |
| print HTML ((' 'x$list_level) . $html_list_open{$list_type[$list_level]}); |
| print HTML2 ((' 'x$list_level) . $html_list_open{$list_type[$list_level]}); |
| print TEX ((' 'x$list_level) . $tex_list_open{$list_type[$list_level]}); |
| while (1) { |
| 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; |
| |
| #$first = "$n_list[$list_level]. $first" if $number && $list_type[$list_level]=~/^[Aa1]$/; |
| print DBX ((' 'x$list_level) . qq(<listitem>\n)); |
| my $rtf_item = $rtf_list_item{$list_type[$list_level]}; |
| $rtf_item =~ s/!!N/$list_level/; |
| $rtf_item =~ s/!!S/$rtf_styles{"s3$list_level"}/; |
| $rtf_item =~ s/!!M/$ord_mark{$list_type[$list_level]}[$n_list[$list_level]]/; |
| #print RTF (("\\tab"x$list_level) . $rtf_item); |
| print RTF $rtf_item; |
| print HTML ((' 'x$list_level) . qq(<li>\n)); |
| print HTML2 ((' 'x$list_level) . qq(<li>\n)); |
| print TEX ((' 'x$list_level) . $tex_list_item{$list_type[$list_level]}); |
| if ($list_type[$list_level] =~ /^[*+-]$/) { |
| print PDSEAL "$list_type[$list_level] "; |
| } else { |
| print PDSEAL $ord_mark{$list_type[$list_level]}[$n_list[$list_level]].". "; |
| } |
| ++$i; |
| body(' 'x$ind_len, $first); # Process paragraphs for this list item |
| warn "$i: back from body --[$first]-- list_level=$list_level" if $trace; |
| print DBX ((' 'x$list_level) . "</listitem>\n"); |
| print RTF "}\n\n"; |
| |
| $la = $pd[$i+1]; |
| if ((length($pd[$i]) == length($la)) && $la =~ /^[=~^-]{3,}$/) { # section |
| warn "$i: section detected list_level=$list_level" if $trace; |
| last; |
| } |
| |
| ### Can either be list item at same level or list item continuation at any |
| ### previous level (i.e. new paragraph) or new item at any previous level |
| |
| $_ = $pd[$i]; |
| ($indent) = /^(\s*)/; |
| $indent = length($indent); |
| warn "***** indent=$indent prev_indent=".$list_indent[$list_level-1]." level=$list_level" if $trace; |
| if ($indent == $list_indent[$list_level-1]) { |
| my $typ = $list_type[$list_level]; |
| my $cur_ind = $list_indent[$list_level]; |
| warn "checking for another item at same level typ=$typ cur_ind=$cur_ind --[$_]--" if $trace; |
| if (($typ eq '1') && /^(\s*\d+\.\s+)(.*)/) { |
| if (length($1) == $cur_ind) { |
| ++$n_list[$list_level]; |
| $first = $2; |
| warn "$i: another item list_level=$list_level --[$first]--" if $trace; |
| next; |
| } else { |
| warn "$i: Indent does not match ($_)"; |
| } |
| } elsif (($typ eq 'a') && /^(\s*[a-z]+[.\)]\s+)(.*)/) { |
| if (length($1) == $cur_ind) { |
| ++$n_list[$list_level]; |
| $first = $2; |
| warn "$i: another item list_level=$list_level --[$first]--" if $trace; |
| next; |
| } else { |
| warn "$i: Indent does not match ($_)"; |
| } |
| } elsif (($typ eq 'A') && /^(\s*[A-Z]+\.\s+)(.*)/) { |
| if (length($1) == $cur_ind) { |
| ++$n_list[$list_level]; |
| $first = $2; |
| warn "$i: another item list_level=$list_level --[$first]--" if $trace; |
| next; |
| } else { |
| warn "$i: Indent does not match ($_)"; |
| } |
| } elsif (($typ eq 'i') && /^(\s*[ivxlcdm]+[.\)]\s+)(.*)/) { |
| if (length($1) == $cur_ind) { |
| ++$n_list[$list_level]; |
| $first = $2; |
| warn "$i: another item list_level=$list_level --[$first]--" if $trace; |
| next; |
| } else { |
| warn "$i: Indent does not match ($_)"; |
| } |
| } elsif (($typ eq 'I') && /^(\s*[IVXLCDM]+\.\s+)(.*)/) { |
| if (length($1) == $cur_ind) { |
| ++$n_list[$list_level]; |
| $first = $2; |
| warn "$i: another item list_level=$list_level --[$first]--" if $trace; |
| next; |
| } else { |
| warn "$i: Indent does not match ($_)"; |
| } |
| } elsif (/^(\s*([*+-])\s+)(.*)/) { |
| if ((length($1) == $cur_ind) && ($typ eq $2)) { |
| ++$n_list[$list_level]; |
| $first = $3; |
| warn "$i: another item list_level=$list_level --[$first]--" if $trace; |
| next; |
| } else { |
| warn "$i: Indent does not match ($_)"; |
| } |
| } |
| warn "$i: same level didn't match --[$pd[$i]]--" if $trace; |
| } |
| |
| last; # Was not an item of the same list |
| } |
| print DBX ((' 'x$list_level) . $dbx_list_close{$list_type[$list_level]}); |
| #print RTF ((' 'x$list_level) . $rtf_list_close{$list_type[$list_level]}); |
| print HTML ((' 'x$list_level) . $html_list_close{$list_type[$list_level]}); |
| print HTML2 ((' 'x$list_level) . $html_list_close{$list_type[$list_level]}); |
| print TEX ((' 'x$list_level) . $tex_list_close{$list_type[$list_level]}); |
| --$list_level; |
| warn "$i: list closed list_level=$list_level" if $trace; |
| } |
| |
| sub sgfrag { |
| my ($in, $sec, $out, $caption) = @_; |
| my ($sg,$dbx); |
| if ($pdflag{'showsgasxsd'} eq '1') { |
| $sg = readall($out, 1); |
| $dbx = qq(<programlisting format="schema"><xi:include xmlns:xi="http://www.w3.org/2001/XInclude" href="./$out" parse="text"/></programlisting>); |
| } elsif ($pdflag{'showsgasxsd'} eq '2') { |
| $sg = readall($out, 1); |
| $dbx = '<programlisting format="schema"><computeroutput><!\[CDATA\[' . |
| dbx_entity_escape_lite($sg) . ']]></computeroutput></programlisting>'; |
| } else { |
| $sg = readall($in, 1); |
| $sg ||= readall("$in.sg", 1); |
| #my $xs = readall("$in.xsd"); |
| if ($sec) { |
| ($sg) = $sg =~ /\#sec\($sec\)\s*(.*?)\s*\#endsec\($sec\)/s; |
| #($xs) = $xs =~ /sec\($sec\)\s*(.*?)\s*endsec\($sec\)/s; |
| } |
| $dbx = qq(<programlisting format="schemagrammar"><computeroutput><!\[CDATA\[) |
| . dbx_entity_escape_lite($sg) . qq(\]\]></computeroutput></programlisting>); |
| } |
| ++$img_no; |
| my $dbx_caption = dbx_format($caption); |
| my $rtf_caption = rtf_format($caption); |
| my $html_caption = html_format($caption); |
| my $tex_caption = tex_caption($caption); |
| my $label = "$in-$sec"; |
| |
| print DBX qq(<figure id="$label" label="$img_no"><title>$dbx_caption</title>); |
| print RTF qq(figstart $rtf_caption); |
| print HTML qq(<pre>); |
| print HTML2 qq(<pre>); |
| print TEX qq(\\begin{figure}\\begin{verbatim}); |
| print DBX $dbx; |
| print NONL $sg; |
| print PDSEAL $sg; |
| print RTF $sg; |
| print HTML $sg; |
| print HTML2 $sg; |
| print TEX $sg; |
| print DBX qq(</figure>); |
| print RTF qq(figend); |
| print HTML "</pre>Fig-$img_no: $html_caption<p>"; |
| print HTML2 "</pre>Fig-$img_no: $html_caption<p>"; |
| print TEX qq(\\end{verbatim}$tex_caption\\label{$label}\\end{figure}); |
| } |
| |
| sub xmlfmt_html { |
| my ($x) = @_; |
| } |
| |
| sub xmlfmt { |
| my ($frag_name, $opts) = @_; |
| my $x = ''; |
| my @opts = split /\s*,\s*/, $opts; |
| |
| for ($row = 0; $i<=$#pd && $pd[$i] !~ /^>>/; ++$i) { |
| $x .= $pd[$i] . "\n"; |
| } |
| |
| print DBX qq(<programlisting format="$opts[0]"><computeroutput><!\[CDATA\[); |
| print RTF qq({\\f2); |
| print HTML qq(<pre>); |
| print HTML2 qq(<pre>); |
| print TEX qq(\\begin{verbatim}); |
| print DBX dbx_entity_escape_lite($x); |
| print RTF $x; |
| print RTF xmlfmt_html($x); |
| print HTML xmlfmt_html($x); |
| print HTML2 xmlfmt_html($x); |
| print TEX texfmt_html($x); |
| print DBX qq(\]\]></computeroutput></programlisting>); |
| print RTF "}"; |
| print HTML "</pre>"; |
| print HTML2 "</pre>"; |
| print TEX qq(\\end{verbatim}); |
| } |
| |
| ### Tables |
| |
| sub table { |
| my ($table_name,$tablekind) = @_; |
| # globals: @pd, $i |
| $i+=2; |
| my (@table, @col_beg, @col_wid, @col_hdr, @row1, @vis_wid); |
| my ($j, $row, $cols, $line, $wid); |
| my @align = (); |
| my $cur_col = 0; |
| if ($table_name) { |
| my $table_n = $table_no+1; |
| print NONL "Table $table_n: $table_name\n"; |
| print PDSEAL "Table $table_n: $table_name\n"; |
| } |
| print NONL $pd[$i-1]."\n"; |
| print NONL $pd[$i]."\n"; |
| print PDSEAL $pd[$i-1]."\n"; |
| #print PDSEAL $pd[$i]."\n"; # No equals signs in pdseal |
| @row1 = split / /, $pd[$i]; # Line of equals signs to set width of columns |
| $cols = $#row1+1; |
| $line = $pd[$i-1]; # Line of column titles |
| for ($j = 0; $j < $cols; ++$j) { |
| $wid = length($row1[$j]); |
| $col_hdr[$j] = substr($line, $cur_col, $wid); |
| $vis_wid[$j] = $col_wid[$j] = $wid; |
| $col_beg[$j] = $cur_col; |
| warn "col $j: >$row1[$j]< wid=$wid cur_col=$cur_col hdr: >>$col_hdr[$j]<<"; # if $trace>1; |
| $cur_col += $wid + 1; |
| } |
| for (++$i; ; ++$i) { |
| if ($pd[$i]=~/^WIDTHS:\s*(.*?)\s*$/) { |
| $j = 0; |
| for $wid (split /,/, $1) { |
| ++$j; |
| my ($plusminus, $viswid,$ali) = $wid =~ /^([+-])?(\d*)([lrc])?$/; |
| $align[$j] = $ali; |
| warn "TAB COL $j: ($plusminus)($viswid)($ali)"; |
| if (length $viswid) { |
| if (length $plusminus) { |
| $vis_wid[$j-1] += $plusminus.$viswid; |
| } else { |
| $vis_wid[$j-1] = $viswid; |
| } |
| } |
| } |
| next; |
| } |
| if ($pd[$i]=~/^OPTIONS:\s*(.*?)\s*/) { |
| next; |
| } |
| last; |
| } |
| for ($row = 0; $i<=$#pd && $pd[$i] !~ /^>>/;) { |
| warn "$i: $pd[$i]" if $trace>1; |
| print NONL $pd[$i]."\n"; |
| print PDSEAL $pd[$i]."\n"; |
| if ($pd[$i] =~ /^:$/) { # end of col by line mode |
| warn "$i: end of col by line marker" if $trace>1; |
| ++$i; |
| next; |
| } |
| if ($pd[$i] =~ /^\s*$/) { # col by line mode |
| warn "$i: col by line mode cols=$cols" if $trace>1; |
| ++$i; |
| for ($j = 0; $j < $cols; ++$j, ++$i) { |
| if ($pd[$i] =~ /^>>/) { |
| warn "Wrong number of lines in end of table in col-by-line mode: [$pd[$i-1]]"; |
| last; |
| } |
| $table[$row][$j] = $pd[$i]; |
| } |
| ++$row; |
| next; |
| } |
| |
| # row by line mode |
| $line = $pd[$i]; |
| for ($j = 0; $j < $cols-1; ++$j) { |
| $table[$row][$j] = substr($line, $col_beg[$j], $col_wid[$j]); |
| warn "$i: col $j: ($table[$row][$j]) --[$line]--" if $trace>1; |
| } |
| $table[$row][$cols-1] = substr($line, $col_beg[$cols-1]); # last col takes the rest |
| ++$i; |
| ++$row; |
| } |
| ++$i; |
| |
| # Ok, now we got table in @table and @col_hdr. Format it into Lib docbook table. The |
| # Liberty DocBook tools require two special columns to be added to sides and require namest. |
| |
| #warn "table1 ".Dumper \@col_hdr; |
| #warn "table2 ".Dumper \@vis_wid; |
| table_output(\@table, \@col_hdr, \@vis_wid, $row, $cols, $table_name, $tablekind); |
| } |
| |
| sub table_output { |
| my ($tabr, $col_hdrr, $vis_widr, $rows, $cols, $table_name, $tablekind) = @_; |
| my ($j, $rr, $dbx, $html, $tex, $colspecs, $tex_colspec, $wid); |
| |
| $colspecs = ''; |
| $tex_colspec = $tex_left_bar; |
| $dbx = qq(<thead>\n<row>\n); |
| $html = "<tr>\n"; |
| $colspecs = qq(<colspec colname="c0" colwidth="0pt"/>\n); # left extra col |
| for ($j = 1; $j <= $cols; ++$j) { |
| #warn "table_output2($$col_hdrr[$j-1])"; |
| $dbx .= qq( <entry namest="c$j">) . dbx_para_raw($$col_hdrr[$j-1]) . "</entry>\n"; |
| $html .= qq( <th$th_align{$align[$j]}>) . html_format($$col_hdrr[$j-1]) . "</th>\n"; |
| $wid = sprintf('%.1f', $$vis_widr[$j-1] * $dbx_col_wid_factor); |
| $colspecs .= qq(<colspec colname="c$j" colwidth="${wid}in"/>\n); |
| |
| $tp = tex_format($$col_hdrr[$j-1]); |
| $tex .= "$tp &"; |
| $wid = sprintf('%.1f', $$vis_widr[$j-1] * $tex_col_wid_factor); |
| $tex_colspec .= $tex_boxed_tab ? "p{${wid}mm}|" : "p{${wid}mm}"; |
| } |
| $colspecs .= qq(<colspec colname="c$j" colwidth="0pt"/>\n); # right extra col |
| |
| $dbx .= "</row>\n</thead>\n<tbody>\n"; |
| $html .= "</tr>\n"; |
| chop $tex; |
| $tex .= $tex_tab_hdr_sep; |
| |
| # Generate Table Body |
| |
| print TEX "\\message{===TAB}"; |
| |
| for ($rr = 0; $rr < $rows; ++$rr) { |
| if ($$tabr[$rr][0] eq '-----') { |
| $tex .= "\\hline\n"; |
| next; |
| } |
| $dbx .= qq(<row>\n); |
| $html .= "<tr>\n"; |
| for ($j = 1; $j <= $cols; ++$j) { |
| $dbx .= qq( <entry namest="c$j">) . dbx_para_raw($$tabr[$rr][$j-1]) . "</entry>\n"; |
| $html .= qq( <td$td_align{$align[$j]}>) . html_format($$tabr[$rr][$j-1]) . "</td>\n"; |
| $tp = tex_format($$tabr[$rr][$j-1]); |
| #$tex .= "$tp &"; |
| $tex .= $tex_align{$align[$j]}."$tp &"; |
| } |
| chop $tex; |
| $tex .= $tex_tab_line_sep; |
| $dbx .= "</row>\n"; |
| $html .= "</tr>\n"; |
| } |
| substr($tex, -length($tex_tab_line_sep)) = '' if $tex_tab_line_sep; |
| $dbx .= "</tbody>\n"; |
| $cols += 2; # account for extra cols |
| |
| $html =~ s|<th>\s*</th>|<th> </th>|gs; # Make empty cells appear correctly on firefox |
| $html =~ s|<td>\s*</td>|<td> </td>|gs; # Make empty cells appear correctly on firefox |
| |
| # Wrap the table into necessary top level tags |
| |
| print TEX "\\hbadness=10000\n"; # Disable warnings |
| if ($table_name) { |
| ++$table_no; |
| my $label = fold_label($table_name); |
| $reflist{$label} = $table_no; |
| $refhtmlpage{$label} = $html2; |
| my $dbx_caption = dbx_format($table_name); |
| my $tex_caption = tex_caption($table_name); |
| my $html_caption = html_format($table_name); |
| 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); |
| #print HTML qq(<p><i>$html_caption</i><br><table border=1>\n$html</table>\n); |
| #print HTML2 qq(<p><i>$html_caption</i><br><table border=1>\n$html</table>\n); |
| print HTML qq(<p>Table $table_no:<i>$html_caption</i><br><table border=0>\n$html</table>\n); |
| print HTML2 qq(<p>Table $table_no:<i>$html_caption</i><br><table border=0>\n$html</table>\n); |
| |
| if ($tablekind eq 'longtable') { |
| 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); |
| } elsif ($tablekind eq 'minitable') { |
| 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); |
| } elsif ($tablekind eq 'rawtable') { |
| 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); |
| } else { |
| 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); |
| } |
| } else { |
| print DBX qq(<informaltable><tgroup cols="$cols" align="left">\n$colspecs$dbx</tgroup></informaltable>\n); |
| print HTML qq(<table border=1>\n$html</table>\n); |
| print HTML2 qq(<table border=1>\n$html</table>\n); |
| if ($tablekind eq 'longtable') { |
| print TEX qq(\\begin{longtable}[$tex_flt_place]{$tex_colspec}\n$tex_top_line$tex\n$tex_bot_line\\end{longtable}\n); |
| } elsif ($tablekind eq 'minitable') { |
| print TEX qq(\\begin{floatingtable}{\\begin{tabular}{$tex_colspec}\n$tex_top_line$tex\n$tex_bot_line\\end{tabular}}\\end{floatingtable}\n); |
| } elsif ($tablekind eq 'rawtable') { |
| print TEX qq(\\begin{tabular}{$tex_colspec}\n$tex_top_line$tex\n$tex_bot_line\\end{tabular}\n); |
| } else { |
| 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); |
| } |
| } |
| print TEX "\\hbadness=$hbadness\n"; # Restore normal warning level |
| } |
| |
| ### Comma separated values tables |
| |
| sub read_csv { |
| my ($path, $topleft, $botright, $opts) = @_; |
| my ($i,$j); |
| my $csv = readall("$path.csv", 1); |
| $csv =~ s/\"//g; # Zap double quotes |
| my @x = split /\r?\n/, $csv; |
| #warn "CSV0 ".Dumper \@x; |
| for ($i = 0; $i <= $#x; ++$i) { |
| if ($opts eq 'pipeysep') { |
| $x[$i] = [ split '\|', $x[$i] ]; |
| } else { |
| $x[$i] = [ split ',', $x[$i] ]; |
| } |
| } |
| my ($left, $top) = $topleft =~ /^([a-z]+)(\d+)$/i; |
| my ($right, $bot) = $botright =~ /^([a-z]+)(\d+)$/i; |
| $left = ord(lc($left)) - ord('a'); |
| $right = ord(lc($right)) - ord('a'); |
| --$top; |
| --$bot; |
| warn "csv ($left,$top), ($right,$bot)"; |
| #warn "CSV1 ".Dumper \@x; |
| @x = splice @x, $top, $bot+1-$top; |
| #warn "CSV2 ".Dumper \@x; |
| for ($i = 0; $i <= $#x; ++$i) { |
| $x[$i] = [ splice(@{$x[$i]}, $left, $right+1-$left) ]; |
| } |
| #warn "CSV3 ".Dumper \@x; |
| return \@x; |
| } |
| |
| sub csv { |
| my ($path, $caption, $topleft, $botright, $opts) = @_; |
| my $xr = read_csv($path, $topleft, $botright, $opts); |
| my $col_hdrr = shift @{$xr}; |
| my $vis_widr = shift @{$xr}; |
| for (my $i = 0; $i <= $#{$vis_widr}; ++$i) { |
| $$vis_widr[$i] = length($$vis_widr[$i]); |
| } |
| #warn "CSV4 ".Dumper $xr; |
| table_output($xr, $col_hdrr, $vis_widr, $#{$xr}+1, $#{$col_hdrr}+1, $table_name, ''); |
| } |
| |
| ### Refs |
| |
| sub close_dbx_sections { |
| while ($sec_level) { |
| print DBX ( (' 'x$sec_level) . "</section><!--$sec_id[$sec_level]-->\n\n\n"); |
| --$sec_level; |
| } |
| } |
| |
| sub references { |
| my ($ref_name, $ena) = @_; |
| my ($ii, $labwid); |
| # globals: @pd, $i |
| $ref_id = $dbx_ref_name = $ref_name || 'References'; |
| $ref_id =~ tr[A-Za-z0-9][_]c; |
| |
| close_dbx_sections(); |
| print DBX <<DBX if $ena ne ':0'; # <section id="$ref_id"><bibliography id="references-$ref_id"> |
| <bibliodiv id="references-$ref_id"> |
| <title>$dbx_ref_name</title> |
| DBX |
| ; |
| if ($ena ne ':0') { |
| if ($ref_name) { |
| print TEX "\\renewcommand\\refname{$ref_name}\n"; # article |
| #print TEX "\\renewcommand\\bibname{$ref_name}\n"; # book |
| print HTML "<H2>$ref_name</H2>\n<dl>\n"; |
| print HTML2 "<H2>$ref_name</H2>\n<dl>\n"; |
| print NONL "$ref_name\n\n"; |
| print PDSEAL "$ref_name\n\n"; |
| } else { |
| print HTML "<H2>References</H2>\n<dl>\n"; |
| print HTML2 "<H2>References</H2>\n<dl>\n"; |
| print NONL "$ref_name\n\n"; |
| print PDSEAL "$ref_name\n\n"; |
| } |
| } |
| |
| $labwid = 4; |
| for ($ii = $i+1; $ii<=$#pd && $pd[$ii] !~ /^>>/; ++$ii) { |
| warn "$ii: $pd[$i]" if $trace>1; |
| if (($lab,$rest) = $pd[$i] =~ /^\s*\[(.*?)\]\s+(.*?)\s*$/) { |
| $labwid = length($lab) if length($lab) > $labwid; |
| } |
| } |
| |
| print TEX "\\begin{thebibliography}{XXXX".('X'x$labwid)."}\n" if $ena ne ':0'; |
| for (++$i; $i<=$#pd && $pd[$i] !~ /^>>/; ++$i) { |
| warn "$i: $pd[$i]" if $trace>1; |
| next if $ena eq ':0'; |
| |
| print NONL $pd[$i]; |
| print PDSEAL $pd[$i]; |
| if (($lab,$rest) = $pd[$i] =~ /^\s*\[(.*?)\]\s+(.*?)\s*$/) { |
| $lab = tex_esc($lab); |
| $rest = tex_esc($rest); |
| print DBX qq( <bibliomixed id="$lab"/>\n); |
| print TEX "\\bibitem[$lab]{$lab} $rest\n"; |
| print HTML qq(<dt>[<a id="$lab" class=ref>$lab</a>] <dd>$rest\n); |
| print HTML2 qq(<dt>[<a id="$lab" class=ref>$lab</a>] <dd>$rest\n); |
| } else { |
| $rest = tex_esc($pd[$i]); |
| print TEX "$rest\n"; |
| print HTML "$pd[$i]\n"; |
| print HTML2 "$pd[$i]\n"; |
| } |
| } |
| ++$i; |
| if ($ena ne ':0') { |
| #print DBX qq(</bibliography>\n </section>\n); |
| print DBX qq(</bibliodiv>\n); |
| print TEX "\\end{thebibliography}\n"; |
| print HTML "</dl>\n"; |
| print HTML2 "</dl>\n"; |
| } |
| } |
| |
| # Output verbatim material to all output streams, even to an external file |
| |
| sub unindented_code { |
| my ($filespec, $first) = @_; |
| if ($filespec) { |
| open OUT, ">$filespec" or die "Can't write file($filespec): $!"; |
| } |
| print DBX dbx_entity_escape_lite($first) if $first; |
| print NONL $first if $first; |
| print PDSEAL $first if $first; |
| print RTF $first if $first; |
| print HTML $first if $first; |
| print HTML2 $first if $first; |
| print OUT $first if $first && $filespec; |
| print TEX tex_esc_verbatim($first."\n") if $first; |
| for (++$i; $pd[$i] !~ /^>>/; ++$i) { |
| print DBX dbx_entity_escape_lite($pd[$i])."\n"; |
| print NONL $pd[$i]."\n"; |
| print PDSEAL $pd[$i]."\n"; |
| print RTF $pd[$i]."\n"; |
| print HTML $pd[$i]."\n"; |
| print HTML2 $pd[$i]."\n"; |
| print OUT $pd[$i]."\n" if $filespec; |
| #print TEX (tex_esc_verbatim($pd[$i])."\n"); |
| my $x = $pd[$i]; # Line wrap code from fjon |
| while(length($x) > $maxlogline){ |
| print TEX (tex_esc_verbatim(substr($x,0,$maxlogline-1))."\\\n"); |
| $x = substr($x, ($maxlogline-1), length($x)); |
| } |
| print TEX (tex_esc_verbatim($x)."\n"); |
| } |
| close OUT; |
| } |
| |
| sub code { |
| my ($first_line) = @_; |
| my ($ind) = $pd[$i] =~ /^(\s+)/; |
| my $code = $pd[$i] . "\n"; |
| #warn "CODE0($code)"; |
| for (++$i; |
| ($i<=$#pd) && ((substr($pd[$i],0,length($ind)) eq $ind) || $pd[$i]=~/^\s*$/); |
| ++$i) { |
| warn "$i code $#pd: line($pd[$i])" if $trace>2; |
| $code .= $pd[$i] . "\n"; |
| } |
| if ($first_line =~ /^NOTE: (.*)$/) { |
| $first_line = $1; |
| $code =~ s/^\s*NOTE: .*?\n//s; |
| my $dbx_code = dbx_para($code); |
| my $tex_code = tex_para($code); |
| print DBX qq(<note><title>$first_line</title>$dbx_code</note>\n); |
| print TEX qq(\\quote{\\emph{$first_line}\n$tex_code}\n); |
| return; |
| } |
| print NONL $code; |
| print PDSEAL $code; |
| print DBX "$code_open_tag<![CDATA[".dbx_entity_escape_lite($code)."]]>$code_close_tag\n"; |
| #warn "CODE($code)"; |
| $code = tex_esc_verbatim($code); |
| #warn "CODE1($code)"; |
| $code =~ s/(\r?\n)+$//gs; |
| #warn "CODE2($code)"; |
| print TEX "\\begin{verbatim}$code\\end{verbatim}\n\n"; |
| $code =~ s/</</g; |
| print HTML "<pre>$code</pre>\n"; |
| print HTML2 "<pre>$code</pre>\n"; |
| } |
| |
| sub blockquote { |
| my ($first_line) = @_; |
| my ($ind) = $pd[$i] =~ /^(\s*> )/; |
| my $len_ind = length($ind); |
| my $code = $first_line; |
| my ($dbx_quote, $tex_quote, $html_quote, $rtf_quote); |
| for (++$i; ($i<=$#pd) && (substr($pd[$i],0,$len_ind) eq $ind); ++$i) { |
| warn "$i: $pd[$i]" if $trace; |
| $line = substr($pd[$i], $len_ind-1); # include space between lines |
| if ($line =~ /^\s*$/) { # empty line signifies paragraph break |
| $dbx_quote .= dbx_para($code) . "\n\n"; |
| $tex_quote .= tex_para($code) . "\n\n"; |
| $code = ''; |
| } else { |
| $code .= $line; |
| } |
| } |
| print NONL $code; |
| print PDSEAL $code; |
| $dbx_quote .= dbx_para($code); |
| print DBX "<blockquote>$dbx_quote</blockquote>\n"; |
| |
| $rtf_quote .= rtf_format($code); |
| print RTF "{\\pard $rtf_styles{'s21'} \\s21\n$rtf_quote\\par}\n"; |
| |
| $html_quote .= html_format($code); |
| print HTML "<blockquote>$html_quote</blockquote>\n"; |
| print HTML2 "<blockquote>$html_quote</blockquote>\n"; |
| |
| $tex_quote .= tex_format($code); |
| print TEX "\\begin{quote}$tex_quote\n\\end{quote}\n"; |
| } |
| |
| ### |
| ### Material from fjon, some very specific to ocean wave simulation |
| ### |
| |
| sub desvar { |
| # Extract design variables from ocean script |
| # Put variables in table |
| |
| my($filename,$comment) = @_; |
| open(INFILE, $filename) or warn "Can't open desvar file '$filename':$!"; |
| |
| my $x_html = "<p><i>" . html_format($comment) . "</i><br><table>\n" . |
| "<tr><th>Variable</th><th>Value</th><th>Comment</th></tr>\n"; |
| print HTML $x_html; |
| print HTML2 $x_html; |
| my $x_comm = tex_format($comment); |
| my $x_tex = <<TEX; |
| \\begin{longtable}[ht]{|l|l|l|} |
| \\caption{\\small $x_comm}\\\\ |
| \\endfirsthead |
| \\caption[]{\\small (continuation)} \\\\ |
| \\endhead |
| \\hline |
| Variable & Value & comment \\\\\\hline\\hline |
| TEX |
| ; |
| print TEX $x_tex; |
| |
| $/ = "\n"; # Disable "slurp" mode |
| while(<INFILE>) { |
| # 1 1 2 2 3 3 |
| if( /^;?desVar\(\s*\"(\w*)\"\s*(.*)\s*\)\s*;?\s*(\w.*)?/ ) { |
| $x_html = "<tr><td>" . html_format($1) . "</td><td>" . |
| $2 . "</td><td>" . html_format($3) . |
| " </td></tr>\n"; |
| print HTML $x_html; |
| print HTML2 $x_html; |
| print TEX tex_format($1)." & ".tex_format($2)." & ".tex_format($3). |
| "\\\\\n\\hline\n"; |
| } |
| } |
| close(INFILE); |
| print HTML "</table>\n"; |
| print HTML2 "</table>\n"; |
| print TEX "\\end{longtable}\n"; |
| undef $/; # Enable "slurp" mode again |
| } |
| |
| sub plot_waves { |
| my $corners = '*'; |
| my $subdir = '*'; |
| # for (++$i; $pd[$i] !~ /^>>/; ++$i) { |
| my $continue = 1; |
| my $found = 0; |
| my $gnuplotcmd = ""; |
| while($continue == 1){ |
| if($pd[$i] =~ /^(un)?set (.*)/) { |
| $gnuplotcmd .= "$1set $2\n"; |
| } elsif($pd[$i] =~ /^(\S*)=(.*)/) { |
| if($1 eq "corners") { |
| $corners = $2; |
| } elsif($1 eq "dir") { |
| $subdir = $2; |
| } |
| } else { |
| my ($in_line) = ($pd[$i] =~ /(?:<<plot:)?([^>]*)/); |
| my ($plot,$comment) = split(/:/, $in_line); |
| if(!$plot) { next; } |
| my ($wavedef, $title, $xlabel, $ylabel, $plot_opt) = split(/,/,$plot); |
| |
| @wavelist = split(/&/, $wavedef); |
| |
| @plotcmd = (); |
| $n_plots = 0; |
| $newest_file = 0; |
| @waves = (); |
| foreach(@wavelist){ |
| # ($wave, $wave_corners) = /([\w-]*)(?:\((.*)\))?/; |
| my ($wave, $wave_corners, $caption) = /([\w-]*)(?:\((.*)\))?(?:\"(.*)\")?/; |
| if(!$caption){ |
| $caption = $wave; |
| } |
| @waves = (@waves, $wave); |
| |
| $found = 0; |
| if($wave_corners){ |
| @cornerlist = split(/\s/,$wave_corners); |
| } else { |
| @cornerlist = split(/\s/,$corners); |
| } |
| |
| # Count number of files |
| my $file_count = 0; |
| foreach(@cornerlist){ |
| $corner = $_; |
| @files = <$subdir/$corner/$wave>; |
| foreach(@files){ |
| $file = $_; |
| if(-e $file){ |
| $file_count++; |
| } |
| } |
| } |
| |
| # Create plots commands |
| foreach(@cornerlist){ |
| $corner = $_; |
| @files = <$subdir/$corner/$wave>; |
| # Removed search of data in non-testbench directory |
| # if($subdir eq '*'){ |
| # @files = (@files, <$corner/$wave>); |
| # } |
| foreach(@files){ |
| $file = $_; |
| if(-e $file){ |
| print "Exist:$file\n"; |
| $timestamp = (stat($file))[9]; |
| if($timestamp > $newest_file){ |
| $newest_file = $timestamp; |
| } |
| print "Number of files @files\n"; |
| if($file_count == 1){ |
| # Only one corner, don't include corner in caption |
| @plotcmd = (@plotcmd, |
| "\"$file\" title \"$caption\" $plot_opt"); |
| } else { |
| ($corn) = ($file =~ /\w*\/(.*)\/\w*/); |
| @plotcmd = (@plotcmd, |
| "\"$file\" title \"$caption:$corn\" $plot_opt"); |
| } |
| $n_plots++; |
| $found = 1; |
| } |
| } |
| } |
| if($found == 0) { |
| print HTML "<error:Missing waveform $wave>"; |
| } |
| } |
| |
| $filename = join('', @waves); |
| if($subdir ne '*'){ |
| $filename = $filename."-".$subdir; |
| } |
| if($cornerlist[0] ne '*'){ |
| $filename = $filename."-".join('',@cornerlist); |
| } |
| |
| if($n_plots == 0){ |
| @plotcmd = ("0"); |
| } |
| |
| open GNUPLOT,">.pd/cmdfile.gnuplot"; |
| warn "Writing .pd/cmdfile.gnuplot"; |
| print GNUPLOT "reset\n". |
| "set terminal postscript eps color dashed\n". |
| "set data style lines\n". |
| "set grid\n". |
| "set autoscale xy\n". |
| # "set title \"$title\"\n". |
| "set xlabel \"$xlabel\"\n". |
| "set ylabel \"$ylabel\"\n". |
| "set output 'tex/$filename.eps'\n". |
| "$gnuplotcmd". |
| "plot ".join(",", @plotcmd)."\n"; |
| close GNUPLOT; |
| |
| $gnuplotcmd = ""; |
| $newplot = 0; |
| $cmdfile = ".pd/$filename.gnuplot"; |
| if((-e $cmdfile) && |
| ($newest_file < (stat($cmdfile))[9]) && |
| (system("diff $cmdfile .pd/cmdfile.gnuplot") eq "0")) { |
| |
| warn("Nothing changed in [".join(' ',@waves)."]\n"); |
| $newplot = 0; |
| } else { |
| warn("Creating plot [".join(' ',@waves)."]\n"); |
| system("mv .pd/cmdfile.gnuplot $cmdfile"); |
| system('gnuplot',"$cmdfile"); |
| system('epstopdf',"tex/$filename.eps"); |
| $newplot = 1; |
| } |
| |
| if((!-e "$htmldir$filename.png") || $newplot){ |
| system('convert',"-density","100x100","tex/$filename.eps", |
| "$htmldir$filename.png"); |
| } |
| if((!-e "$htmldir$filename"."-zoom.png") || $newplot){ |
| system('convert',"-density","200x200","tex/$filename.eps", |
| "$htmldir$filename"."-zoom.png"); |
| } |
| if((!-e "tex/$filename.pdf") || $newplot){ |
| # system('ps2pdf',"tex/$filename.eps","tex/$filename.pdf"); |
| } |
| ++$img_no; |
| $refname = fold_label($filename); |
| $reflist{$refname} = $img_no; |
| $refhtmlpage{$refname} = $html2; |
| my $html_caption = "<p><a href=\"$filename"."-zoom.png\" ". |
| "id=\"$refname\"><img src=\"$filename.png\"></a><br>". |
| "Fig-$img_no: <i>".html_format($title)."</i></p>\n"; |
| print HTML $html_caption; |
| print HTML2 $html_caption; |
| |
| my $tex_caption = tex_caption($title); |
| print TEX "\\begin{figure}[ht]\n\\center\\includegraphics[totalheight=3.5in]". |
| "{$filename.pdf}\n$tex_caption\n". |
| "\\label{$refname}\\end{figure}\n"; |
| } |
| |
| } continue { |
| if($pd[$i] =~ />>$/) { |
| $continue = 0; |
| } |
| $i++; |
| } |
| # print TEX "\\pagestyle{fancy}\n"; |
| $sec_float_obj++; |
| } |
| |
| sub print_data { |
| my $corners = '*'; |
| my $subdir = '*'; |
| my $continue = 1; |
| my $firstdata = 1; |
| |
| my ($cmd,$table_caption,$label) = split(/:/, $pd[$i++]); |
| ++$table_no; |
| if(!$label) { |
| $label = "table_$table_no"; |
| } |
| my $ref = fold_label($label); |
| $reflist{$ref} = $table_no; |
| $refhtmlpage{$ref} = $html2; |
| |
| # print table head |
| $html = "<p><a id=\"$ref\"></a><br>". |
| "<table border=0>\n" . |
| "<tr><th rowspan=\"2\">Parameter</th><th colspan=\"3\">Spec</th>". |
| "<th colspan=\"3\">Result</th><th rowspan=\"2\">Unit</th><th rowspan=\"2\">Pass</th></tr>\n". |
| "<tr><th>Min</th><th>Typ</th><th>Max</th>". |
| "<th>Min</th><th>Typ</th><th>Max</th></tr>\n"; |
| print HTML $html; |
| print HTML2 $html; |
| |
| $tex = "\\begin{center}\n". |
| "\\scriptsize\n". |
| "\\tablehead{\n". |
| " & & Spec& & &Result& & & \\\\\n". |
| "Parameter & Min & Typ & Max & Min & Typ & Max & Unit & Pass\\\\\n". |
| "\\hline\n\\hline}\n". |
| "\\tabletail{\\hline}\n". |
| # "\\title{\\textbf{Table $table_no:$label}}\n". |
| "\\bottomcaption{$table_caption}\n". |
| "\\label{$ref}\n". |
| "\\begin{mpsupertabular}{l|ccc|ccc|c|c}\n"; |
| print TEX $tex; |
| |
| while($continue == 1){ |
| if($pd[$i] =~ /^(\S*)=(.*)/) { |
| if($1 eq 'corners') { |
| $corners = $2; |
| } elsif ($1 eq 'dir') { |
| $subdir = $2; |
| } else { |
| warn("Illegal command '$1'\n"); |
| } |
| next; |
| } |
| my ($varname,$caption,$eq,$min_spec,$typ_spec,$max_spec,$unit,$n_dec) = |
| split(/,/, $pd[$i]); |
| if(!$varname){ |
| next; |
| } |
| if(!$unit){ |
| # Unit not specified = Wrong number of parameters. Use line as title |
| $html = "<tr><th colspan=\"9\">$pd[$i]</th></tr>\n"; |
| print HTML $html; |
| print HTML2 $html; |
| if($firstdata eq 0){ |
| print TEX "\\hline\n"; |
| } |
| print TEX "\\multicolumn{9}{l}{\\textbf{$pd[$i]}}\\\\\n\\hline\n"; |
| next; |
| } |
| if($n_dec eq ''){ |
| $n_dec = 2; |
| } |
| |
| my ($typ, $min, $max, $min_corner, $max_corner, $typ_corner); |
| $min_corner = ''; |
| $max_corner = ''; |
| my $count = 0; |
| # Walk through corners and subdir to find variables |
| my @cornerlist = split(/\s/,$corners); |
| $/ = "\n"; # Disable "slurp" mode |
| foreach(@cornerlist){ |
| $corner = $_; |
| @files = <$subdir/$corner/$varname>; |
| foreach(@files){ |
| $file = $_; |
| |
| # Read data |
| open DATAFILE, $file; |
| chomp($data = <DATAFILE>); |
| close DATAFILE; |
| |
| # Find min and max value |
| ($corn) = ($file =~ /\w*\/(.*)\/\w*/); |
| if($count eq 0){ |
| $typ = $data; |
| $min = $data; |
| $max = $data; |
| $typ_corner = $corn; |
| $min_corner = $corn; |
| $max_corner = $corn; |
| } else { |
| if($corn eq 'typ'){ |
| $typ = $data; |
| $typ_corner = $corn; |
| } |
| if($min > $data){ |
| $min = $data; |
| $min_corner = $corn; |
| } |
| if($max < $data){ |
| $max = $data; |
| $max_corner = $corn; |
| } |
| } |
| $count++; |
| } |
| } |
| # Scale result according to unit |
| my($prefix) = $unit =~ /(.?)/; |
| if ($prefix eq 'T') { $scale = 1e-12; } |
| elsif ($prefix eq 'G') { $scale = 1e-9; } |
| elsif ($prefix eq 'M') { $scale = 1e-6; } |
| elsif ($prefix eq 'k') { $scale = 1e-3; } |
| elsif ($prefix eq 'm') { $scale = 1e3; } |
| elsif ($prefix eq 'u') { $scale = 1e6; } |
| elsif ($prefix eq 'n') { $scale = 1e9; } |
| elsif ($prefix eq 'p') { $scale = 1e12; } |
| elsif ($prefix eq 'f') { $scale = 1e15; } |
| else { $scale = 1; } |
| |
| $min *= $scale; |
| $max *= $scale; |
| $typ *= $scale; |
| |
| # Check results |
| if((($min_spec eq '') || ($min >= $min_spec)) && |
| (($max_spec eq '') || ($max <= $max_spec))){ |
| $result_html = ' '; |
| $result_tex = ''; |
| } else { |
| $result_html = 'FAIL'; |
| $result_tex = 'FAIL'; |
| } |
| |
| $typ_cap_tex = sprintf("%.$n_dec"."f",$typ); |
| $typ_cap_html = $typ_cap_tex; |
| if($count eq 1){ |
| # Dont print min and max data if only one data point found |
| $max_cap_html = ' '; |
| $min_cap_html = ' '; |
| $min_cap_tex = ''; |
| $max_cap_tex = ''; |
| } elsif($count eq 0){ |
| # Dont print results if no data found |
| $max_cap_html = ' '; |
| $min_cap_html = ' '; |
| $typ_cap_html = ' '; |
| $min_cap_tex = ''; |
| $max_cap_tex = ''; |
| $typ_cap_tex = ''; |
| $result_html = ' '; |
| $result_tex = ''; |
| print HTML "<error:Data $varname not found>\n"; |
| } else { |
| $min_cap_html = sprintf("%.$n_dec"."f (%s)",$min,$min_corner); |
| $max_cap_html = sprintf("%.$n_dec"."f (%s)",$max,$max_corner); |
| $min_cap_tex = sprintf("%.$n_dec"."f\\ensuremath{^{%s}}",$min,$min_corner); |
| $max_cap_tex = sprintf("%.$n_dec"."f\\ensuremath{^{%s}}",$max,$max_corner); |
| } |
| |
| |
| # Print result if data found |
| $html = "<tr><td>$caption</td>". |
| "<td>$min_spec </td>". |
| "<td>$typ_spec </td>". |
| "<td>$max_spec </td>". |
| "<td>$min_cap_html</td>" . |
| "<td>$typ_cap_html</td>". |
| "<td>$max_cap_html</td>". |
| "<td>$unit</td><td>$result_html</td></tr>\n"; |
| print HTML $html; |
| print HTML2 $html; |
| $tex = "$caption & $min_spec & $typ_spec & $max_spec &". |
| "$min_cap_tex & $ typ_cap_tex & $max_cap_tex & ". |
| "$unit & $result_tex \\\\\n"; |
| print TEX $tex; |
| $firstdata = 0; |
| } continue { |
| $i++; |
| if($pd[$i] =~ />>$/){ |
| $continue = 0; |
| } |
| } |
| |
| # Close table |
| $html = "</p></table>Table $table_no:<i>$table_caption</i>\n"; |
| print HTML $html; |
| print HTML2 $html; |
| |
| print TEX "\\end{mpsupertabular}\n\\normalsize\n\\end{center}\n"; |
| |
| $i++; |
| undef $/; # Enable "slurp" mode again |
| } |
| |
| sub plot_schematics { |
| my $cont = 1; |
| |
| print HTML '<p><i>Schematics:</i><br>'; |
| print HTML2 '<p><i>Schematics:</i><br>'; |
| |
| # Deuglify filenames of newly printed schematics |
| my $schdir = 'sch'; |
| my @sch_list = glob "$schdir/*,*"; # schematic printed using hieracical plots contains a , |
| my $index; |
| foreach my $sch (@sch_list) { # rename Cadence file format, easier for LaTex and for sort |
| $index++; |
| print "Schematic $index of " . @sch_list . "\n"; |
| if ($sch =~ /[@](.*),(.*),(.*)/) { #strip @ prefix and extract ckt and libname |
| my $libname = $1; |
| my $cktname = $2; |
| my $viewname = $3; |
| my $viewext; |
| if($viewname eq 'schematic') { |
| $viewext = ''; |
| } else { |
| $viewext = "-$viewname"; |
| } |
| |
| rename "$sch", "$schdir/$cktname.$libname.$viewname.ps" or warn "couldn't rename $sch\n"; |
| system "ps2ps $schdir/$cktname.$libname.$viewname.ps $schdir/$cktname$viewext-$libname"; |
| unlink "$schdir/$cktname.$libname.$viewname.ps"; # delete eps files |
| } |
| } |
| |
| while($cont){ |
| # my ($pre, $sch, $lib) = ($pd[$i] =~ /(?:<<sch:)?([\s\^]*)([\w]*)\s*\((\w*)/); |
| my ($pre, $sch, $lib) = ($pd[$i] =~ /(?:<<sch:)?(\W*)([\w-]*)\s*\((\w*)/); |
| $filename = "$sch-$lib"; |
| print "$filename\n"; |
| if(-r "sch/$filename"){ |
| if((stat("sch/$filename"))[9] > (stat("tex/$filename.pdf"))[9]){ |
| print "Converting $filename to pdf\n"; |
| system('epstopdf',"sch/$filename", "-outfile","tex/$filename.pdf"); |
| } |
| if((stat("sch/$filename"))[9] > (stat("$htmldir$filename.png"))[9]){ |
| print "Converting $filename to png\n"; |
| system("convert -density 150x150 sch/$filename $htmldir$filename.png"); |
| } |
| ++$img_no; |
| $refname = fold_label($filename); |
| $reflist{$refname} = $img_no; |
| $refhtmlpage{$refname} = $html2; |
| |
| my $html_caption = "$pre<a href=\"$filename.png\"". |
| "id=\"$refname\">$sch ($lib)</a><br>\n"; |
| print HTML $html_caption; |
| print HTML2 $html_caption; |
| $tex_caption = ""; |
| print TEX <<TEX; |
| \\setlength{\\unitlength}{1in} |
| \\newpage |
| \\begin{picture}(5,7)(1.5,2.5) |
| \\thispagestyle{plain} |
| \\includegraphics[width=1\\paperwidth,height=1\\paperheight,keepaspectratio]{$filename.pdf} |
| \\end{picture} |
| \\newpage |
| TEX |
| ; |
| # print TEX "\\begin{figure}[ht]\n\\center". |
| # "\\includegraphics[totalheight=9in]". |
| # "\\includegraphics[width=1.0\\textwidth,". |
| # "height=1.0\\textheight,keepaspectratio]". |
| # "\\includegraphics[width=0.95\\paperwidth,". |
| # "height=0.95\\paperheight,keepaspectratio]". |
| # "{$filename.pdf}\n$tex_caption". |
| # "\\label{$refname}\n\\end{figure}\n\\clearpage\n\n"; |
| } |
| |
| if($pd[$i] =~ />>$/) { |
| $cont = 0; |
| } |
| $i++; |
| } |
| print HTML '</p>'; |
| print HTML2 '</p>'; |
| } |
| |
| # Generate TeX for equation AND render it for HTML representation |
| |
| sub plot_eqn { |
| my($equation,$tag,$eqnr) = @_; |
| my $ref = fold_label($tag); |
| |
| print TEX "\\begin{equation}\\label{$ref}$equation\\end{equation}"; |
| |
| # Convert latex equation to png to include in HTML document |
| my $f = "eqn_$tag"; |
| my $dpi = 150; |
| my $res = 0.5; |
| my $imageCmd = 'pnmtopng'; |
| #my $imageCmdD = 'pngtopnm'; |
| my $imageExt = 'png'; |
| my $background = ""; |
| my $transparent = "ff/ff/ff"; |
| $reflist{$ref} = $eqnr; |
| $refhtmlpage{$ref} = $html2; |
| |
| open TEXEQN,">$f.tex"; |
| warn "Writing $f.tex"; |
| print TEXEQN "\\documentclass[12pt]{article}\n" . |
| "\\pagestyle{empty}\n". |
| "\\begin{document}\n". |
| "\\begin{displaymath}\n". |
| # "\\bf\n". |
| "$equation\n". |
| "\\end{displaymath}\n". |
| "\\end{document}\n"; |
| close TEXEQN; |
| |
| # Only recreate png file if tex file changed |
| if((-e ".pd/$f.tex") && (-e "$htmldir$f.$imageExt") && |
| (system("diff .pd/$f.tex $f.tex") eq "0")){ |
| unlink "$f.tex"; |
| warn("Nothing changed in equation $tag\n"); |
| } else { |
| # *** the following, from fjon, has too many tool dependencies for my taste --Sampo |
| unlink ".pd/$f.tex"; |
| rename "$f.tex", ".pd/$f.tex"; |
| system("latex .pd/$f.tex\n"); |
| system("dvips -f $f.dvi > $f.ps\n"); |
| $cmd = "echo quit | gs -q -dNOPAUSE -r" . int($dpi / $res). "x". int($dpi / $res) . |
| " -sOutputFile=- -sDEVICE=pbmraw $f.ps | " . |
| "pnmcrop -white | pnmdepth 255 | $background pnmscale " . |
| $res . " | " . |
| "$imageCmd -interlace -transparent rgb:$transparent >$htmldir$f.$imageExt"; |
| system($cmd); |
| system("rm $f.dvi $f.aux $f.log $f.ps"); |
| } |
| # Place equation in table to align equation number |
| $html = "<table><tr>". |
| "<td class=\"eqn\"><a id=\"$ref\"><img src=\"$f.$imageExt\"></a>". |
| "<td class=\"eqn\">($eqnr)\n". |
| "</table><br>\n"; |
| # "<a id=\"$ref\"><img src=\"$f.$imageExt\"></a>". |
| # " ($eqnr)<br>\n"; |
| print HTML $html; |
| print HTML2 $html; |
| } |
| |
| ### End fjon contribution |
| |
| # N.B. In order to be able to escape < and > properly we use here a trick: |
| # ^^^^ represents < and ~~~~ represents >. Once escaping is done, they |
| # are substituted back. |
| |
| $inline_open = '^^^^inlinemediaobject~~~~^^^^imageobject~~~~'; |
| $inline_close = '^^^^/imageobject~~~~^^^^/inlinemediaobject~~~~'; |
| |
| sub fold_label { |
| my ($label) = @_; |
| $label =~ s|[^\w_:-]|-|g; # fjon added _ |
| return $label; |
| } |
| |
| sub dbx_entity_escape_lite { # Used by verbatim modes that use CDATA |
| my ($x) = @_; |
| return $x unless $encoding eq 'UTF-8'; |
| |
| return $x; |
| } |
| |
| sub dbx_entity_escape { |
| my ($x) = @_; |
| return $x unless $encoding eq 'UTF-8'; |
| |
| $x =~ s/\@/@/g; |
| |
| $x =~ s/á/á/g; $x =~ s/à/à/g; $x =~ s/â/â/g; |
| $x =~ s/ä/ä/g; $x =~ s/ã/ã/g; $x =~ s/å/å/g; |
| $x =~ s/Á/Á/g; $x =~ s/À/À/g; $x =~ s/Â/Â/g; |
| $x =~ s/Ä/Ä/g; $x =~ s/Ã/Ã/g; $x =~ s/Å/Å/g; |
| |
| $x =~ s/ó/ó/g; $x =~ s/ò/ò/g; $x =~ s/ô/ô/g; |
| $x =~ s/ö/ö/g; $x =~ s/õ/õ/g; |
| $x =~ s/Ó/Ó/g; $x =~ s/Ò/Ò/g; $x =~ s/Ô/Ô/g; |
| $x =~ s/Ö/Ö/g; $x =~ s/Õ/Õ/g; |
| |
| $x =~ s/í/í/g; $x =~ s/ì/ì/g; $x =~ s/î/î/g; $x =~ s/ï/ï/g; |
| $x =~ s/Í/Í/g; $x =~ s/Ì/Ì/g; $x =~ s/Î/Î/g; $x =~ s/Ï/Ï/g; |
| |
| $x =~ s/é/é/g; $x =~ s/è/è/g; $x =~ s/ê/ê/g; $x =~ s/ë/ë/g; |
| $x =~ s/É/É/g; $x =~ s/È/È/g; $x =~ s/Ê/Ê/g; $x =~ s/Ë/Ë/g; |
| |
| $x =~ s/ú/ú/g; $x =~ s/ù/ù/g; $x =~ s/û/û/g; $x =~ s/ü/ü/g; |
| $x =~ s/Ú/Ú/g; $x =~ s/Ù/Ù/g; $x =~ s/Û/Û/g; $x =~ s/Ü/Ü/g; |
| |
| $x =~ s/ç/çla;/g; $x =~ s/Ç/Çla;/g; |
| $x =~ s/ñ/ñ/g; $x =~ s/Ñ/Ñ/g; |
| |
| return $x; |
| } |
| |
| sub dbx_format_infobox { |
| my ($id,$link,$tableargs,$content) = @_; |
| $content =~ s/</^^^^/gs; |
| $content =~ s/>/~~~~/gs; |
| return tag(qq(a href="#" onClick="vis('$id',1);")).$link.tag('/a') |
| .tag(qq(table id=$id $tableargs)).tag('tr').tag('td').$content |
| .tag('/td').tag('/tr').tag('/table'); |
| } |
| |
| sub dbx_para_raw { |
| my $x = join ' ', @_; |
| return "\n" unless length $x; |
| local ($1,$2,$3,$4,$5,$6,$7,$8,$9); |
| |
| if ($fn_style == 3) { |
| $x =~ s%<<footnote:\s*(.*?)\s*>>%$fn_num++,qq(^^^^footnote id="fn$fn_num" label="$fn_num"~~~~^^^^para~~~~$1^^^^/para~~~~^^^^/footnote~~~~)%gse; |
| } elsif ($fn_style == 1) { |
| $x =~ s%<<footnote:\s*(.*?)\s*>>%$fn_num++,qq([*** fn$fn_num: $1 ***])%gse; |
| } else { |
| $x =~ s%<<footnote:\s*(.*?)\s*>>%%gs; |
| } |
| $x =~ s%<<feedbackopts:.*?>>%%gs; |
| $x =~ s%<<addfeedbacktop:.*?>>%%gs; |
| $x =~ s%<<addfeedbackbot:.*?>>%%gs; |
| $x =~ s%<<infobox:(\w+):([^:]*):([^:]*):\s*(.*?)\s*>>%dbx_format_infobox($1,$2,$3,$4)%gse; |
| $x =~ s/\(\*\*\*(.*?)\)//gs; |
| |
| # 1 2 34 5 6 7 8 |
| $x =~ s%<<(\S*?(\.((gif)|(jpe?g)|(svg)|(png)|(e?ps))))>>% |
| $inline_open^^^^imagedata fileref="$1"/~~~~$inline_close%gsx; |
| $x =~ s%<<tt:\s*(.*?)>>%^^^^computeroutput~~~~$1^^^^/computeroutput~~~~%gs; |
| $x =~ s%<<bold:\s*(.*?)>>%^^^^emphasis role="bold"~~~~$1^^^^/emphasis~~~~%gs; |
| $x =~ s%<<italic:\s*(.*?)>>%^^^^emphasis~~~~$1^^^^/emphasis~~~~%gs; |
| $x =~ s%<<see:\s*(\S[^>]*?)(?::\s+(\S[^>]*))?>>%qq(^^^^xref linkend=") . fold_label($1) . qq("/~~~~)%gse; |
| $x =~ s%<<ix:\s*([^>]+)>>%$1%gs; # index entry |
| $x =~ s%<<ref:\s*([^:]+): (.*?)>>%<xref linkend="$2"/>%gs; # *** should do proper ref |
| $x =~ s|<(/?\w.*?/?)>|^^^^$tag_tag~~~~<$1>^^^^/$tag_tag~~~~|gs; |
| $x =~ s%((?<!\S)\@[a-z0-9-]+)%^^^^computeroutput~~~~$1^^^^/computeroutput~~~~%gsxi; # XML or HTML @attribute |
| # *** add URL, email, and file path detection |
| $x =~ s|&|&|g; |
| $x =~ s|<|<|g; |
| $x =~ s|>|>|g; |
| $x =~ s|\\\\|<literallayout>\n</literallayout>|g; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWTEX: (.*?)~~~~~~~~||gse; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWDBX: (.*?)~~~~~~~~|unhexit($1)|gse; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWRTF: (.*?)~~~~~~~~||gse; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWHTML: (.*?)~~~~~~~~||gse; |
| $x =~ s|\^\^\^\^|<|g; |
| $x =~ s|~~~~|>|g; |
| $x =~ s|\*(\S.*?\S)\*|<emphasis role="bold">$1</emphasis>|gs; |
| $x =~ s|([\s\(])\+([a-z].*?\w)\+|$1<emphasis>$2</emphasis>|gsi; |
| $x =~ s|~(\S.*?\S)~|<computeroutput>$1</computeroutput>|gs; |
| $x =~ s|~([/\#\$\w-].*?[\w\)])~|<computeroutput>$1</computeroutput>|gs; |
| #$x =~ s|~(\S.*?\S)~|<literal>$1</literal>|gs; |
| #$x =~ s|\+(\S.*?\S)\+|<command>$1</command>|gs; |
| #$x =~ s|!(\S.*?\S)!|<replaceable>$1</replaceable>|gs; |
| #$x =~ s|\[(\S.*?\S)\]|[<link linkend="$1">$1</link>]|gs; # biblio refs |
| $x =~ s|\[(\w.*?[\w.])\]|<xref linkend="$1"/>|gs; # biblio refs |
| |
| # convert LaTeX leftovers to something reasonable |
| $x =~ s|\\mu|µ|gs; |
| $x =~ s|\\acute\{a\}|á|gs; |
| $x =~ s|\\times| x |gs; |
| $x =~ s|\\:| |gs; |
| $x =~ s|(?<!\\)\^\{([^\{\}]+)\}|<sup>$1</sup>|gs if $x =~ /\$/; # *** different for dbx? |
| $x =~ s|(?<!\\)\^(\w)|<sup>$1</sup>|gs if $x =~ /\$/; |
| $x =~ s|(?<!\\)_\{([^\{\}]+)\}|<sub>$1</sub>|gs if $x =~ /\$/; |
| $x =~ s|(?<!\\)_(\w)|<sub>$1</sub>|gs if $x =~ /\$/; |
| $x =~ s/!\\/\\/g; # Backslash escape |
| $x =~ s|\$||gs; |
| $x =~ s|<dollari>|\$|gs; |
| $x =~ s|<ampersandi>|&|gs; |
| $x =~ s|\\pm |±|gs; |
| $x =~ s|\\isotope\{(\d+)\}\{(\w+)\}|<sup>$1</sup>$2|gs; |
| $x =~ s/\\[a-z]+(\[[^]]+\])*(\{[^}]+\})*//gsi; # most LaTeX macros |
| $x =~ s/\\{/{/gs; |
| $x =~ s/\\}/}/gs; |
| $x =~ s%====%_%g; |
| |
| return dbx_entity_escape($x); |
| } |
| |
| sub dbx_para { |
| my $x = &dbx_para_raw; |
| return '' if $x =~ /^\s*$/s; |
| my $prepara = $para_started ? '' : '<para>'; |
| return "$prepara$x</para>"; |
| } |
| |
| sub dbx_format { |
| return &dbx_para_raw; |
| } |
| |
| ### |
| ### NONL formatting |
| ### |
| |
| sub nonl_format { |
| my $x = join ' ', @_; |
| return "\n" unless length $x; |
| local ($1,$2,$3,$4,$5,$6,$7,$8,$9); |
| |
| if ($fn_style) { |
| #$x =~ s%<<footnote:\s*(.*?)\s*>>%<<footnote: $1>>%gse; |
| } else { |
| $x =~ s%<<footnote:\s*(.*?)\s*>>%%gs; |
| } |
| $x =~ s%<<feedbackopts:.*?>>%%gs; |
| # 1 1 2 2 3 3 |
| $x =~ s%<<addfeedbacktop:(\w+):([^:]+):\s*(.*?)\s*>>%%gse; |
| $x =~ s%<<addfeedbackbot:(\w+):([^:]+):\s*(.*?)\s*>>%%gse; |
| # 1 1 2 2 3 3 4 4 |
| $x =~ s%<<infobox:(\w+):([^:]*):([^:]*):\s*(.*?)\s*>>%%gse; |
| $x =~ s%<<label:\s*(.*?)\s*>>%%gs; |
| $x =~ s%<<link:(.*?)(:\s+(.*?))?\s*>>%defined($3)?$3:$1%gsex; |
| $x =~ s/\(\*\*\*(.*?)\)//gs; |
| |
| # 1 2 34 5 6 7 8 |
| #$x =~ s%<<(\S*?(\.((gif)|(jpe?g)|(svg)|(png)|(e?ps))))>>%^^^^img href="$1"/~~~~%gsx; |
| $x =~ s%<<tt:\s*(.*?)>>%$1%gsex; |
| $x =~ s%<<italic:\s*(.*?)>>%$1%gs; |
| $x =~ s%<<bold:\s*(.*?)>>%$1%gs; |
| #$x =~ s%<<seeix:\s*(\S[^:>]*):\s*(\S[^>]*)>>%^^^^a href="#$1"~~~~$2^^^^/a~~~~%gs; # Combined index and ref |
| |
| # Fredrik Jonsson: Store reference as <see:ref> in html document for future resolving |
| #$x =~ s%<<see:\s*(\S[^>]*?)(?::\s+(\S[^>]*))?>>%"^^^^see:?:". fold_label($1) . "=$2~~~~"%gse; |
| |
| $x =~ s%<<ix:\s*([^>]+)>>%$1%gs; # index entry |
| $x =~ s%<<ixx:\s*([^>]+)>>%%gs; # hidden index entry |
| $x =~ s%<<ref:\s*([^:]+): (.*?)>>%$2%gs; |
| $x =~ s|\\\\|\n|g; |
| |
| $x =~ s|\*(\S.*?\S)\*|$1|gs; # bold |
| $x =~ s{(\A|\s|\()\+([a-z].*?[\w.])\+}{$1$2}gsi; # italic |
| $x =~ s|(?<!~)~([/\#\$\w-].*?[\w\)\}:])~(?!~)|$1|gsex; # computer output |
| $x =~ s|<<RAWTEX: (.*?)>>||gse; |
| $x =~ s|<<RAWDBX: (.*?)>>||gse; |
| $x =~ s|<<RAWRTF: (.*?)>>||gse; |
| $x =~ s|<<RAWHTML: (.*?)>>||gse; |
| |
| #$x =~ s|~(\w.*?\w)~|<literal>$1</literal>|gs; |
| #$x =~ s|\+(\w.*?\w)\+|<command>$1</command>|gs; |
| #$x =~ s|!(\w.*?\w)!|<replaceable>$1</replaceable>|gs; |
| #$x =~ s|\[(\w.*?\w)\]|[<link linkend="$1">$1</link>]|gs; # biblio refs |
| #$x =~ s|\[(\w.*?[\w.])\]|$1|gsex; # biblio refs |
| #$x =~ s|||gs; |
| |
| # convert LaTeX leftovers to something reasonable |
| $x =~ s|\\mu|µ|gs; |
| $x =~ s|\\acute\{a\}|á|gs; |
| $x =~ s|\\times| x |gs; |
| $x =~ s|\\:| |gs; |
| $x =~ s|(?<!\\)\^\{([^\{\}]+)\}|$1|gs if $x =~ /\$/; |
| $x =~ s|(?<!\\)\^(\w)|$1|gs if $x =~ /\$/; |
| $x =~ s|(?<!\\)_\{([^\{\}]+)\}|$1|gs if $x =~ /\$/; |
| $x =~ s|(?<!\\)_(\w)|$1|gs if $x =~ /\$/; |
| $x =~ s/!\\/\\/g; # Backslash escape |
| $x =~ s|\$||gs; |
| $x =~ s|<dollari>|\$|gs; |
| $x =~ s|<ampersandi>|&|gs; |
| $x =~ s|\\pm |±|gs; |
| $x =~ s|\\isotope\{(\d+)\}\{(\w+)\}|$1 $2|gs; |
| $x =~ s/\\[a-z]+(\[[^]]+\])*(\{[^}]+\})*//gsi; # most LaTeX macros |
| $x =~ s/\\{/{/gs; |
| $x =~ s/\\}/}/gs; |
| $x =~ s%====%_%g; |
| |
| return $x; |
| } |
| |
| sub nonl_para { |
| my $x = &nonl_format; |
| $x =~ s/\r?\n\r?\n/<<PAR>>/g; |
| $x =~ s/\s*\r?\n/ /g; |
| $x =~ s/<<PAR>>/\n\n/g; |
| return $x; |
| } |
| |
| sub pdseal_para { |
| my $x = join ' ', @_; |
| $x =~ s|\\\\||g; |
| $x =~ s%<<footnote:\s*(.*?)\s*>>%%gs; |
| $x =~ s%<<see:\s*(\S[^>]*?)(?::\s+(\S[^>]*))?>>%%gse; |
| $x = &nonl_format($x); |
| $x =~ s/\r?\n\r?\n/<<PAR>>/g; |
| $x =~ s/\s*\r?\n/ /g; |
| $x =~ s/<<PAR>>/\n\n/g; |
| return $x; |
| } |
| |
| ### |
| ### RTF formatting |
| ### |
| |
| sub rtf_format_infobox { |
| my ($id,$link,$tableargs,$content) = @_; |
| return $content; |
| } |
| |
| sub rtf_para_raw { |
| my $x = join ' ', @_; |
| return "\n" unless length $x; |
| local ($1,$2,$3,$4,$5,$6,$7,$8,$9); |
| |
| if ($fn_style == 3) { |
| $x =~ s%<<footnote:\s*(.*?)\s*>>%$fn_num++,qq({\\*\\footnote $1})%gse; |
| } elsif ($fn_style == 1) { |
| $x =~ s%<<footnote:\s*(.*?)\s*>>%$fn_num++,qq(\\chftn{\\*\\footnote {\\up6\\chftn } $1})%gse; |
| #$x =~ s%<<footnote:\s*(.*?)\s*>>%$fn_num++,qq([*** fn$fn_num: $1 ***])%gse; |
| } else { |
| $x =~ s%<<footnote:\s*(.*?)\s*>>%%gs; |
| } |
| $x =~ s%<<feedbackopts:.*?>>%%gs; |
| $x =~ s%<<addfeedbacktop:.*?>>%%gs; |
| $x =~ s%<<addfeedbackbot:.*?>>%%gs; |
| $x =~ s%<<infobox:(\w+):([^:]*):([^:]*):\s*(.*?)\s*>>%rtf_format_infobox($1,$2,$3,$4)%gse; |
| $x =~ s/\(\*\*\*(.*?)\)//gs; |
| |
| # 1 2 34 5 6 7 8 |
| $x =~ s%<<(\S*?(\.((gif)|(jpe?g)|(svg)|(png)|(e?ps))))>>% |
| $inline_open^^^^imagedata fileref="$1"/~~~~$inline_close%gsx; |
| $x =~ s%<<tt:\s*(.*?)>>%{\\f2 $1}%gs; |
| $x =~ s%<<bold:\s*(.*?)>>%{\\b $1}%gs; |
| $x =~ s%<<italic:\s*(.*?)>>%{\\i $1}%gs; |
| $x =~ s%<<see:\s*(\S[^>]*?)(?::\s+(\S[^>]*))?>>%qq(^^^^xref linkend=") . fold_label($1) . qq("/~~~~)%gse; |
| $x =~ s%<<ix:\s*([^>]+)>>%{\\xe $1}%gs; # index entry |
| $x =~ s%<<ref:\s*([^:]+): (.*?)>>%<xref linkend="$2"/>%gs; # *** should do proper ref |
| $x =~ s|<(/?\w.*?/?)>|^^^^$tag_tag~~~~<$1>^^^^/$tag_tag~~~~|gs; |
| # *** add URL, email, and file path detection |
| $x =~ s|\\\\|\\ql\\line |g; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWTEX: (.*?)~~~~~~~~||gse; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWDBX: (.*?)~~~~~~~~||gse; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWRTF: (.*?)~~~~~~~~|unhexit($1)|gse; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWHTML: (.*?)~~~~~~~~||gse; |
| $x =~ s|\^\^\^\^|<|g; |
| $x =~ s|~~~~|>|g; |
| $x =~ s<\*(\S.*?\S)\*><{\\b $1}>gs; # bold |
| $x =~ s<(\A|\s|\()\+([a-z].*?[\w.])\+><$1\{\\i $2\}>gsi; # italic |
| #$x =~ s|([\s\(])\+([a-z].*?\w)\+|$1{\\i $2}|gsi; # Italic *** |
| $x =~ s|~(\S.*?\S)~|{\\f2 $1 }|gs; |
| $x =~ s|~([/\#\$\w-].*?[\w\)])~|{\\f2 $1 }|gs; |
| #$x =~ s|~(\S.*?\S)~|<literal>$1</literal>|gs; |
| #$x =~ s|\+(\S.*?\S)\+|<command>$1</command>|gs; |
| #$x =~ s|!(\S.*?\S)!|<replaceable>$1</replaceable>|gs; |
| #$x =~ s|\[(\S.*?\S)\]|[<link linkend="$1">$1</link>]|gs; # biblio refs |
| $x =~ s|\[(\w.*?[\w.])\]|<xref linkend="$1"/>|gs; # biblio refs |
| |
| # convert LaTeX leftovers to something reasonable |
| $x =~ s|\\mu|µ|gs; |
| $x =~ s|\\acute\{a\}|á|gs; |
| $x =~ s|\\times| x |gs; |
| $x =~ s|\\:| |gs; |
| $x =~ s|(?<!\\)\^\{([^\{\}]+)\}|{\\up $1}|gs if $x =~ /\$/; |
| $x =~ s|(?<!\\)\^(\w)|{\\up $1}|gs if $x =~ /\$/; |
| $x =~ s|(?<!\\)_\{([^\{\}]+)\}|{\\dn $1}|gs if $x =~ /\$/; |
| $x =~ s|(?<!\\)_(\w)|{\\dn $1}|gs if $x =~ /\$/; |
| $x =~ s/!\\/\\/g; # Backslash escape |
| $x =~ s|\$||gs; |
| $x =~ s|<dollari>|\$|gs; |
| $x =~ s|<ampersandi>|&|gs; |
| $x =~ s|\\pm |±|gs; |
| $x =~ s|\\isotope\{(\d+)\}\{(\w+)\}|<sup>$1</sup>$2|gs; |
| #$x =~ s/\\[a-z]+(\[[^]]+\])*(\{[^}]+\})*//gsi; # most LaTeX macros |
| $x =~ s/\\{/{/gs; |
| $x =~ s/\\}/}/gs; |
| $x =~ s%====%_%g; |
| |
| return $x; |
| } |
| |
| sub rtf_para { |
| my $x = &rtf_para_raw; |
| return '' if $x =~ /^\s*$/s; |
| #my $prepara = $para_started ? '' : '\\par '; |
| #return "$prepara$x"; |
| #return "{\\pard $rtf_styles{'s10'} \\s10 $x\\par}\n"; |
| |
| # We want the paragraphs to inherit style from containg unit, e.g. to preserve |
| # list indentation. |
| return "{$x\\par}\\fi0\n"; |
| } |
| |
| sub rtf_format { |
| return &rtf_para_raw; |
| } |
| |
| ### |
| ### HTML formatting |
| ### |
| |
| sub tag { |
| my ($tag, $cont) = @_; |
| if ($cont) { |
| my ($thetag) = split /\s+/, $tag, 2; |
| return qq(^^^^$tag~~~~$cont^^^^/$thetag~~~~); |
| } else { |
| return qq(^^^^$tag~~~~); |
| } |
| } |
| |
| sub html_format_func { |
| my ($ret, $func, $args) = @_; |
| my $proto = "$ret$func($args)"; |
| #warn "CANDIDATE html func($func)\n"; |
| return $proto if $not_a_path{$proto}; |
| #return "$ret$func($args)" if !$pdflag{'autoformat'}; |
| $proto =~ s%_%====%g; |
| #warn "html func($func)\n"; |
| return tag('i', $proto); |
| } |
| |
| sub html_format_email { |
| my ($uid, $dom) = @_; |
| my $addr = "$uid\@$dom"; |
| return $addr if $not_a_path{$addr} || $not_a_url{$addr}; |
| #warn "email uid($uid) dom($dom)\n"; |
| #return "$uid\@$dom" if !$pdflag{'autoformat'}; |
| $addr =~ s%_%====%g; |
| $addr =~ s|\.|''''|g; |
| return tag(qq(a href="mailto:$addr"), "$addr"); |
| } |
| |
| sub html_format_url { |
| my ($url, $what) = @_; |
| return $url if $not_a_path{$url} || $not_a_url{$url}; |
| #warn "url($url) $what\n"; |
| #return $url if !$pdflag{'autoformat'}; |
| $url =~ s%_%====%g; |
| $url =~ s|\.|''''|g; |
| $url =~ s|/|""""|g; |
| my $link = $url; |
| $link = 'http://'.$link if $link !~ m{:""""""""}; |
| return tag(qq(a href="$link"), $url); |
| } |
| |
| sub html_format_country_url { |
| my ($url, $cc, $what) = @_; |
| return $url if $not_a_country{$cc}; |
| return $url if $not_a_path{$url} || $not_a_url{$url}; |
| #warn "url($url) cc($cc) $what"; |
| return html_format_url($url); |
| } |
| |
| sub html_format_path { |
| my ($path,$what) = @_; |
| return $path if $not_a_path{$path}; |
| return $path if $path=~m|^[0-9/.,-]+$|s; # Avoid pure numbers like 12/34 or 1.2 |
| #warn "path($path) $what"; |
| $path =~ s%_%====%g; |
| $path =~ s|\.|''''|g; |
| $path =~ s|/|""""|g; |
| return tag('tt', $path); |
| } |
| |
| sub html_format_ip { |
| my ($path,$what) = @_; |
| return $path if $not_a_path{$path}; |
| return $path if $path=~m|^\d+\.\d+\.?$|s; # Avoid pure numbers like 1.2 |
| return $path if $path=~m|^\d+\.\d+\.\d+\.?$|s; # Avoid pure numbers like 1.2.3 |
| #warn "path($path) $what"; |
| $path =~ s%_%====%g; |
| $path =~ s|\.|''''|g; |
| $path =~ s|/|""""|g; |
| return tag('tt', $path); |
| } |
| |
| sub html_format_ref { |
| my ($ref) = @_; |
| return qq([$ref]); |
| } |
| |
| sub html_format_tt { |
| my ($tt) = @_; |
| $tt =~ s/\$/^^^^dollari~~~~/gs; |
| return tag('tt', $tt); |
| } |
| |
| sub html_format_fn { |
| my ($note) = @_; |
| ++$fn_num; |
| $note =~ s/\"/^^^^ampersandi~~~~quot;/gs; # Quote friendly |
| $note =~ s%</?\w+.*?>%%gs; # Zap tags such as <i> or <tt> |
| #warn "FN($note)"; |
| $note = " (($note))"; # Renders much more naturally |
| return tag(qq(img src="fn.png" title="$note" alt="$note")); |
| } |
| |
| sub html_format_infobox { |
| my ($id,$link,$tableargs,$content) = @_; |
| #$note =~ s/\"/^^^^ampersandi~~~~quot;/gs; # Quote friendly |
| #$note =~ s%</?\w+.*?>%%gs; # Zap tags such as <i> or <tt> |
| #warn "infobox($note)"; |
| $content =~ s/</^^^^/gs; |
| $content =~ s/>/~~~~/gs; |
| if (length($link)) { |
| return tag(qq(a href="#" onClick="vis('$id',$id=!$id);")).$link.tag('/a') |
| .tag(qq(table id=$id $tableargs)).tag('tr').tag('td').$content |
| .tag('/td').tag('/tr').tag('/table'); |
| } else { |
| return tag(qq(table id=$id $tableargs)).tag('tr').tag('td').$content |
| .tag('/td').tag('/tr').tag('/table'); |
| } |
| } |
| |
| sub html_format_addfeedback { |
| my ($vis,$link,$title) = @_; |
| return '' if !$vis; |
| my $templ = readall('pdblogcom.html'); |
| $templ =~ s/!!LINK/$link/gs; |
| $templ =~ s/!!TIT/$title/gs; |
| $templ =~ s/!!BASE/$base/gs; |
| $templ =~ s/</^^^^/gs; |
| $templ =~ s/>/~~~~/gs; |
| return $templ; |
| } |
| |
| sub html_biblio { |
| my ($bibref) = @_; |
| return '['.$biblio.']' if $not_a_path{$biblio}; |
| return qq([<a href="#$bibref"/>$1</a>]); |
| } |
| |
| sub html_format { |
| my $x = join ' ', @_; |
| return "\n" unless length $x; |
| local ($1,$2,$3,$4,$5,$6,$7,$8,$9); |
| |
| if ($fn_style) { |
| $x =~ s%<<footnote:\s*(.*?)\s*>>%html_format_fn($1)%gse; |
| } else { |
| $x =~ s%<<footnote:\s*(.*?)\s*>>%%gs; |
| } |
| $x =~ s%<<feedbackopts:.*?>>%%gs; |
| # 1 1 2 2 3 3 |
| $x =~ s%<<addfeedbacktop:(\w+):([^:]+):\s*(.*?)\s*>>%html_format_addfeedback($1,$2,$3)%gse; |
| $x =~ s%<<addfeedbackbot:(\w+):([^:]+):\s*(.*?)\s*>>%html_format_addfeedback($1,$2,$3)%gse; |
| # 1 1 2 2 3 3 4 4 |
| $x =~ s%<<infobox:(\w+):([^:]*):([^:]*):\s*(.*?)\s*>>%html_format_infobox($1,$2,$3,$4)%gse; |
| $x =~ s%<<label:\s*(.*?)\s*>>%^^^^a id="$1"~~~~^^^^/a~~~~%gs; |
| $x =~ s%<<link:(.*?)(:\s+(.*?))?\s*>>%qq(^^^^a href="$1"~~~~).(defined($3)?$3:$1).'^^^^/a~~~~'%gsex; |
| $x =~ s/\(\*\*\*(.*?)\)//gs; |
| |
| if ($pdflag{'autoformat'} == 1) { |
| # function and email detection |
| # 1 12 2 3 3 4 4 5 5 |
| $x =~ s{(\A|\s|\()([a-z0-9_:]+=)?([a-z0-9_.:-]+)\(([a-z0-9_:, -]*)\)([,.!?\)]?)(?=\s|\Z)}{$1.html_format_func($2,$3,$4).$5}gisex; |
| # 1 12 2 3 34 4 |
| $x =~ s{(\A|\s|\(|\<)([a-z0-9_.-]+)\@([a-z0-9_.-]+?)([,.!?\)\>]?)(?=\s|\Z)}{$1.html_format_email($2,$3).$4}gisex; |
| |
| # URL and domain name detection |
| # 1 12 23 3 |
| $x =~ s{(\A|\s|\()([a-z]+://[a-z0-9][a-z0-9_.:/?&=+%\#-]+)([,.!?\)]?)(?=\s|\Z)}{$1.html_format_url($2,"proto2://$3/").$3}gisex; |
| # 1 12 23 3 |
| $x =~ s{(\A|\s|\()(www\.[a-z0-9_-]+\.[a-z0-9][a-z0-9_.:/?&=+%-]+)([,.!?\)]?)(?=\s|\Z)}{$1.html_format_url($2,'www').$3}gisex; |
| # 1 12 23 3 |
| $x =~ s{(\A|\s|\()(ftp\.[a-z0-9_-]+\.[a-z0-9][a-z0-9_.:/?&=+%-]+)([,.!?\)]?)(?=\s|\Z)}{$1.html_format_url($2,'ftp').$3}gisex; |
| # 1 12 3 3 24 4 |
| $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; |
| $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; |
| $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; |
| |
| # 1 12 3 34 4 25 5 |
| $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; |
| #warn "==[$x]=="; |
| |
| # file path detection |
| # 1 12 23 3 |
| $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; |
| # 1 12 23 3 |
| $x =~ s{(\A|\s|\()(~?[a-z0-9_.-]*/[a-z0-9_./-]*?)([,.!?\)]{0,2})(?=\s|\Z)}{$1.html_format_path($2,"path2($3)").$3}gisex; |
| # 1 12 23 34 term 4 URN detect |
| $x =~ s{(\A|\s|\()(urn:[a-z0-9_./:-]*?)([,.!?\)]{0,2})(?=\s|\Z)}{$1.html_format_path($2,"urn($3)").$3}gisex; |
| # 1 12 23 3 |
| $x =~ s{(\A|\s|\()(\d+\.[\d./*]+)([,.!?\)]{0,2})(?=\s|\Z)}{$1.html_format_ip($2,"ip($3)").$3}gisex; |
| } |
| |
| # 1 2 34 5 6 7 8 |
| $x =~ s%<<(\S*?(\.((gif)|(jpe?g)|(svg)|(png)|(e?ps))))>>%^^^^img href="$1"/~~~~%gsx; |
| $x =~ s%<<tt:\s*(.*?)>>%html_format_tt($1)%gsex; |
| $x =~ s%<<italic:\s*(.*?)>>%^^^^i~~~~$1^^^^/i~~~~%gs; |
| $x =~ s%<<bold:\s*(.*?)>>%^^^^b~~~~$1^^^^/b~~~~%gs; |
| $x =~ s%<<br:\s*>>%^^^^br~~~~%gs; |
| $x =~ s%<<seeix:\s*(\S[^:>]*):\s*(\S[^>]*)>>%^^^^a href="#$1"~~~~$2^^^^/a~~~~%gs; # Combined index and ref |
| |
| # Fredrik Jonsson: Store reference as <see:ref> in html document for future resolving |
| $x =~ s%<<see:\s*(\S[^>]*?)(?::\s+(\S[^>]*))?>>%"^^^^see:?:". fold_label($1) . "=$2~~~~"%gse; |
| |
| $x =~ s%<<ix:\s*([^>]+)>>%$1%gs; # index entry |
| $x =~ s%<<ixx:\s*([^>]+)>>%%gs; # hidden index entry |
| $x =~ s%<<ref:\s*([^:]+): (.*?)>>%$2%gs; # *** should do proper ref |
| $x =~ s|<(/?\w.*?/?)>|^^^^$tag_tag~~~~<$1>^^^^/$tag_tag~~~~|gs; |
| $x =~ s%((?<!\S)\@[a-z0-9-]+)%html_format_tt($1)%gsexi; # XML or HTML @attribute |
| $x =~ s|&|&|g; |
| $x =~ s|<|<|g; |
| $x =~ s|>|>|g; |
| $x =~ s|\\\\|^^^^br~~~~|g; |
| $x =~ s|''''|.|g; |
| $x =~ s|""""|/|g; |
| |
| $x =~ s|\*(\S.*?\S)\*|^^^^b~~~~$1^^^^/b~~~~|gs; # bold |
| $x =~ s{(\A|\s|\()\+([a-z].*?[\w.])\+}{$1^^^^i~~~~$2^^^^/i~~~~}gsi; # italic |
| $x =~ s|(?<!~)~([/\#\$\w-].*?[\w\)\}:])~(?!~)|html_format_tt($1)|gsex; # computer output |
| $x =~ s|\^\^\^\^\^\^\^\^RAWTEX: (.*?)~~~~~~~~||gse; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWDBX: (.*?)~~~~~~~~||gse; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWRTF: (.*?)~~~~~~~~||gse; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWHTML: (.*?)~~~~~~~~|unhexit($1)|gse; |
| $x =~ s|\^\^\^\^|<|g; |
| $x =~ s|~~~~|>|g; |
| |
| #$x =~ s|~(\w.*?\w)~|<literal>$1</literal>|gs; |
| #$x =~ s|\+(\w.*?\w)\+|<command>$1</command>|gs; |
| #$x =~ s|!(\w.*?\w)!|<replaceable>$1</replaceable>|gs; |
| #$x =~ s|\[(\w.*?\w)\]|[<link linkend="$1">$1</link>]|gs; # biblio refs |
| $x =~ s|\[(\w.*?[\w.])\]|html_biblio($1)|gsex; # biblio refs |
| #$x =~ s|||gs; |
| |
| # convert LaTeX leftovers to something reasonable |
| $x =~ s|\\mu|µ|gs; |
| $x =~ s|\\acute\{a\}|á|gs; |
| $x =~ s|\\times| x |gs; |
| $x =~ s|\\:| |gs; |
| $x =~ s|(?<!\\)\^\{([^\{\}]+)\}|<sup>$1</sup>|gs if $x =~ /\$/; |
| $x =~ s|(?<!\\)\^(\w)|<sup>$1</sup>|gs if $x =~ /\$/; |
| $x =~ s|(?<!\\)_\{([^\{\}]+)\}|<sub>$1</sub>|gs if $x =~ /\$/; |
| $x =~ s|(?<!\\)_(\w)|<sub>$1</sub>|gs if $x =~ /\$/; |
| $x =~ s/!\\/\\/g; # Backslash escape |
| $x =~ s|\$||gs; |
| $x =~ s|<dollari>|\$|gs; |
| $x =~ s|<ampersandi>|&|gs; |
| $x =~ s|\\pm |±|gs; |
| $x =~ s|\\isotope\{(\d+)\}\{(\w+)\}|<sup>$1</sup>$2|gs; |
| $x =~ s/\\[a-z]+(\[[^]]+\])*(\{[^}]+\})*//gsi; # most LaTeX macros |
| $x =~ s/\\{/{/gs; |
| $x =~ s/\\}/}/gs; |
| $x =~ s%====%_%g; |
| |
| return $x; |
| } |
| |
| sub html_para { |
| my $x = &html_format; |
| return '' if $x =~ /^\s*$/s; |
| my $prepara = $para_started ? '' : '<p>'; |
| return "$prepara$x</p>"; |
| } |
| |
| |
| ### |
| ### TeX Special Character Escaping |
| ### |
| |
| sub tex_esc_verbatim { |
| my ($x) = @_; |
| local ($1,$2); |
| #$x =~ s/(\r?\n)+//s; # *** only zap first CRNL? |
| return $x; |
| $x =~ s/([\&])/\\$1/g; # fjon wants to abolish this |
| #$x =~ s/\\/\$\\backslash\$/g; More useful to permit customization |
| $x =~ s/([\#\$\%\&\_\{\}])/\\$1/g; |
| $x =~ s/([~^])/\\$1\{\}/g; |
| $x =~ s/!\\/\$\\backslash\$/g; |
| return $x; |
| } |
| |
| sub tex_esc { |
| my ($x) = @_; |
| local ($1,$2); |
| $x =~ s/([\#\%\&\_\{\}])/\\$1/g; # \$ is needed for math |
| $x =~ s/([~^])/\\$1\{\}/g; |
| $x =~ s/!\\/\$\\backslash\$/g; |
| return $x; |
| } |
| |
| sub tex_esc_tag { |
| return "\\".$_[0].'^^^^'.tex_esc($_[1]).'````'; |
| } |
| |
| sub tex_esc_tt { |
| my ($x) = @_; |
| local ($1,$2); |
| #warn "escaping [$x]"; |
| $x =~ s/([_\$\{\}\#])/\\$1/g; # \&\% |
| $x =~ s/\[/~~~~/g; |
| $x =~ s/\]/\$\$\$\$/g; |
| $x =~ s/</::::/g; |
| $x =~ s/>/;;;;/g; |
| #$x =~ s/([~^])/\\$1\{\}/g; |
| #$x =~ s/!\\/\$\\backslash\$/g; |
| #warn "escaped [$x]"; |
| return $x; |
| } |
| |
| sub tex_esc_tt_tag { |
| return "\\".$_[0].'^^^^'.tex_esc_tt($_[1]).'````'; |
| } |
| |
| sub tex_format_func { |
| my ($ret, $func, $args) = @_; |
| my $proto = "$ret$func($args)"; |
| return $proto if $not_a_path{$proto}; |
| warn "func($func)\n"; |
| $ret = tex_esc_tt($ret); |
| $func = tex_esc_tt($func); |
| $args = tex_esc_tt($args); |
| return '\\emph^^^^' . $ret . $func . '(' . $args . ")````\\index^^^^$func\@\\emph{$func()}````"; |
| } |
| |
| sub tex_format_email { |
| my ($uid, $dom) = @_; |
| my $addr = "$uid\@$dom"; |
| return $addr if $not_a_path{$addr} || $not_a_url{$addr}; |
| warn "email uid($uid) dom($dom)\n"; |
| $uid = tex_esc_tt($uid); |
| $dom = tex_esc_tt($dom); |
| $uid =~ s|\.|''''|g; |
| $dom =~ s|\.|''''|g; |
| return "\\texttt^^^^$uid\@$dom````\\index^^^^$uid\"\@$dom````"; |
| } |
| |
| sub tex_format_url { |
| my ($url, $what) = @_; |
| return $url if $not_a_path{$url} || $not_a_url{$url}; |
| warn "url($url) $what\n"; |
| $url = tex_esc_tt($url); |
| $url =~ s|\.|''''|g; |
| $url =~ s|/|""""|g; |
| return '\\texttt^^^^' . $url . '````'; |
| } |
| |
| sub tex_format_country_url { |
| my ($url, $cc, $what) = @_; |
| #warn "url($url) cc($cc) $what"; |
| return $url if $not_a_country{$cc}; |
| return $url if $not_a_path{$url} || $not_a_url{$url}; |
| warn "url($url) cc($cc) $what\n"; |
| return tex_format_url($url); |
| } |
| |
| sub tex_format_path { |
| my ($path,$what) = @_; |
| return $path if $not_a_path{$path}; |
| return $path if $path=~m|^[0-9/.,-]+$|s; # Avoid pure numbers like 12/34 or 1.2 |
| warn "path($path) $what\n"; |
| $path = tex_esc_tt($path); |
| $path =~ s|\.|''''|g; |
| $path =~ s|/|""""|g; |
| return '\\texttt^^^^' . $path . '````'; |
| } |
| |
| sub tex_format_ip { |
| my ($path,$what) = @_; |
| return $path if $not_a_path{$path}; |
| return $path if $path=~m|^\d+\.\d+\.?$|s; # Avoid pure numbers like 1.2 |
| return $path if $path=~m|^\d+\.\d+\.\d+\.?$|s; # Avoid pure numbers like 1.2.3 |
| warn "ip($path) $what\n"; |
| $path = tex_esc_tt($path); |
| $path =~ s|\.|''''|g; |
| $path =~ s|/|""""|g; |
| return '\\texttt^^^^' . $path . '````'; |
| } |
| |
| sub tex_format_ref { |
| my ($ref) = @_; |
| #$ref =~ s/^[+*~]//; $ref =~ s/[+*~]$//; |
| $ref =~ s/^\\[a-z]+\^\^\^\^(.*?)````/$1/gsi; |
| return "\\index^^^^$ref````"; |
| } |
| |
| sub tex_format_infobox { |
| my ($id,$link,$tableargs,$content) = @_; |
| return $content; |
| } |
| |
| sub tex_esc_all { |
| my ($x) = @_; |
| $x = tex_esc_tt($x); |
| $x =~ s|\.|''''|g; |
| $x =~ s|/|""""|g; |
| return $x; |
| } |
| |
| sub tex_esc_underscore { |
| my ($x) = @_; |
| $x =~ s|_|!underscore|g; |
| return $x; |
| } |
| |
| sub tex_biblio { |
| my ($bibref) = @_; |
| return '['.$bibref.']' if $not_a_path{$bibref}; |
| return '\\cite^^^^'.$bibref.'````\\index^^^^'.$bibref.'````'; |
| } |
| |
| sub tex_format { |
| my $x = join ' ', @_; |
| return "\n" unless length $x; |
| local ($1,$2,$3,$4,$5,$6,$7,$8,$9); |
| |
| $x =~ s%<<e:\s*(.*?)>>%tex_esc_all($1)%gsex; |
| $x =~ s/\(\*\*\*(.*?)\)/push(@todo, $1),''/ges; |
| |
| #warn "--[$x]--"; |
| |
| if ($pdflag{'autoformat'} == 1) { |
| # function and email detection |
| # 1 12 2 3 3 4 4 5 5 |
| $x =~ s{(\A|\s|\()([a-z0-9_:]+=)?([a-z0-9_.:-]+)\(([a-z0-9_:, -]*)\)([,.!?\)]?)(?=\s|\Z)}{$1.tex_format_func($2,$3,$4).$5}gisex; |
| # 1 12 2 3 34 4 |
| $x =~ s{(\A|\s|\(|\<)([a-z0-9_.-]+)\@([a-z0-9_.-]+?)([,.!?\)\>]?)(?=\s|\Z)}{$1.tex_format_email($2,$3).$4}gisex; |
| |
| # URL and domain name detection |
| # 1 12 23 3 |
| $x =~ s{(\A|\s|\()([a-z]+://[a-z0-9][a-z0-9_.:/?&=+%\#-]+)([,.!?\)]?)(?=\s|\Z)}{$1.tex_format_url($2,"proto2://$3/").$3}gisex; |
| # 1 12 23 3 |
| $x =~ s{(\A|\s|\()(www\.[a-z0-9_-]+\.[a-z0-9][a-z0-9_.:/?&=+%-]+)([,.!?\)]?)(?=\s|\Z)}{$1.tex_format_url($2,'www').$3}gisex; |
| # 1 12 23 3 |
| $x =~ s{(\A|\s|\()(ftp\.[a-z0-9_-]+\.[a-z0-9][a-z0-9_.:/?&=+%-]+)([,.!?\)]?)(?=\s|\Z)}{$1.tex_format_url($2,'ftp').$3}gisex; |
| # 1 12 3 3 24 4 |
| $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; |
| $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; |
| $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; |
| |
| # 1 12 3 34 4 25 5 |
| $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; |
| #warn "==[$x]==" if $x =~ m%/var/wr/PQ%; |
| |
| # file path detection |
| # 1 pre 12 path.ext 23 post 34 term 4 |
| $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; |
| # 1 pre 12 a/b or /a/b 23 post 34 term 4 |
| $x =~ s{(\A|\s|\()(~?[a-z0-9_.-]*/[a-z0-9_./-]*?)([,.!?\)]{0,2})(?=\s|\Z)}{$1.tex_format_path($2,"path2($3)").$3}gisex; |
| |
| # 1 12 23 34 term 4 URN detect |
| $x =~ s{(\A|\s|\()(urn:[a-z0-9_./:-]*?)([,.!?\)]{0,2})(?=\s|\Z)}{$1.tex_format_path($2,"urn($3)").$3}gisex; |
| |
| # 1 12 23 34 term 4 |
| $x =~ s{(\A|\s|\()(\d+\.[\d./*]+)([,.!?\)]{0,2})(?=\s|\Z)}{$1.tex_format_ip($2,"ip($3)").$3}gisex; |
| } |
| #warn "..[$x].."; |
| |
| $x =~ s|\*(\S.*?\S)\*|\\textbf^^^^$1````|gs; # bold |
| $x =~ s{(\A|\s|\()\+([a-z].*?[\w.])\+}{$1\\emph^^^^$2````}gsi; # italic |
| $x =~ s|~([/\#\$\w-].*?[\w\)\}:])~|tex_esc_tt_tag('texttt', $1)|gsex; # computer output |
| #$x =~ s|\+(\w.*?\w)\+|\\textsf^^^^$1````|gs; # command |
| #$x =~ s|!(\w.*?\w)!|\\textsf^^^^\\emph^^^^$1````````|gs; # replaceable |
| $x =~ s%<<tt:\s*(.*?)>>%tex_esc_tt_tag('texttt', $1)%gsex; |
| $x =~ s%<<italic:\s*(.*?)>>%tex_esc_tag('emph', $1)%gsex; |
| $x =~ s%<<bold:\s*(.*?)>>%tex_esc_tag('textbf', $1)%gsex; |
| $x =~ s%<<br:\s*>>%\\\\%gs; |
| $x =~ s%<<seeix:\s*(\S[^:>]*):\s*(\S[^>]*)>>%"\\ref^^^^$1```` $2".tex_format_ref($2)%gsex; # Combined index and ref |
| # Fredrik Jonsson: Don't do anything with references yet, resolve later |
| $x =~ s%<<see:\s*(\S[^>]*?)(?::\s+(\S[^>]*))?>>%'::::see:?:' . fold_label($1) . "=$2;;;;"%gse; |
| |
| $x =~ s%<<ix:\s*(\S[^>]*)>>%$1.tex_format_ref($1)%gsex; # index entry |
| $x =~ s%<<ixx:\s*(\S[^>]*)>>%tex_format_ref($1)%gsex; # hidden index entry |
| $x =~ s%<<ref:\s*([^:]+): (.*?)>>%$2%gs; # *** should do proper ref |
| $x =~ s%([a-z])-se(?![a-z0-9])%$1\\hifen se%gi; # Portuguese ortography "faz-se" |
| |
| $x =~ s|\[(\w.*?[\w.])\]|tex_biblio($1)|gsex; # biblio refs |
| |
| #warn "BEFORE($x)" if $x =~ /sensor/; |
| #$x =~ s|(\\[a-z]+)\{(.*?)\}|$1^^^^$2````|g; |
| |
| # Escape "TeXish" programming language hash and array constructs |
| # foo{bar}, --> foo\{bar\} |
| # 1 12 2 3 3 4 4 |
| $x =~ s%(\A|\s|\()(\w+)\{([^\}]*?)\}([:,.!?\)]*)(?=\s|\Z)%$1$2\\\{$3\\\}$4%gs; |
| $x =~ s%(\A|\s|\()(\w+)\[([^\]]*?)\]([:,.!?\)]*)(?=\s|\Z)%$1$2\\\[$3\\\]$4%gs; |
| |
| if ($fn_style) { |
| $x =~ s%<<footnote:\s*(.*?)\s*>>%\\footnote{$1}%gs; |
| } else { |
| $x =~ s%<<footnote:\s*(.*?)\s*>>%%gs; |
| } |
| $x =~ s%<<feedbackopts:.*?>>%%gs; |
| $x =~ s%<<addfeedbacktop:.*?>>%%gs; |
| $x =~ s%<<addfeedbackbot:.*?>>%%gs; |
| $x =~ s%<<infobox:(\w+):([^:]*):([^:]*):\s*(.*?)\s*>>%tex_format_infobox($1,$2,$3,$4)%gse; |
| $x =~ s%<<label:\s*(.*?)\s*>>%\\label{$1}%gs; |
| $x =~ s%<<link:(.*?)(:\s+(.*?))?\s*>>%defined($3)?$3:$1%gsex; |
| $x =~ s%<<(\S*?)(\.((gif)|(jpe?g)|(svg)|(png)|(e?ps)))>>% |
| \\begin{figure}[$tex_flt_place]$includegraphics\{$1\}\\end{figure}%gs; |
| $x =~ s%(</?[a-z][^>]*?/?>)%tex_esc_tt_tag('texttt', $1)%gsexi; # XML or HTML <tag> or element |
| $x =~ s%((?<!\S)\@[a-z0-9-]+)%tex_esc_tt_tag('texttt', $1)%gsexi; # XML or HTML @attribute |
| # \\ means line break but just by passing it thru LaTeX will do the right thing |
| $x =~ s|\^\^\^\^\^\^\^\^RAWTEX: (.*?)~~~~~~~~|unhexit($1)|gse; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWDBX: (.*?)~~~~~~~~||gse; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWRTF: (.*?)~~~~~~~~||gse; |
| $x =~ s|\^\^\^\^\^\^\^\^RAWHTML: (.*?)~~~~~~~~||gse; |
| |
| $x =~ s|([¹²³¼½¾©®±÷×°])|\$$1\$|g; # Render Latin1 special chars in math mode |
| |
| # Late undo escaping on some special characters |
| $x =~ s|\^\^\^\^|{|g; |
| $x =~ s|````|}|g; |
| $x =~ s|::::|<|g; |
| $x =~ s|;;;;|>|g; |
| $x =~ s|~~~~|[|g; |
| $x =~ s|\$\$\$\$|]|g; |
| $x =~ s|''''|.|g; |
| $x =~ s|""""|/|g; |
| # vvvvvvv------ negative lookbehind for backslash |
| $x =~ s/(?<!\\)([\#\%\&])/\\$1/g; # \$ \{ \} \_ are needed for math. Be sure not to double esc. |
| $x =~ s/(?<!\\)_/\\_/g if $x !~ /\$/; |
| $x =~ s/(?<!\\)\^/\\^\{\}/g if $x !~ /\$/; |
| $x =~ s/!\\/\$\\backslash\$/g; # special escape for backslash itself: !\ |
| $x =~ s/!underscore/_/g; # special escape to support preservation of _ in <<see: la_bel>> |
| $x =~ s/!star/*/g; # special escape to support preservation of * |
| |
| # Index designated words (this gets pretty inefficient when there are hundreds of words) |
| #warn "Start indexing"; |
| my $w; |
| for $w (@ix) { |
| #warn " Index [$w]"; |
| # Regexs gets recompiled every single time. Tough. |
| if (1) { |
| $x =~ s/\\((emph)|(texttt)|(textbf))\{$w\}/\\$1\{$w\}\\index\{$ix{$w}\}/g; |
| $x =~ s/(\A|\s|\()$w([,.!?\)]?)(?=\s|\Z)/$1$w\\index\{$ix{$w}\}$2/g; |
| } else { |
| $x =~ s/\\((emph)|(texttt)|(textbf))\{$w\}/"\\$1\{$w\}".debug_ix($w)/ge; |
| $x =~ s/(\A|\s|\()$w([,.!?\)]?)(?=\s|\Z)/$1.$w.debug_ix($w).$2/ge; |
| } |
| } |
| #warn "End indexing"; |
| return $x; |
| } |
| |
| sub debug_ix { |
| my ($w) = @_; |
| my $r = "\\index\{$ix{$w}\}"; |
| warn "word($w) ix($r)"; |
| return $r; |
| } |
| |
| sub tex_para { |
| return &tex_format . "\n\n"; |
| } |
| |
| sub para { |
| print DBX &dbx_para . "\n"; |
| print NONL &nonl_para . "\n\n"; |
| print PDSEAL &pdseal_para . "\n\n"; |
| print RTF &rtf_para . "\n\n"; |
| print HTML &html_para . "\n\n"; |
| print HTML2 &html_para . "\n\n"; |
| print TEX &tex_para; |
| $para_started = 0; |
| return (); |
| } |
| |
| # sub format { |
| # if (!$para_started) { |
| # print DBX "<para>"; |
| # print HTML "<p>"; |
| # print HTML2 "<p>"; |
| # } |
| # $para_started = 1; |
| # print DBX &dbx_format . "\n\n"; |
| # print HTML &html_format . "\n\n"; |
| # print HTML2 &html_format . "\n\n"; |
| # print TEX &tex_format; |
| # } |
| |
| ### |
| ### Image handling |
| ### |
| |
| sub filenewer { |
| my ($a, $b) = @_; |
| my $a_m = (stat $a)[9] + 0; |
| my $b_m = (stat $b)[9] + 0; |
| #warn "filenewer a($a)=$a_m b($b)=$b_m"; |
| return $a_m > $b_m; |
| } |
| |
| sub fix_dia_eps_export { |
| my ($path) = @_; |
| my $x = readall("$path.eps"); |
| # Add to this table any other translations you need (open *-utf-8.eps file w/emacs) |
| $x =~ s/Ã/í/g; # iacute |
| $x =~ s/ó/ó/g; # oacute |
| $x =~ s/ú/ú/g; # uacute |
| $x =~ s/ç/ç/g; # ccedil |
| $x =~ s/ã/ã/g; # atilde |
| |
| #$x =~ s%/Courier-BoldOblique-latin1\n\s+/Courier-BoldOblique findfont\n.*?\ndefinefont pop\n%%gs; |
| writeall("$path.eps", $x); |
| } |
| |
| sub extract_dia_layers { |
| my ($path,$layers) = @_; |
| my $epspath = $path.'-'.$layers; |
| if (!-r "$path.dia") { |
| warn "x-x-x-DIA file($path.dia) missing. No conversion possible for($epspath)\n"; |
| return $epspath; |
| } |
| |
| if ((($imggen eq 'force') |
| || filenewer("$path.dia", "tex/$epspath.eps") && filenewer("$path.dia", "tex/$epspath.pdf"))) { |
| warn "-----Automatic conversion of DIA $path.dia to EPS $epspath.eps\n"; |
| unless ($dryrun) { |
| system('dia', '-t', 'eps-builtin', '-e', "tex/$epspath.eps", '-L', $layers, "$path.dia"); |
| fix_dia_eps_export("tex/$epspath"); |
| } |
| } |
| return $epspath; |
| } |
| |
| sub system_cmd { |
| if (1 || $trace) { |
| my ($pkg, $file, $line) = caller; |
| my $cmd = join ' ', @_; |
| print STDERR "$file:$line: SYSTEM($cmd)\n"; |
| } |
| return system @_ unless $dryrun; |
| } |
| |
| $gs_antialias = '-DDOINTERPOLATE -dTextAlphaBits=4 -dGraphicsAlphaBits=4'; |
| |
| sub epstopng { |
| my ($eps, $png) = @_; |
| my $f = readall($eps); |
| my ($x, $y, $m, $n) = $f =~ m{%%BoundingBox:\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)}; |
| $m -= $x; |
| $n -= $y; |
| # -r144x144 |
| # Effect correct page size and translation. Especially latter is tricky: the -c flag |
| # causes some PostScript code to be evaluated before the eps file so origin is shifted. |
| $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"; |
| system_cmd($cmd); |
| } |
| |
| sub gen_img { |
| my ($path, $hint) = @_; |
| #warn "GEN($path) pwd(" . `pwd` . ") imggen($imggen)"; |
| if (-r "$path.pdf" |
| && (($imggen eq 'force') |
| || filenewer("$path.pdf", "tex/$path.pdf"))) { |
| writeall("tex/$path.pdf", readall("$path.pdf")); |
| #warn "wrote(tex/$path.pdf)"; |
| return; |
| } |
| return if !$imggen; # -nogen |
| if ($imggen eq 'safe') { |
| return if -r "$path.pdf"; |
| } |
| |
| if (-r "$path.dot" |
| && (($imggen eq 'force') |
| || filenewer("$path.dot", "tex/$path.eps") && filenewer("$path.dot", "tex/$path.pdf"))) { |
| # apt-get install graphviz |
| warn "-----Automatic conversion of DOT $path.dot to PS\n"; |
| system_cmd('dot', '-Tps2', "$path.dot", '-o', "tex/$path.eps"); |
| } elsif (-r "$path.gp" |
| && (($imggen eq 'force') |
| || filenewer("$path.gp", "tex/$path.eps") && filenewer("$path.gp", "tex/$path.pdf"))) { |
| warn "-----Automatic conversion of GNUPLOT $path.gp to EPS\n"; |
| # N.B. gnuplot file itself must be set up to produce EPS output |
| system_cmd("cd tex && gnuplot ../$path.gp"); |
| } elsif (-r "$path.gnuplot" |
| && (($imggen eq 'force') |
| || filenewer("$path.gnuplot", "tex/$path.eps") && filenewer("$path.gnuplot", "tex/$path.pdf"))) { |
| warn "-----Automatic conversion of GNUPLOT $path.gnuplot to EPS\n"; |
| # N.B. gnuplot file itself must be set up to produce EPS output |
| system_cmd("cd tex && gnuplot ../$path.gnuplot"); |
| } elsif (-r "$path.dia" |
| && (($imggen eq 'force') |
| || filenewer("$path.dia", "tex/$path.eps") && filenewer("$path.dia", "tex/$path.pdf"))) { |
| warn "-----Automatic conversion of DIA $path.dia to EPS\n"; |
| unless ($dryrun) { |
| system_cmd('dia', '-t', 'eps-builtin', '-e', "tex/$path.eps", "$path.dia"); |
| fix_dia_eps_export("tex/$path"); |
| } |
| } elsif (-r "$path.png" |
| && (($imggen eq 'force') |
| || filenewer("$path.png", "tex/$path.eps") && filenewer("$path.png", "tex/$path.pdf") && filenewer("$path.png", "tex/$path.ppm"))) { |
| warn "-----Automatic conversion of IMAGE $path.png to PPM\n"; |
| #system("cp $path.png tex/$path.png"); # fjon wants direct copy! |
| system_cmd("pngtopnm $path.png >tex/$path.ppm"); |
| system_cmd("cp $path.png ${htmldir}i-$path.png"); |
| } elsif (-r "$path.jpg" |
| && (($imggen eq 'force') |
| || filenewer("$path.jpg", "tex/$path.eps") |
| && filenewer("$path.jpg", "tex/$path.pdf") |
| && filenewer("$path.jpg", "tex/$path.ppm"))) { |
| warn "-----Automatic conversion of IMAGE $path.jpg to EPS\n"; |
| #system("cp $path.jpg tex/$path.jpg"); # fjon wants direct copy! |
| #system("cp $path.jpg ${htmldir}i-$path.jpg"); # fjon wants direct copy! |
| system_cmd("djpeg -pnm $path.jpg >tex/$path.ppm"); |
| } elsif (-r "$path.gif" |
| && (($imggen eq 'force') |
| || filenewer("$path.gif", "tex/$path.eps") && filenewer("$path.gif", "tex/$path.pdf") && filenewer("$path.gif", "tex/$path.ppm"))) { |
| warn "-----Automatic conversion of IMAGE $path.gif to EPS\n"; |
| #system("giftopnm -pnm $path.gif >$path.ppm") unless $dryrun; |
| system_cmd("gif2ps $path.gif >tex/$path.ps"); |
| } |
| |
| if (-r "$path.ppm" |
| && (($imggen eq 'force') |
| || filenewer("$path.ppm", "tex/$path.eps") && filenewer("$path.ppm", "tex/$path.pdf"))) { |
| warn "-----Automatic conversion of IMAGE $path.ppm to EPS\n"; |
| system_cmd("pnmtops -noturn $path.ppm >tex/$path.eps"); # output $path.eps |
| } |
| if (-r "tex/$path.ppm" |
| && (($imggen eq 'force') |
| || filenewer("tex/$path.ppm", "tex/$path.eps") |
| && filenewer("tex/$path.ppm", "tex/$path.pdf"))) { |
| warn "-----Automatic conversion of IMAGE $path.ppm to EPS\n"; |
| system_cmd("pnmtops -noturn tex/$path.ppm >tex/$path.eps"); # output $path.eps |
| } |
| |
| if (-r "$path.eps" |
| && (($imggen eq 'force') |
| || filenewer("$path.eps", "tex/$path.pdf"))) { |
| warn "+++++Automatic conversion of EPS $path.eps to PDF\n"; |
| my $x = readall("$path.eps"); |
| if ($x !~ /^%%BoundingBox: /m && !$dryrun) { |
| warn "++++++++Missing BoundingBox in EPS $path.eps. Running gs to determine it.\n"; |
| system_cmd "gs -q -dSAFER -dNOPAUSE -dBATCH -sDEVICE=bbox $path.eps >/dev/null 2>bbox"; |
| my $bbox = readall('bbox'); |
| if ($bbox =~ /^%%BoundingBox: /m) { |
| rename "$path.eps" => "$path-nobbox.eps"; |
| $x =~ s/^(%%EndComments)/$bbox$1/m; |
| writeall("$path.eps", $x); |
| } else { |
| warn "Determination of BoundingBox failed: $bbox"; |
| } |
| } |
| # apt-get install texlive-font-utils |
| system_cmd("cd tex && epstopdf ../$path.eps"); |
| #if(!$dryrun){ # fjon |
| # system("epstopdf $path.eps"); |
| # system("mv $path.pdf tex/"); |
| #} |
| |
| warn "-----Automatic conversion of EPS $path.eps to PNG\n"; |
| # *** FJ 070613 - Image should always be copied if mod'd, no need to check if image exist |
| #system("convert -density 100x100 $path.eps ${htmldir}i-$path.png") unless $dryrun; |
| if (-r "${htmldir}i-$path.png") { |
| warn "++ Image already copied ++\n"; |
| } else { |
| #system("convert -density 70x70 $path.eps ${htmldir}i-$path.png") unless $dryrun; # fjon |
| epstopng("$path.eps", "${htmldir}i-$path.png") unless $dryrun; |
| } |
| return; |
| } elsif (-r "$path.ps" |
| && (($imggen eq 'force') |
| || filenewer("$path.ps", "tex/$path.pdf"))) { |
| warn "+++++Automatic conversion of PS $path.ps to PDF\n"; |
| #system('ps2pdf', "$path.ps", "tex/i-$path.pdf") unless $dryrun; # fjon |
| system_cmd('ps2pdf', "$path.ps", "tex/$path.pdf"); |
| warn "-----Automatic conversion of PS $path.ps to PNG\n"; |
| if (-r "${htmldir}i-$path.png") { |
| warn "++ Image already copied ++\n"; |
| } else { |
| epstopng("$path.ps", "${htmldir}i-$path.png") unless $dryrun; |
| } |
| return; |
| } |
| |
| if (-r "tex/$path.eps" |
| && (($imggen eq 'force') |
| || filenewer("tex/$path.eps", "tex/$path.pdf"))) { |
| warn "+++++Automatic conversion of EPS tex/$path.eps to PDF\n"; |
| my $x = readall("tex/$path.eps"); |
| if ($x !~ /^%%BoundingBox: /m && !$dryrun) { |
| warn "++++++++Missing BoundingBox in EPS $path.eps. Running gs to determine it.\n"; |
| system_cmd "gs -q -dSAFER -dNOPAUSE -dBATCH -sDEVICE=bbox $path.eps >/dev/null 2>bbox"; |
| my $bbox = readall('bbox'); |
| if ($bbox =~ /^%%BoundingBox: /m) { |
| rename "$path.eps" => "$path-nobbox.eps"; |
| $x =~ s/^(%%EndComments)/$bbox$1/m; |
| writeall("tex/$path.eps", $x); |
| } else { |
| warn "Determination of BoundingBox failed: $bbox"; |
| } |
| } |
| system_cmd("cd tex && epstopdf $path.eps"); |
| warn "-----Automatic conversion of EPS tex/$path.eps to PNG\n"; |
| if (-r "${htmldir}i-$path.png") { |
| warn "++ Image already copied ++\n"; |
| } else { |
| epstopng("tex/$path.eps", "${htmldir}i-$path.png") unless $dryrun; |
| } |
| # Old way (has problem in that it rotates landscape graphics) |
| #system("cd tex && pstopnm -ppm $path.eps") unless $dryrun; # invokes gs |
| #system("pnmtopng tex/$path.eps001.ppm >${htmldir}i-$path.png") unless $dryrun; |
| #unlink "tex/$path.eps001.ppm"; # these are huge so it behooves to rm them quickly |
| return; |
| } elsif (-r "tex/$path.ps" |
| && (($imggen eq 'force') |
| || filenewer("tex/$path.ps", "tex/$path.pdf"))) { |
| warn "+++++Automatic conversion of PS tex/$path.ps to PDF\n"; |
| system_cmd('ps2pdf', "tex/$path.ps", "tex/$path.pdf"); |
| warn "-----Automatic conversion of PS $path.ps to PNG\n"; |
| if (-r "${htmldir}i-$path.png") { |
| warn "++ Image already copied ++\n"; |
| } else { |
| epstopng("tex/$path.ps", "${htmldir}i-$path.png") unless $dryrun; |
| } |
| return; |
| } |
| warn "*****Missing image `tex/$path.pdf' or conversion to pdf failed ($hint) pd[$i]: $pd[$i]" |
| unless -r "tex/$path.pdf"; |
| } |
| |
| |
| sub massage_image { |
| my ($path, $layers, $hint) = @_; |
| if ($layers) { |
| $path = extract_dia_layers($path, $layers); |
| } |
| gen_img($path, $hint); |
| if ((!-r "tex/$path.pdf") |
| && (!-r "tex/$path.jpg") && (!-r "tex/$path.png") # fjon |
| ) { |
| warn "*****Missing image tex/$path.pdf"; |
| $path = "MISSING GRAPHIC ($path)"; |
| } |
| return $path; |
| } |
| |
| %tex_img_sizes = ( |
| n => 'keepaspectratio,', # "natural" |
| 'dbx90' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,', |
| 'dbx80' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,', |
| 'dbx70' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,', |
| 'dbx60' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,', |
| 'dbx50' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,', |
| 'dbx40' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,', |
| 'dbx30' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,', |
| 'dbx20' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,', |
| 'dbx10' => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,', |
| 1 => 'width=1.0\\textwidth,height=1.0\\textheight,keepaspectratio,', |
| 15 => 'width=0.67\\textwidth,height=0.67\\textheight,keepaspectratio,', |
| 2 => 'width=0.5\\textwidth,height=0.5\\textheight,keepaspectratio,', |
| 3 => 'width=0.33\\textwidth,height=0.33\\textheight,keepaspectratio,', |
| 4 => 'width=0.25\\textwidth,height=0.25\\textheight,keepaspectratio,', |
| 8 => 'width=0.125\\textwidth,height=0.125\\textheight,keepaspectratio,', |
| 10 => 'width=1.0\\textwidth,height=0.1\\textheight,keepaspectratio,', |
| 20 => 'width=1.0\\textwidth,height=0.2\\textheight,keepaspectratio,', |
| 30 => 'width=1.0\\textwidth,height=0.3\\textheight,keepaspectratio,', |
| 40 => 'width=1.0\\textwidth,height=0.4\\textheight,keepaspectratio,', |
| 50 => 'width=1.0\\textwidth,height=0.5\\textheight,keepaspectratio,', |
| 60 => 'width=1.0\\textwidth,height=0.6\\textheight,keepaspectratio,', |
| 70 => 'width=1.0\\textwidth,height=0.7\\textheight,keepaspectratio,', |
| 75 => 'width=0.75\\textwidth,height=0.75\\textheight,keepaspectratio,', |
| 80 => 'width=0.8\\textwidth,height=0.8\\textheight,keepaspectratio,', |
| 85 => 'width=0.85\\textwidth,height=0.85\\textheight,keepaspectratio,', |
| 90 => 'width=0.90\\textwidth,height=0.9\\textheight,keepaspectratio,', |
| 95 => 'width=0.95\\textwidth,height=0.95\\textheight,keepaspectratio,', |
| 120 => 'width=1.2\\textwidth,height=1.0\\textheight,keepaspectratio,', |
| 130 => 'width=1.3\\textwidth,height=1.1\\textheight,keepaspectratio,', |
| 140 => 'width=1.4\\textwidth,height=1.2\\textheight,keepaspectratio,', |
| 150 => 'width=1.5\\textwidth,height=1.3\\textheight,keepaspectratio,', |
| ); |
| |
| %dbx_img_sizes = ( |
| n => '', # "natural" |
| 'dbx90' => 'scale="90"', # scalefit="1" |
| 'dbx80' => 'scale="80"', |
| 'dbx70' => 'scale="70"', |
| 'dbx60' => 'scale="60"', |
| 'dbx50' => 'scale="50"', |
| 'dbx40' => 'scale="40"', |
| 'dbx30' => 'scale="30"', |
| 'dbx20' => 'scale="20"', |
| 'dbx10' => 'scale="10"', |
| 1 => 'scale="100"', |
| 15 => 'scale="67"', |
| 2 => 'scale="50"', |
| 3 => 'scale="33"', |
| 4 => 'scale="25"', |
| 8 => 'scale="12.5"', |
| 10 => 'scale="10"', |
| 20 => 'scale="20"', |
| 30 => 'scale="30"', |
| 40 => 'scale="40"', |
| 50 => 'scale="50"', |
| 60 => 'scale="60"', |
| 70 => 'scale="70"', |
| 75 => 'scale="75"', |
| 80 => 'scale="80"', |
| 85 => 'scale="85"', |
| 90 => 'scale="90"', |
| 95 => 'scale="95"', |
| ); |
| |
| %tex_units = ( |
| tw => '\\textwidth', |
| th => '\\textheight', |
| ); |
| |
| sub tex_graphics { |
| my ($siz, $path) = @_; |
| return $path if $path =~ /^MISS/; |
| return qq(\\includegraphics[$siz]{$path}); |
| } |
| |
| sub tex_caption { |
| my ($caption) = @_; |
| return '' if !$caption; |
| my $tex_caption = tex_format($caption); |
| return "\\caption{\\small $tex_caption}"; |
| } |
| |
| sub image { |
| my ($path, $caption, $pos, $siz, $trim, $layers) = @_; |
| $path = massage_image($path, $layers, 'image'); |
| |
| my $star = ''; |
| my ($w, $w_unit, $h, $h_unit, $k, $label, $tex_graphics, $tex_caption, $dbx_siz); |
| $pos ||= $tex_flt_place; |
| if ($pos =~ s/\*//) { |
| #warn "POS HAS A STAR pos($pos)"; |
| $star = '*'; |
| } |
| $siz = 1 if !$siz; |
| warn "SIZ($siz)"; |
| # 1width.d 2Unit X3height.d4Unit 5stretch |
| if (($w, $w_unit, $h, $h_unit, $stretch) = $siz =~ /^([0-9.]*)([^0-9.X]*?)X([0-9.]*)(\w*?)(S?)$/) { |
| $siz = ''; |
| if ($w) { |
| $w_unit = $tex_units{$w_unit} if $tex_units{$w_unit}; |
| $siz .= "width=$w$w_unit,"; |
| } |
| if ($h) { |
| $h_unit = $tex_units{$h_unit} if $tex_units{$h_unit}; |
| $siz .= "height=$h$h_unit,"; |
| } |
| $siz .= 'keepaspectratio,' unless $stretch; |
| chop $siz; |
| warn "SIZ($siz)"; |
| } else { |
| $dbx_siz = $dbx_img_sizes{$siz}; |
| $siz = $tex_img_sizes{$siz}; |
| warn "Bad size spec `$siz' in `<<img: $path\[...\]: $caption>>'" unless $siz; |
| } |
| $siz ||= $tex_img_sizes{1}; |
| if ($trim) { |
| #warn "TRIM TRIM TRIM [$trim]"; |
| my ($trim_left, $trim_bot, $trim_right, $trim_top) = |
| $trim =~ /L(-?\d+)B(-?\d+)R(-?\d+)T(-?\d+)/; |
| $siz .= "trim=$trim_left $trim_bot $trim_right $trim_top,"; |
| } |
| #chop $siz; |
| $siz .= 'clip'; |
| $label = fold_label($path); |
| $tex_graphics = tex_graphics($siz, $path); |
| |
| if(-e "${htmldir}i-$path.jpg"){ # fjon |
| $filename = "i-$path.jpg"; |
| } else { |
| $filename = "i-$path.png"; |
| } |
| |
| ++$n_images; |
| ++$cap_n_images; |
| print TEX "\\message{===FIG $label}"; |
| if ($caption) { |
| my $dbx_caption = dbx_format($caption); |
| ++$img_no; |
| $refname = "fig:$label"; |
| $reflist{$refname} = $img_no; |
| $refhtmlpage{$refname} = $html2; |
| |
| print NONL "Figure $img_no: $caption\n"; |
| print PDSEAL "Figure $img_no: $caption\n"; |
| print DBX <<DBX; |
| <figure id="$label" label="$img_no"> |
| <title>$dbx_caption</title> |
| <mediaobject> |
| <imageobject><imagedata fileref="$path.eps" $dbx_siz/></imageobject> |
| </mediaobject> |
| </figure> |
| DBX |
| ; |
| my $html_caption = html_format($caption); |
| print HTML qq(<p><a id="$label"><img src="$filename"></a><br>Fig-$img_no: $html_caption</p>); |
| print HTML2 qq(<p><a id="$label"><img src="$filename"></a><br>Fig-$img_no: $html_caption</p>); |
| $tex_caption = tex_caption($caption); |
| if ($pos =~ /^W(\d+)/) { |
| print TEX qq(\\begin{floatingfigure}{${1}cm}$tex_graphics$tex_caption\\vspace{3mm}\\label{fig:$label}\\end{floatingfigure}); |
| } else { |
| print TEX qq(\\begin{figure$star}[$pos]\\centering$tex_graphics$tex_caption\\label{fig:$label}\\end{figure$star}); |
| } |
| } else { |
| print DBX qq(<mediaobject><imageobject><imagedata fileref="$path.eps" $dbx_siz/></imageobject></mediaobject>); |
| print HTML qq(<p><a id="$label"><img src="$filename"></a></p>); |
| print HTML2 qq(<p><a id="$label"><img src="$filename"></a></p>); |
| if ($pos =~ /^W(\d+)/) { |
| print TEX qq(\\begin{floatingfigure}{${1}cm}$tex_graphics\\end{floatingfigure}); |
| } elsif ($pos eq 'R') { |
| print TEX qq($tex_graphics\n); |
| } else { |
| print TEX qq(\\begin{figure$star}[$pos]\\centering$tex_graphics \\end{figure$star}\n); |
| } |
| } |
| ++$sec_float_obj; |
| } |
| |
| $doubleimage_half_siz = 'width=0.5\textwidth,height=0.5\textheight,keepaspectratio'; |
| |
| # <<doubleimg: ref-tag,posspec: Text for legend |
| # image-file1: Sublegend for image 1 (will be labelled a) |
| # image-file2: Sublegend for image 2 (will be labelled b) |
| # >> |
| |
| sub doubleimage { |
| my ($label, $caption, $pos, # ref-tag,posspec: Text for legend |
| $path1, $layers1, $legend1, # image-file1: Sublegend for image 1 |
| $path2, $layers2, $legend2) = @_; # image-file2: Sublegend for image 2 |
| #warn "pos1($pos)"; |
| $path1 = massage_image($path1, $layers1, 'doubleimage 1'); |
| $path2 = massage_image($path2, $layers2, 'doubleimage 2'); |
| |
| my ($w, $w_unit, $h, $h_unit, $k, $tex_graphics, $tex_caption); |
| $pos ||= $tex_flt_place; |
| $label = fold_label($label); |
| my $tex_graphics1 = tex_graphics($doubleimage_half_siz, $path1); |
| my $tex_graphics2 = tex_graphics($doubleimage_half_siz, $path2); |
| |
| my $dbx_caption = dbx_format($caption); |
| ++$n_images; |
| ++$cap_n_images; |
| ++$img_no; |
| $refname = "fig:$label"; |
| $reflist{$refname} = $img_no; |
| $refhtmlpage{$refname} = $html2; |
| print TEX "\\message{===DBLFIG $label}"; |
| print DBX <<DBX; |
| <figure id="$label" label="$img_no"> |
| <title>$dbx_caption</title> |
| <mediaobject> |
| <imageobject><imagedata fileref="i-$path1.png"/></imageobject> |
| <imageobject><imagedata fileref="i-$path2.png"/></imageobject> |
| </mediaobject> |
| </figure> |
| DBX |
| ; |
| my $html_caption = html_format($caption); |
| my $html_dual_fig = <<HTML; |
| <table border=0> |
| <tr><td><img src="i-$path1.png"><br>(a) $legend1</td> |
| <td><img src="i-$path2.png"><br>(b) $legend2</td></tr> |
| <tr><td colspan=2><a id="$label">Fig-$img_no</a>: $html_caption</td></tr> |
| </table> |
| HTML |
| ; |
| print HTML $html_dual_fig; |
| print HTML2 $html_dual_fig; |
| |
| $tex_caption = tex_caption($caption); |
| my $tex_dbl_subfig = qq(\\mbox{\\subfigure[\\small $legend1]{$tex_graphics1}\\quad\\subfigure[\\small $legend2]{$tex_graphics2}}); |
| if ($pos =~ /^W(\d+)/) { |
| print TEX qq(\\begin{floatingfigure}{${1}cm}$tex_dbl_subfig$tex_caption\\vspace{3mm}\\label{fig:$label}\\end{floatingfigure}); |
| } else { |
| print TEX qq(\\begin{figure}[$pos]\\centering$tex_dbl_subfig$tex_caption\\label{fig:$label}\\end{figure}); |
| } |
| } |
| |
| ### |
| ### Preamble and Output phase |
| ### |
| |
| $cvsid =~ s/\$//g; |
| $dbx_credit = ''; |
| for $x (@credits) { |
| next if $x =~ /^\s*$/; |
| $y = dbx_para_raw($x); |
| $dbx_credit .= qq(<othercredit><surname>$y</surname></othercredit>\n); |
| } |
| |
| if ($history_ena eq '1:') { |
| $dbx_history = '<revhistory>'; |
| for ($j=0; $j<$#history; $j+=4) { |
| $x = $history[$j+3]; |
| $dbx_revdesc = dbx_para_raw($x); |
| $dbx_revdesc =~ s%^\s+\*%</para><para>%gm; |
| $x = $history[$j+2]; |
| $dbx_auth = dbx_entity_escape($x); # Lib simplified DocBook forbids markup |
| $dbx_history .= <<HISTORY; |
| <revision> |
| <revnumber>$history[$j]</revnumber> |
| <date>$history[$j+1]</date> |
| <authorinitials>$dbx_auth</authorinitials> |
| <revdescription> |
| <para> |
| $dbx_revdesc |
| </para> |
| </revdescription> |
| </revision> |
| HISTORY |
| ; |
| } |
| $dbx_history =~ s%<para>\s*</para>%%g; |
| $dbx_history .= '</revhistory>'; |
| } else { |
| $dbx_history = ''; |
| } |
| |
| @dbx_authors = split /(?:,?\s+and\s+)|\n/, $author; |
| for $a (@dbx_authors) { |
| $dbx_author .= '<editor><surname>' . dbx_format($a) . "</surname></editor>\n"; |
| } |
| |
| $author_squash = $author; |
| $author_squash =~ s/ä/a/g; |
| |
| #<?xml-stylesheet type="text/xsl" href="../../src/xsl/_html.xsl"?> |
| #<affiliation><orgname></orgname></affiliation> |
| print DBX <<DBX; |
| $dbxpreamble |
| <!-- WARNING: Do not edit! This file was generated on $curdate from original |
| PlainDoc (.pd) source using pd2tex of Sampo Kellomaki (sampo\@iki.fi). |
| All edits to this file will be lost when it is generated next time. --> |
| <!-- \$Id\$ --> |
| <!-- Original id: $cvsid --> |
| <!-- Author: $author_squash --> |
| <article id="$sec_id[0]" class="specification" status="draft"> |
| |
| <articleinfo> |
| <title>$doctitle</title> |
| <date>$curdate</date> |
| <edition role="Version">$version</edition> |
| <authorgroup> |
| $dbx_author |
| $dbx_credit |
| </authorgroup> |
| <abstract> |
| $dbx_abstract |
| </abstract> |
| $additionalarticleinfodbx |
| $dbx_history |
| </articleinfo> |
| DBX |
| ; |
| |
| ### See http://latex2rtf.sourceforge.net/RTF-Spec-1.0.txt |
| # http://www.boumphrey.com/rtf/rtf_tutorial_2.php |
| |
| # Preamble and font table: f0 = sans serif, f1 = serif, f2 = monospaced |
| print RTF '{\rtf1 \ansi \deff0 |
| {\fonttbl |
| {\f0\fRoman Time New Roman;} |
| {\f1\fswiss Arial;} |
| {\f2\fmodern Courier New;} |
| } |
| {\stylesheet |
| '; |
| |
| for $k (sort keys %rtf_styles) { |
| print RTF "{\\$k $rtf_styles{$k}}\n"; |
| $rtf_styles{$k} =~ s/\s+[a-z0-9]+;$//si; # Chop off style name |
| } |
| |
| print RTF '} |
| \plain \sa220 \fs24 \widowctrl \hyphauto \qj |
| |
| {\footer \pard\qc\plain\f22 \chpgn \par} |
| |
| '; |
| print RTF "$rtf_tabs\n"; |
| |
| #{\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;}} |
| |
| print RTF '{\stylesheet{\s0\snext0\nowidctlpar{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\cf0\kerning1\hich\af3\langfe2052\dbch\af4\afs24\lang1081\loch\f0\fs24\lang1033 Normal;} |
| {\s1\sbasedon16\snext17\ilvl0\outlinelevel0\sb240\sa120\keepn\b\hich\af3\dbch\af4\afs32\ab\loch\f2\fs32 Heading 1;} |
| {\s2\sbasedon16\snext17\ilvl1\outlinelevel1\sb240\sa120\keepn\i\b\hich\af3\dbch\af4\afs28\ai\ab\loch\f2\fs28 Heading 2;} |
| {\s3\sbasedon16\snext17\ilvl2\outlinelevel2\sb240\sa120\keepn\b\hich\af3\dbch\af4\afs28\ab\loch\f2\fs28 Heading 3;} |
| {\*\cs15\snext15 Numbering Symbols;} |
| {\s16\sbasedon0\snext17\sb240\sa120\keepn\hich\af3\dbch\af4\afs28\loch\f2\fs28 Heading;} |
| {\s17\sbasedon0\snext17\sb0\sa120 Text body;} |
| {\s18\sbasedon17\snext18\sb0\sa120\dbch\af5 List;} |
| {\s19\sbasedon0\snext19\sb120\sa120\noline\i\dbch\af5\afs24\ai\fs24 Caption;} |
| {\s20\sbasedon0\snext20\noline\dbch\af5 Index;} |
| {\s21\sbasedon16\snext22\qc\sb240\sa120\keepn\b\hich\af3\dbch\af4\afs36\ab\loch\f2\fs36 Title;} |
| {\s22\sbasedon16\snext17\qc\sb240\sa120\keepn\i\hich\af3\dbch\af4\afs28\ai\loch\f2\fs28 Subtitle;} |
| } |
| ' if 0; |
| |
| # Summary, like title |
| print RTF "\\ftnbj\n{\\info {\\title $doctitle}{\\author $author}} |
| |
| {\\pard $rtf_styles{'s14'} \\s14\n$doctitle\\par} |
| |
| {\\pard $rtf_styles{'s15'} \\s15\n$author\\par} |
| |
| {\\pard $rtf_styles{'s16'} \\s16\n$rtf_abstract\\par}"; |
| |
| print NONL "$doctitle\n\n"; |
| print PDSEAL "$doctitle\n\n"; |
| print NONL "$author\n\n" if $author && $author ne 'N.N.'; |
| print PDSEAL "$author\n\n" if $author && $author ne 'N.N.'; |
| if ($nonl_abstract) { |
| $nonl_abstract =~ s/\r?\n\r?\n/<<PAR>>/g; |
| $nonl_abstract =~ s/\s*\r?\n/ /g; |
| $nonl_abstract =~ s/<<PAR>>/\n\n/g; |
| print NONL "$nonl_abstract\n\n"; |
| print PDSEAL "$nonl_abstract\n\n"; |
| } |
| |
| ### |
| |
| #warn "doctitle($doctitle)"; |
| #<meta http-equiv="Content-type" content="text/html; charset=utf-8"> |
| |
| print HTML $htmlpreamble ? $htmlpreamble : <<HTML unless $nohtmlpreamb; |
| <title>$doctitle</title> |
| <link type="text/css" rel="stylesheet" href="$base.css"> |
| <body bgcolor=white> |
| <H1>$doctitle</H1> |
| HTML |
| ; |
| |
| print HTML2 <<HTML unless $nohtmlpreamb; |
| <title>$doctitle</title> |
| <body bgcolor=white> |
| <link type="text/css" rel="stylesheet" href="$base.css"> |
| <H1>$doctitle</H1> |
| HTML |
| ; |
| |
| if ($author && $author ne 'N.N.') { |
| $html_author = html_format($author); |
| print HTML "<i>$html_author</i>\n"; |
| print HTML2 "<i>$html_author</i>\n"; |
| } |
| |
| if ($abstract) { |
| print HTML "<blockquote>$html_abstract</blockquote>\n"; |
| print HTML2 "<blockquote>$html_abstract</blockquote>\n"; |
| } |
| |
| # See also: \overlay{image} for background image, or \background{color}, or \emblema{logoimg} |
| # in pdfscreen section (sec 4.8, p. 80 of lshort.pdf). |
| |
| #$tex_1st = tex_para($first_page); |
| #warn "###".$first_page."###\n"; |
| #warn "###".$tex_1st."###\n"; |
| |
| if ($makeindex) { |
| $tex_index = ($makeindex == 2) ? "\\usepackage{makeidx,showidx}" : "\\usepackage{makeidx}"; |
| $tex_index .= "\n\\makeindex\n"; |
| } |
| |
| # N.B. Add \\hbadness=10000 to disable 90% of the warnings |
| |
| print TEX <<LATEX; |
| % Generated on $curdate using pd2tex of Sampo Kellomaki (sampo\@iki.fi) |
| % Do not edit this file: your changes will be lost next time this is regenerated. |
| LATEX |
| ; |
| |
| # If the $moremoretexpreamble wants to use the enumitem package, then |
| # the enumerate must get used after that (must be done in $moremoretexpreamble). |
| # Thus we need to prevent premature use of enumerate here. |
| $usepackage_enumerate = '\\usepackage{enumerate}' |
| unless $moremoretexpreamble =~ /\\usepackage\{enumerate\}/; |
| |
| print TEX $texpreamble ? $texpreamble : <<LATEX; |
| $tex_doc_class |
| \\usepackage{floatflt} |
| \\usepackage{pslatex} |
| \\usepackage[T1]{fontenc} |
| \\usepackage[latin1]{inputenc} |
| $usepackage_enumerate |
| \\usepackage{amssymb} |
| \\usepackage{subfigure} |
| $lineno |
| \\usepackage{longtable} |
| \\usepackage[bookmarks=true,bookmarksnumbered=true,pdftex]{hyperref} |
| \\usepackage{supertabular,lscape} % fjon |
| \\usepackage{fancyvrb} % fjon |
| $vmargin |
| $pagestyle |
| \\usepackage[pdftex]{color,graphicx} |
| \\pdfpagewidth=\\paperwidth |
| \\pdfpageheight=\\paperheight |
| \\hbadness=$hbadness |
| \\newcommand{\\hifen}{\\discretionary{-}{-}{-}} |
| $tex_index |
| \\author{$author} |
| \\title{$doctitle} |
| $moretexpreamble |
| $linespace |
| $moremoretexpreamble |
| \\begin{document} |
| $maketitle |
| LATEX |
| ; |
| |
| print TEX "\\begin{slide}\n" if $class eq 'slide'; |
| |
| sec(); # recursively processes the entire document |
| |
| print DBX qq(</article>\n); |
| print RTF "}"; |
| print TEX "\\end{slide}\n" if $class eq 'slide'; |
| print TEX qq(\\end{document}\n); |
| close TEX; |
| close DBX; |
| close RTF; |
| |
| $amb = $htmlpostamble; |
| $amb =~ s/!\?!TITLE/$doctitle: $sec_no$x/gs; |
| $amb =~ s/!\?!BASE/$base/gs; |
| $amb =~ s/!\?!PREV/$prevprev/gs; |
| $amb =~ s/!\?!NEXT/$html2/gs; |
| print HTML $amb; |
| close HTML; |
| |
| $amb = $htmlpostamble2; |
| $amb =~ s/!\?!TITLE/$doctitle: $sec_no$x/gs; |
| $amb =~ s/!\?!BASE/$base/gs; |
| $amb =~ s/!\?!PREV/$prevprev/gs; |
| $amb =~ s/!\?!NEXT/$html2/gs; |
| print HTML2 $amb; |
| close HTML2; |
| |
| @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); |
| @weekDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun); |
| ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek) = localtime(); |
| $year = 1900 + $yearOffset; |
| $today = "$months[$month] $dayOfMonth, $year"; |
| # $today = join(' ', @today); |
| |
| if ($html1) { # ToC for monolith document |
| open HTML, ">$htmldir$base-toc1.html" or die "Can't open $htmldir$base-toc1.html for writing: $!"; |
| warn "Writing $htmldir$base-toc1.html"; |
| print HTML <<HTML; |
| <title>$doctitle TOC</title> |
| <link type="text/css" rel="stylesheet" href="$base.css"> |
| <body bgcolor=white> |
| <H1>$doctitle</H1> |
| $today<br><br> |
| <a href="$base.pdf" target="_top">Download as pdf</a><br> |
| <a href="index1.html" target="_top">Multi page</a> |
| <H3>Table of Contents (monolithic)</H3> |
| HTML |
| ; |
| for ($i = 0; $i <= $#html_toc_title; ++$i) { |
| print HTML qq(<a href="$html1\#$html_toc_link[$i]" target=c>$html_toc_title[$i]</a><br>\n); |
| } |
| close HTML; |
| } |
| |
| if ($html2) { # ToC for multipage document |
| open HTML2, ">$htmldir$base-toc.html" or die "Can't open $htmldir$base-toc.html for writing: $!"; |
| warn "Writing $htmldir$base-toc.html"; |
| print HTML2 <<HTML2; |
| <title>$doctitle TOC</title> |
| <link type="text/css" rel="stylesheet" href="$base.css"> |
| <body bgcolor=white> |
| <H1>$doctitle</H1> |
| $today<br><br> |
| <a href="$base.pdf" target="_top">Download as pdf</a><br> |
| <a href="index.html" target="_top">Single page</a> |
| <H3>Table of Contents</H3> |
| HTML2 |
| ; |
| for ($i = 0; $i <= $#html_toc_title; ++$i) { |
| print HTML2 qq(<a href="$html2_toc_link[$i]" target=c>$html_toc_title[$i]</a><br>\n); |
| } |
| close HTML2; |
| } |
| |
| ### |
| ### Recommended stylesheet (if you do not have one, one will be created for you) |
| ### |
| |
| $css = <<CSS |
| BODY,H1,H2,H3,H4,H5,H6,P,CENTER,TD,TH,UL,DL,DIV { |
| font-family: Geneva, Arial, Helvetica, sans-serif; |
| } |
| BODY,TD { |
| font-size: 100%; |
| } |
| BODY { |
| background-color: white; |
| color: black; |
| margin-right: 20px; |
| margin-left: 20px; |
| } |
| H1 { |
| text-align: left; |
| font-size: 160%; |
| } |
| H2 { font-size: 120%; } |
| H3 { font-size: 100%; } |
| PRE { |
| border: 1px solid #CCCCCC; |
| background-color: #f5f5f5; |
| padding-top: 4px; padding-bottom: 4px; padding-left: 6px; padding-right: 6px; |
| margin-top: 4px; margin-bottom: 4px; margin-left: 2px; margin-right: 8px; |
| } |
| a { |
| color: #1A41A8; |
| } |
| a:visited { |
| color: #2A3798; |
| } |
| HR { height: 1px; |
| border: none; |
| border-top: 1px solid black; |
| } |
| |
| TH { |
| background-color: #C0C0CA; |
| text-align : left; |
| vertical-align : bottom; |
| font-weight : bold; |
| padding-top: 2px; padding-bottom: 2px; padding-left: 10px; padding-right: 10px; |
| margin-top: 2px; margin-bottom: 2px; margin-left: 0px; margin-right: 0px; |
| border: 1px solid #CCCCCC; |
| } |
| TD { |
| background-color: #e8eef2; |
| padding-top: 2px; padding-bottom: 2px; padding-left: 10px; padding-right: 10px; |
| margin-top: 2px; margin-bottom: 2px; margin-left: 0px; margin-right: 0px; |
| border: 1px solid #CCCCCC; |
| } |
| TD.eqn { |
| background-color: white; |
| vertical-align : middle; |
| padding-top: 2px; padding-bottom: 2px; padding-left: 10px; padding-right: 10px; |
| margin-top: 2px; margin-bottom: 2px; margin-left: 0px; margin-right: 0px; |
| border: 0px solid white; |
| } |
| CSS |
| ; |
| |
| if(!-f "$htmldir$base.css") { |
| open (CSS,">$htmldir$base.css") or die "Can't open $htmldir$base.css for write:$!"; |
| warn "Writing $htmldir$base.css"; |
| print CSS $css; |
| close CSS; |
| } |
| |
| ### |
| ### Create HTML index and framesets as expected |
| ### |
| |
| if (!-f "${htmldir}index1.html") { |
| open(HTML,">${htmldir}index1.html") or die "Can't open(${htmldir}index1.html) for write:$!"; |
| warn "Writing ${htmldir}index1.html"; |
| print HTML <<HTML; |
| <title>$doctitle</title> |
| <frameset cols="300,*"> |
| <frame name=toc src="$base-toc.html"> |
| <frame name=c src="$base-front-matter.html"> |
| </frameset> |
| HTML |
| ; |
| close HTML; |
| } |
| |
| if (!-f "${htmldir}index.html") { |
| open(HTML,">${htmldir}index.html") or die "Can't open(${htmldir}index.html) for write:$!"; |
| warn "Writing ${htmldir}index.html"; |
| print HTML "<title>$doctitle</title>\n". |
| "<frameset cols=\"300,*\">\n". |
| "<frame name=toc src=\"$base-toc1.html\">\n". |
| "<frame name=c src=\"$base.html\">". |
| "</frameset>\n"; |
| close HTML; |
| } |
| |
| if ($pipemode) { |
| warn "Waiting for pdflatex process (pid $texpid) to complete.\n"; |
| waitpid $texpid,0; |
| if ($?) { |
| warn "### pdflatex error. Exit value=".($? >> 8).", sig=".($? & 0x7f).".\n"; |
| } else { |
| warn "--- pdflatex completed with success.\n"; |
| } |
| } |
| |
| warn "Total figures: $n_images\nFigures in last chapter: $cap_n_images\n"; |
| |
| exit if $nopdf; |
| |
| ### Post processing to generate the pdf document |
| |
| # *** need to check and process picture dependencies here! |
| |
| resolve_file_tex("$texdir$base.tex") unless $notex; |
| |
| chdir $texdir; |
| unless ($dryrun || $pipemode) { |
| warn "pdflatex -file-line-error-style $base.tex"; |
| system ('pdflatex', '-file-line-error-style', "$base.tex"); |
| system ("cp $base.pdf ../$htmldir"); # fjon |
| ##system ("mv $base.pdf .."); # fjon |
| #system('latex', "../$base.tex"); # fjon |
| #system('dvipdf', "$base.dvi", "../$base.pdf"); # fjon |
| |
| if ($makeindex) { |
| # Fix spurious whitespace in formatted index entries generated from table |
| $idx = readall("$base.idx"); |
| $idx =~ s/\@\\((emph)|(texttt)|(textbf))\s+\{/\@\\$1\{/g; |
| writeall("$base.idx", $idx); |
| system ('makeindex', '-q', "$base.idx"); |
| } |
| } |
| system ('acroread', "$base.pdf") if $acroread; |
| chdir '..'; # so further post processing will work! (fjon) |
| |
| ### Post process: Resolve references in html files |
| unless ($nohtml || $noref) { |
| warn "\nResolving html references\n-------------------------\n"; |
| resolve_file_html("$htmldir$base.html", 0); |
| for (<${htmldir}*.html>) { |
| resolve_file_html($_, 1); |
| } |
| } |
| |
| ### |
| ### Functions to resolve references (from fjon) |
| ### |
| |
| sub resolve_ref { |
| my ($ref, $see_caption, $quiet) = @_; |
| my($caption, $found, $page, $key, $value); |
| |
| $ref = fold_label($ref); |
| $page = ""; |
| if ($reflist{$ref}) { |
| $caption = $reflist{$ref}; |
| $page = $refhtmlpage{$ref}; |
| } else { |
| $found = 0; |
| while (($key, $value) = each(%reflist)) { |
| if($key =~ "$ref"){ |
| ++$found; |
| if ($found == 1){ |
| warn "Note: Not exact reference. '$ref' match '$key'" if !$quiet; |
| $ref = $key; |
| $caption = $value; |
| $page = $refhtmlpage{$ref}; |
| } else { |
| warn "Error: Ambigous reference. '$ref' also match '$key'" if !$quiet; |
| } |
| } |
| } |
| |
| if (!$found) { |
| warn "Error: Missing reference:$ref" if !$quiet; |
| $caption = "?$ref?"; |
| } |
| } |
| return ($ref, $see_caption || $caption, $page); |
| } |
| |
| sub format_ref_html { |
| my ($guess, $caption, $quiet) = @_; |
| my ($ref, $caption, $page) = resolve_ref($guess, $caption, $quiet); |
| if ($quiet) { |
| return "<a href=\"$page#$ref\">$caption</a>"; |
| } else { |
| return "<a href=\"#$ref\">$caption</a>"; |
| } |
| } |
| |
| sub resolve_file_html { |
| my($filename, $quiet) = @_; |
| |
| open F, $filename or die "Can not read($filename)"; |
| my($x) = <F>; |
| close F; |
| |
| #Resolve links |
| $x =~ s/<see:\?:\s*([^>]+?)(?:=([^>]*))?>/format_ref_html($1, $2, $quiet)/gse; |
| |
| #Print errors |
| if ($quiet) { |
| $x =~ s/<error:\s*([^>]+)>//gse; |
| } else { |
| $x =~ s/<error:\s*([^>]+)>/print "Error: $1\n"/gse; |
| } |
| writeall($filename, $x); |
| } |
| |
| # Reference resolution pass. Read in almost ready file and fix references, then write it out! |
| |
| sub format_ref_tex { |
| my ($see, $see_caption) = @_; |
| my ($ref, $caption) = resolve_ref($see, $caption, 1); |
| warn "see($see:$ref:$caption)"; |
| return "$see_caption\\ref{$ref}"; |
| } |
| |
| sub resolve_file_tex { |
| my($filename) = @_; |
| my $x = readall($filename); |
| $x =~ s/<see:\?:([^>]+?)(?:=([^>]*))?>/format_ref_tex($1,$2)/gse; |
| writeall($filename, $x); |
| } |
| |
| #EOF |