Subversion Repositories zxid

Compare Revisions

Regard whitespace Rev 1 → Rev 2

/debian/auth_saml.load
0,0 → 1,0
LoadModule zxid_module /usr/lib/apache2/modules/mod_auth_saml.so
/debian/changelog
0,0 → 1,6
zxid (1.22-1) unstable; urgency=low
 
* Initial release.
 
-- Magnus Holmgren <holmgren@debian.org> Sun, 15 Mar 2015 23:08:03 +0100
 
/debian/compat
0,0 → 1,0
7
/debian/control
0,0 → 1,132
Source: zxid
Section: web
Priority: optional
Standards-Version: 3.9.6
Maintainer: Magnus Holmgren <holmgren@debian.org>
Build-Depends: debhelper (>= 7), php5-dev, libssl-dev, libcurl4-openssl-dev, zlib1g-dev,
libapr1-dev, apache2-dev, dh-apache2, dh-php5, default-jdk, libservlet3.0-java, libgcrypt20-dev
 
Package: zxid
Architecture: any
Depends: libzxid0 (= ${binary:Version}), ${shlibs:Depends}, ${misc:Depends}
Description: tools for SAML 2.0 federated Single Sign-On (SSO) and ID-WSF Web Services
ZXID.org Identity Management toolkit implements standalone SAML 2.0,
Liberty ID-WSF 2.0, and XACML 2.0 stacks and aims at implementing all
popular federation, SSO, and ID Web Services protocols. Due to its
small footprint and efficient and accurate schema driven
implementation, it is suitable for embedded and high volume
applications. ZXID implements, as of Nov 2011, SP, IdP, WSC, WSP,
Discovery, PEP, and PDP roles. ZXID is the reference implementation
of the core security architecture of the TAS3.eu project.
.
This package contains the tools to set up the IdP and services
infrastructure.
 
Package: zxid-doc
Section: doc
Architecture: all
Depends: ${misc:Depends}
Description: SAML 2.0 federated Single Sign-On (SSO) and ID-WSF Web Services - documentation
ZXID.org Identity Management toolkit implements standalone SAML 2.0,
Liberty ID-WSF 2.0, and XACML 2.0 stacks and aims at implementing all
popular federation, SSO, and ID Web Services protocols. Due to its
small footprint and efficient and accurate schema driven
implementation, it is suitable for embedded and high volume
applications. ZXID implements, as of Nov 2011, SP, IdP, WSC, WSP,
Discovery, PEP, and PDP roles. ZXID is the reference implementation
of the core security architecture of the TAS3.eu project.
 
Package: libzxid0
Architecture: any
Depends: ${shlibs:Depends}, ${misc:Depends}
Description: C library for SAML 2.0 federated Single Sign-On (SSO) and ID-WSF Web Services
ZXID.org Identity Management toolkit implements standalone SAML 2.0,
Liberty ID-WSF 2.0, and XACML 2.0 stacks and aims at implementing all
popular federation, SSO, and ID Web Services protocols. Due to its
small footprint and efficient and accurate schema driven
implementation, it is suitable for embedded and high volume
applications. ZXID implements, as of Nov 2011, SP, IdP, WSC, WSP,
Discovery, PEP, and PDP roles. ZXID is the reference implementation
of the core security architecture of the TAS3.eu project.
.
This package contains the core C library.
 
Package: libzxid-dev
Section: libdevel
Architecture: any
Depends: libzxid0 (= ${binary:Version}), ${misc:Depends}
Recommends: zxid-doc
Description: C library for SAML 2.0 federated Single Sign-On (SSO) and ID-WSF Web Services - development
ZXID.org Identity Management toolkit implements standalone SAML 2.0,
Liberty ID-WSF 2.0, and XACML 2.0 stacks and aims at implementing all
popular federation, SSO, and ID Web Services protocols. Due to its
small footprint and efficient and accurate schema driven
implementation, it is suitable for embedded and high volume
applications. ZXID implements, as of Nov 2011, SP, IdP, WSC, WSP,
Discovery, PEP, and PDP roles. ZXID is the reference implementation
of the core security architecture of the TAS3.eu project.
 
Package: libapache2-mod-auth-saml
Architecture: any
Depends: libzxid0 (= ${binary:Version}), ${shlibs:Depends}, ${misc:Depends}
Description: apache2 module for SAML 2.0 authentication using libzxid
ZXID.org Identity Management toolkit implements standalone SAML 2.0,
Liberty ID-WSF 2.0, and XACML 2.0 stacks and aims at implementing all
popular federation, SSO, and ID Web Services protocols. Due to its
small footprint and efficient and accurate schema driven
implementation, it is suitable for embedded and high volume
applications. ZXID implements, as of Nov 2011, SP, IdP, WSC, WSP,
Discovery, PEP, and PDP roles. ZXID is the reference implementation
of the core security architecture of the TAS3.eu project.
.
This package contains an Apache authentication module that can be
used to set up single sign-on with no programming.
 
Package: libnet-saml-perl
Section: perl
Architecture: any
Pre-Depends: ${misc:Pre-Depends}
Depends: libzxid0 (= ${binary:Version}), ${shlibs:Depends}, ${misc:Depends}, ${perl:Depends}
Description: Perl module for SAML 2.0 authentication using libzxid
ZXID.org Identity Management toolkit implements standalone SAML 2.0,
Liberty ID-WSF 2.0, and XACML 2.0 stacks and aims at implementing all
popular federation, SSO, and ID Web Services protocols. Due to its
small footprint and efficient and accurate schema driven
implementation, it is suitable for embedded and high volume
applications. ZXID implements, as of Nov 2011, SP, IdP, WSC, WSP,
Discovery, PEP, and PDP roles. ZXID is the reference implementation
of the core security architecture of the TAS3.eu project.
.
This package contains the Perl bindings to libzxid (generated using
SWIG).
 
Package: php5-zxid
Section: php
Architecture: any
Depends: libzxid0 (= ${binary:Version}), ${shlibs:Depends}, ${misc:Depends}
Description: PHP module for SAML 2.0 authentication using libzxid
ZXID.org Identity Management toolkit implements standalone SAML 2.0,
Liberty ID-WSF 2.0, and XACML 2.0 stacks and aims at implementing all
popular federation, SSO, and ID Web Services protocols. Due to its
small footprint and efficient and accurate schema driven
implementation, it is suitable for embedded and high volume
applications. ZXID implements, as of Nov 2011, SP, IdP, WSC, WSP,
Discovery, PEP, and PDP roles. ZXID is the reference implementation
of the core security architecture of the TAS3.eu project.
.
This package contains the PHP bindings to libzxid (generated using
SWIG).
 
 
Package: libzxid-java
Section: java
Architecture: all
Depends: libzxid0-jni (>= ${binary:Version}), ${misc:Depends}, default-jre-headless
Description: Java package for SAML 2.0 authentication using libzxid
 
Package: libzxid0-jni
Section: java
Architecture: any
Depends: libzxid0 (= ${binary:Version}), ${shlibs:Depends}, ${misc:Depends}
Description: JNI package for SAML 2.0 authentication using libzxid
 
/debian/copyright
0,0 → 1,24
Copyright (c) 2012-2013 Synergetics NV (sampo@synergetics.be), All Rights Reserved.
Copyright (c) 2009-2012 Sampo Kellomaki (sampo@iki.fi), All Rights Reserved.
Copyright (c) 2006-2009 Symlabs (symlabs@symlabs.com), All Rights Reserved.
Author: Sampo Kellomaki (sampo@iki.fi)
 
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
 
http://www.apache.org/licenses/LICENSE-2.0
 
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 
The research leading to these results has received funding from the
European Community's Seventh Framework Programme (FP7/2007-2013) under
grant agreement number 216287 (TAS3 - Trusted Architecture for Securely
Shared Services - www.tas3.eu).
 
On Debian GNU/Linux systems, the complete text of the Apache License,
version 2.0, can be found in /usr/share/common-licenses/Apache-2.0.
/debian/libapache2-mod-auth-saml.apache2
0,0 → 1,0
mod debian/auth_saml.load
/debian/libapache2-mod-auth-saml.install
0,0 → 1,0
mod_auth_saml.so usr/lib/apache2/modules
/debian/libnet-saml-perl.install
0,0 → 1,2
usr/lib/*/perl5
usr/share/man/man3/*.3pm
/debian/libzxid-dev.install
0,0 → 1,4
libzxid.a usr/lib
libzxid.so usr/lib
*.h c/*.h usr/include/zxid
zx.h usr/include/zx
/debian/libzxid-java.install
0,0 → 1,0
zxidjava.jar usr/share/java
/debian/libzxid0-jni.install
0,0 → 1,0
zxidjava/libzxidjni.so usr/lib/jni
/debian/libzxid0.install
0,0 → 1,0
libzxid.so.* usr/lib
/debian/patches/build.patch
0,0 → 1,142
--- a/Makefile
+++ b/Makefile
@@ -57,6 +57,10 @@ PREFIX=/var/zxid/$(ZXIDREL)
### well. N.B. Trailing / (forward slash) is needed.
ZXID_PATH=/var/zxid/
+SHLIBLINK=libzxid.so
+SONAME=$(SHLIBLINK).0
+SHLIB=$(SONAME).0
+
###
### Module selection options (you should enable all, unless building embedded)
###
@@ -154,7 +158,7 @@ LIBS+= -lcurl -lssl -lcrypto -lz $(POSTL
### Where commands for build are found (override for cross compiler or Windows)
#CC=ccache gcc
-CC?=gcc
+CC=gcc
# If you want to override LD setting you must supply LD_ALT on command line or use localconf.mk
LD_ALT?=$(CC)
LD=$(LD_ALT)
@@ -699,7 +703,7 @@ precheck/chk-%$(EXE): precheck/chk-%.$(O
@if $(LD) $(OUTOPT)$@ $< $(LDFLAGS) $(LIBS) ; then : ; else \
echo Failed command:; echo '$(LD) $(OUTOPT)$@ $< $(LDFLAGS) $(LIBS)' ; false; fi
-%$(EXE): %.$(OBJ_EXT)
+%$(EXE): %.$(OBJ_EXT) $(SHLIBLINK)
@echo " Linking $@"
@if $(LD) $(OUTOPT)$@ $< $(LDFLAGS) $(LIBZXID) $(LIBS) ; then : ; else \
echo Failed command:; echo '$(LD) $(OUTOPT)$@ $< $(LDFLAGS) $(LIBZXID) $(LIBS)' ; false; fi
@@ -716,7 +720,7 @@ export LC_COLLATE LC_NUMERIC
DEFAULT_EXE= zxidhlo$(EXE) zxididp$(EXE) zxidhlowsf$(EXE) zxidsimple$(EXE) zxidwsctool$(EXE) zxlogview$(EXE) zxidhrxmlwsc$(EXE) zxidhrxmlwsp$(EXE) zxdecode$(EXE) zxcot$(EXE) zxpasswd$(EXE) zxcall$(EXE) zxencdectest$(EXE)
-ALL_EXE= smime$(EXE) zxidwspcgi$(EXE) zxid_httpd$(EXE) htpasswd$(EXE)
+ALL_EXE= smime$(EXE) zxidwspcgi$(EXE) zxid_httpd$(EXE) htpasswd$(EXE) zxbusd$(EXE) zxbustailf$(EXE) zxbuslist$(EXE)
#$(info DEFAULT_EXE=$(DEFAULT_EXE))
@@ -1211,8 +1215,8 @@ endif
# Overall
-samlmod Net/Makefile: Net/SAML_wrap.c Net/SAML.pm $(LIBZXID_A)
- cd Net; $(PERL) Makefile.PL && $(MAKE)
+samlmod Net/Makefile: Net/SAML_wrap.c Net/SAML.pm $(SHLIBLINK)
+ cd Net; $(PERL) Makefile.PL INSTALLDIRS=vendor && $(MAKE)
samlmod_install: Net/Makefile
cd Net; $(MAKE) install
@@ -1284,9 +1288,9 @@ php/php_zxid$(SO): php/zxid_wrap.$(OBJ_E
phpzxid: php/php_zxid$(SO)
phpzxid_install: php/php_zxid$(SO)
- @$(ECHO) Installing in `$(PHP_CONFIG) --extension-dir`
- mkdir -p `$(PHP_CONFIG) --extension-dir`
- $(CP) $< `$(PHP_CONFIG) --extension-dir`
+ @$(ECHO) Installing in $(DESTDIR)`$(PHP_CONFIG) --extension-dir`
+ mkdir -p $(DESTDIR)`$(PHP_CONFIG) --extension-dir`
+ $(CP) $< $(DESTDIR)`$(PHP_CONFIG) --extension-dir`
#cp zxid.ini `$(PHP_CONFIG) --extension-dir`
@@ -1476,7 +1480,7 @@ ZxidServlet.class: ZxidServlet.java zxid
$(JAVAC) $(JAVAC_FLAGS) -classpath $(SERVLET_PATH) zxidjava/*.java ZxidServlet.java
zxidjava.jar: zxidjava/zxidjni.class zxidjava/README.zxid-java
- $(CP) COPYING LICENSE-2.0.txt LICENSE.openssl LICENSE.ssleay LICENSE.curl zxidjava/
+ $(CP) COPYING LICENSE-2.0.txt zxidjava/
$(JAR) cf zxidjava.jar zxidjava/*.class zxidjava/*.java zxidjava/COPYING zxidjava/LICENSE*
zxiddemo.war: zxidjava.jar
@@ -1549,7 +1553,7 @@ precheck_apache: precheck/chk-apache.$(
apachezxid: precheck_apache precheck mod_auth_saml$(SO)
apachezxid_install: mod_auth_saml$(SO)
- $(CP) $< $(APACHE_MODULES)
+ $(CP) $< $(DESTDIR)$(APACHE_MODULES)
mod_auth_saml: apachezxid
@$(ECHO) "mod_auth_saml: not an official target. Use make apachezxid"
@@ -1587,7 +1591,7 @@ mini_httpd_zxid: $(MINI_HTTPD_DIR)/mini_
### zxid_httpd (derived from mini_httd).
###
-zxid_httpd$(EXE): zxid_httpd.$(OBJ_EXT) tdate_parse.$(OBJ_EXT) mini_httpd_filter.$(OBJ_EXT) $(LIBZXID_A)
+zxid_httpd$(EXE): zxid_httpd.$(OBJ_EXT) tdate_parse.$(OBJ_EXT) mini_httpd_filter.$(OBJ_EXT) $(SHLIBLINK)
$(warning ZXID_HTTPD LINK)
$(LD) $(LDFLAGS) $(OUTOPT)$@ $^ $(LIBS)
@@ -1597,7 +1601,7 @@ zxid_httpd$(EXE): zxid_httpd.$(OBJ_EXT)
#zxid$(EXE): zxid.$(OBJ_EXT) $(LIBZXID_A)
-$(DEFAULT_EXE) $(ALL_EXE): $(LIBZXID_A)
+$(DEFAULT_EXE) $(ALL_EXE): $(SHLIBLINK) $(SONAME)
zxcot-static-x64: zxcot.$(OBJ_EXT) $(LIBZXID_A)
diet gcc $(OUTOPT)$@$(EXE) $< -static -L. -lzxid -pthread -lpthread -L$(DIET_ROOT)/lib -L$(DIET_ROOT)/ssl/lib-x86_64 -lcurl -lssl -lcrypto -lz
@@ -1653,7 +1657,7 @@ zxbustailf-static-x64: zxbustailf.$(OBJ_
zxbuslist-static-x64: zxbuslist.$(OBJ_EXT) $(LIBZXID_A)
diet gcc $(OUTOPT)$@ $< -static -L. -lzxid -pthread -lpthread -L$(DIET_ROOT)/lib -L$(DIET_ROOT)/ssl/lib-x86_64 -lcurl -lssl -lcrypto -lz
-zxbusd: $(ZXBUSD_OBJ) $(LIBZXID_A)
+zxbusd: $(ZXBUSD_OBJ) $(SHLIBLINK)
$(CC) $(OUTOPT)$@ $^ $(LIBS)
zxbusd-static-x64: $(ZXBUSD_OBJ) $(LIBZXID_A)
@@ -1691,8 +1695,11 @@ $(LIBZXID_A): $(ZX_OBJ) $(ZX_GEN_C:.c=.o
endif
endif
-libzxid.so.0.0: $(LIBZXID_A)
- $(LD) $(OUTOPT)libzxid.so.0.0 $(SHARED_FLAGS) $^ $(SHARED_CLOSE) $(LIBS)
+$(SHLIB): $(ZX_OBJ) $(ZX_GEN_C:.c=.o) $(ZXID_LIB_OBJ) $(WSF_OBJ) $(OAUTH_OBJ) $(SMIME_LIB_OBJ)
+ $(LD) $(LDFLAGS) -Wl,-soname=$(SONAME) $(OUTOPT)libzxid.so.0.0 $(SHARED_FLAGS) $^ $(SHARED_CLOSE) $(LIBS)
+
+$(SHLIBLINK) $(SONAME): $(SHLIB)
+ ln -sf $< $@
zxid.dll zxidimp.lib: $(LIBZXID_A)
$(LD) $(OUTOPT)zxid.dll $(SHARED_FLAGS) -Wl,--output-def,zxid.def,--out-implib,zxidimp.lib $^ $(SHARED_CLOSE) $(SO_LIBS)
@@ -2000,13 +2007,11 @@ dirs: dir
install_nodep:
@$(ECHO) "===== Installing in $(PREFIX) (to change do make install PREFIX=/your/path)"
- -mkdir -p $(PREFIX) $(PREFIX)/bin $(PREFIX)/lib $(PREFIX)/include/zxid $(PREFIX)/include/zx $(PREFIX)/doc
- $(CP) zxmkdirs.sh zxcall zxpasswd zxcot zxlogview zxbusd zxbustailf zxbuslist zxdecode zxencdectest zxcleanlogs.sh zximport-htpasswd.pl zximport-ldif.pl xml-pretty.pl diffy.pl smime send.pl xacml2ldif.pl mockpdp.pl env.cgi zxid-java.sh zxidatsel.pl zxidnewuser.pl zxidcot.pl zxiddash.pl zxidexplo.pl zxidhlo zxidhlo.pl zxidhlo.php zxidhlo.sh zxidhlo-java.sh zxidhlocgi.php zxidhlowsf zxidhrxmlwsc zxidhrxmlwsp zxididp zxidsimple zxidwsctool zxidwspcgi zxtest.pl mini_httpd_zxid $(PREFIX)/bin
- $(CP) $(LIBZXID_A) libzxid.so* $(PREFIX)/lib
- $(CP) libzxid.so.0.0 $(PREFIX)/lib
- $(CP) *.h c/*.h $(PREFIX)/include/zxid
- $(CP) zx.h $(PREFIX)/include/zx
- $(CP) *.pd *.dia $(PREFIX)/doc
+ -mkdir -p "$(DESTDIR)$(PREFIX)" "$(DESTDIR)$(PREFIX)/bin" "$(DESTDIR)$(PREFIX)/lib" "$(DESTDIR)$(PREFIX)/include/zx" "$(DESTDIR)$(PREFIX)/share/doc"
+ $(CP) zxmkdirs.sh zxcall zxpasswd zxcot zxlogview zxbusd zxbustailf zxbuslist zxdecode zxencdectest zxcleanlogs.sh zximport-htpasswd.pl zximport-ldif.pl xml-pretty.pl diffy.pl smime send.pl xacml2ldif.pl mockpdp.pl env.cgi zxid-java.sh zxidatsel.pl zxidnewuser.pl zxidcot.pl zxiddash.pl zxidexplo.pl zxidhlo zxidhlo.pl zxidhlo.php zxidhlo.sh zxidhlo-java.sh zxidhlocgi.php zxidhlowsf zxidhrxmlwsc zxidhrxmlwsp zxididp zxidsimple zxidwsctool zxidwspcgi zxtest.pl zxid_httpd $(DESTDIR)$(PREFIX)/bin
+ $(CP) $(LIBZXID_A) libzxid.so* $(DESTDIR)$(PREFIX)/lib
+ $(CP) $(SHLIB) $(DESTDIR)$(PREFIX)/lib
+ $(CP) *.h $(DESTDIR)$(PREFIX)/include/zx
@$(ECHO) "You will need to copy zxidhlo binary where your web server can find it and"
@$(ECHO) "make sure your web server is configured to recognize zxidhlo as a CGI script."
@$(ECHO)
/debian/patches/samlwrap_bool.patch
0,0 → 1,12
--- a/Net/SAML_wrap.c
+++ b/Net/SAML_wrap.c
@@ -1441,9 +1441,6 @@ SWIG_Perl_SetModule(swig_module_info *mo
#ifdef eof
#undef eof
#endif
-#ifdef bool
- #undef bool
-#endif
#ifdef close
#undef close
#endif
/debian/patches/series
0,0 → 1,2
build.patch
samlwrap_bool.patch
/debian/pd2tex
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>&nbsp;</th>|gs; # Make empty cells appear correctly on firefox
$html =~ s|<td>\s*</td>|<td>&nbsp;</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/</&lt;/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) .
"&nbsp;</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 = '&nbsp;';
$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 = '&nbsp;';
$min_cap_html = '&nbsp;';
$min_cap_tex = '';
$max_cap_tex = '';
} elsif($count eq 0){
# Dont print results if no data found
$max_cap_html = '&nbsp;';
$min_cap_html = '&nbsp;';
$typ_cap_html = '&nbsp;';
$min_cap_tex = '';
$max_cap_tex = '';
$typ_cap_tex = '';
$result_html = '&nbsp;';
$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&nbsp;</td>".
"<td>$typ_spec&nbsp;</td>".
"<td>$max_spec&nbsp;</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>".
# "&nbsp;&nbsp;($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/\@/&commat;/g;
 
$x =~ s/รก/&aacute;/g; $x =~ s/ร /&agrave;/g; $x =~ s/รข/&acirc;/g;
$x =~ s/รค/&auml;/g; $x =~ s/รฃ/&atilde;/g; $x =~ s/รฅ/&aring;/g;
$x =~ s/ร/&Aacute;/g; $x =~ s/ร€/&Agrave;/g; $x =~ s/ร‚/&Acirc;/g;
$x =~ s/ร„/&Auml;/g; $x =~ s/รƒ/&Atilde;/g; $x =~ s/ร…/&Aring;/g;
$x =~ s/รณ/&oacute;/g; $x =~ s/รฒ/&ograve;/g; $x =~ s/รด/&ocirc;/g;
$x =~ s/รถ/&ouml;/g; $x =~ s/รต/&otilde;/g;
$x =~ s/ร“/&Oacute;/g; $x =~ s/ร’/&Ograve;/g; $x =~ s/ร”/&Ocirc;/g;
$x =~ s/ร–/&Ouml;/g; $x =~ s/ร•/&Otilde;/g;
$x =~ s/รญ/&iacute;/g; $x =~ s/รฌ/&igrave;/g; $x =~ s/รฎ/&icirc;/g; $x =~ s/รฏ/&iuml;/g;
$x =~ s/ร/&Iacute;/g; $x =~ s/รŒ/&Igrave;/g; $x =~ s/รŽ/&Icirc;/g; $x =~ s/ร/&Iuml;/g;
$x =~ s/รฉ/&eacute;/g; $x =~ s/รจ/&egrave;/g; $x =~ s/รช/&ecirc;/g; $x =~ s/รซ/&euml;/g;
$x =~ s/ร‰/&Eacute;/g; $x =~ s/รˆ/&Egrave;/g; $x =~ s/รŠ/&Ecirc;/g; $x =~ s/ร‹/&Euml;/g;
$x =~ s/รบ/&uacute;/g; $x =~ s/รน/&ugrave;/g; $x =~ s/รป/&ucirc;/g; $x =~ s/รผ/&uuml;/g;
$x =~ s/รš/&Uacute;/g; $x =~ s/ร™/&Ugrave;/g; $x =~ s/ร›/&Ucirc;/g; $x =~ s/รœ/&Uuml;/g;
$x =~ s/รง/&ccedilla;/g; $x =~ s/ร‡/&Ccedilla;/g;
$x =~ s/รฑ/&ntilde;/g; $x =~ s/ร‘/&Ntilde;/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|&|&amp;|g;
$x =~ s|<|&lt;|g;
$x =~ s|>|&gt;|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|&|&amp;|g;
$x =~ s|<|&lt;|g;
$x =~ s|>|&gt;|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
/debian/php5-zxid.install
0,0 → 1,0
usr/lib/php*
/debian/php5-zxid.php5
0,0 → 1,0
mod debian/zxid.ini
/debian/rules
0,0 → 1,75
#!/usr/bin/make -f
# -*- makefile -*-
 
parallel = $(patsubst parallel=%,%,$(filter parallel=%,$(DEB_BUILD_OPTIONS)))
ifneq (,$(parallel))
jobsflag = -j$(parallel)
endif
export CFLAGS := $(shell dpkg-buildflags --get CFLAGS)
export LDFLAGS := $(shell dpkg-buildflags --get LDFLAGS) -Wl,--as-needed
 
clean:
dh_testdir
dh_testroot
rm -f build-stamp
 
[ ! -f Makefile ] || $(MAKE) distclean
dh_clean
 
build: build-arch build-indep
build-indep:
$(MAKE) doc zxidjava.jar PD2TEX_PL=debian/pd2tex
 
build-arch:
CDEF='-DZXID_CONF_PATH=\"/etc/zxid.conf\" -DZXID_PATH=\"/var/lib/zxid\"' $(MAKE) $(jobsflag) all SHARED=1 V=1 JNI_INC='-I/usr/lib/jvm/default-java/include' SERVLET_PATH='/usr/share/java/servlet-api-3.0.jar' OPTIMIZE="-O2 -g -Wall" LD_RUN_PATH="" OTHERLDFLAGS="$(LDFLAGS)"
touch build-stamp
 
install:
$(MAKE) install_nodep samlmod_install perlzxid_install phpzxid_install DESTDIR=$(CURDIR)/debian/tmp PREFIX=/usr V=1
 
# Build architecture-dependent files here.
build-arch: build
binary-arch: build-arch install
dh_testdir
dh_testroot
dh_install -a
dh_link -a
dh_installchangelogs -a Changes
dh_installdocs -a
dh_installexamples -a
dh_installinfo -a
dh_installman -a
dh_strip -a
dh_perl -a
dh_apache2 -a
dh_php5 -a
dh_compress -a
dh_fixperms -a
dh_makeshlibs -a -V
dh_installdeb -a
dh_shlibdeps -a
dh_gencontrol -a
dh_md5sums -a
dh_builddeb -a
 
build-indep: build
binary-indep: build-indep
dh_testdir
dh_testroot
dh_install -i
dh_link -i
dh_installchangelogs -i Changes
dh_installdocs -i
dh_installexamples -i
dh_installinfo -i
dh_installman -i
dh_compress -i
dh_fixperms -i
dh_installdeb -i
dh_shlibdeps -i
dh_gencontrol -i
dh_md5sums -i
dh_builddeb -i
 
binary: binary-arch binary-indep
.PHONY: build build-indep build-arch clean clean-patched binary-indep binary-arch binary install
/debian/source/format
0,0 → 1,0
3.0 (quilt)
/debian/zxid-doc.docs
0,0 → 1,0
html/
/debian/zxid-doc.examples
0,0 → 1,0
zxid*hlo.*
/debian/zxid.ini
0,0 → 1,0
extension=php_zxid.so
/debian/zxid.install
0,0 → 1,15
usr/bin/smime
usr/bin/zxcall
usr/bin/zxcot
usr/bin/zxidsimple
usr/bin/zxpasswd
usr/bin/zxlogview
usr/bin/zxdecode
usr/bin/zxidwsctool
usr/bin/zxlogview usr/sbin
usr/bin/zxbusd usr/sbin
usr/bin/zxbustailf
usr/bin/zxbuslist
usr/bin/zxid_httpd usr/sbin
usr/bin/zxididp usr/lib/cgi-bin
usr/bin/zxidwspcgi usr/lib/cgi-bin
/debian
Property changes:
Added: mergeWithUpstream
## -0,0 +1 ##
+1
\ No newline at end of property