diff --git a/progs/convert/latex/init-latex.scm b/progs/convert/latex/init-latex.scm new file mode 100644 index 0000000..133b419 --- /dev/null +++ b/progs/convert/latex/init-latex.scm @@ -0,0 +1,122 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : init-latex.scm +;; DESCRIPTION : setup latex converters +;; COPYRIGHT : (C) 2003 Joris van der Hoeven +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex init-latex)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; LaTeX format +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (latex-recognizes-at? s pos) + (set! pos (format-skip-spaces s pos)) + (cond ((format-test? s pos "\\document") #t) + ((format-test? s pos "\\usepackage") #t) + ((format-test? s pos "\\input") #t) + ((format-test? s pos "\\includeonly") #t) + ((format-test? s pos "\\chapter") #t) + ((format-test? s pos "\\appendix") #t) + ((format-test? s pos "\\section") #t) + ((format-test? s pos "\\begin") #t) + (else #f))) + +(define (latex-recognizes? s) + (and (string? s) (latex-recognizes-at? s 0))) + +(define-format latex + (:name "LaTeX") + (:suffix "tex") + (:recognize latex-recognizes?)) + +(define-format latex-class + (:name "LaTeX class") + (:suffix "ltx" "sty" "cls")) + +(define-preferences + ("texmacs->latex:transparent-tracking" "on" noop)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; TeXmacs->LaTeX +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(lazy-define (convert latex texout) serialize-latex) +(lazy-define (convert latex tmtex) texmacs->latex) + +(converter texmacs-stree latex-stree + (:function-with-options texmacs->latex) + (:option "texmacs->latex:source-tracking" "off") + (:option "texmacs->latex:conservative" "on") + (:option "texmacs->latex:transparent-source-tracking" "on") + (:option "texmacs->latex:attach-tracking-info" "on") + (:option "texmacs->latex:replace-style" "on") + (:option "texmacs->latex:expand-macros" "on") + (:option "texmacs->latex:expand-user-macros" "off") + (:option "texmacs->latex:indirect-bib" "off") + (:option "texmacs->latex:use-macros" "on") + (:option "texmacs->latex:encoding" "UTF-8")) + +(converter latex-stree latex-document + (:function serialize-latex)) + +(converter latex-stree latex-snippet + (:function serialize-latex)) + +(tm-define (texmacs->latex-document x opts) + (serialize-latex (texmacs->latex (tm->stree x) opts))) + +(converter texmacs-stree latex-document + (:function-with-options conservative-texmacs->latex) + ;;(:function-with-options tracked-texmacs->latex) + (:option "texmacs->latex:source-tracking" "off") + (:option "texmacs->latex:conservative" "on") + (:option "texmacs->latex:transparent-source-tracking" "on") + (:option "texmacs->latex:attach-tracking-info" "on") + (:option "texmacs->latex:replace-style" "on") + (:option "texmacs->latex:expand-macros" "on") + (:option "texmacs->latex:expand-user-macros" "off") + (:option "texmacs->latex:indirect-bib" "off") + (:option "texmacs->latex:use-macros" "on") + (:option "texmacs->latex:encoding" "ascii")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; LaTeX -> TeXmacs +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (latex-document->texmacs x . opts) + (if (list-1? opts) (set! opts (car opts))) + (with as-pic (== (get-preference "latex->texmacs:fallback-on-pictures") "on") + (conservative-latex->texmacs x as-pic))) + +(converter latex-document latex-tree + (:function parse-latex-document)) + +(converter latex-snippet latex-tree + (:function parse-latex)) + +(converter latex-document texmacs-tree + (:function-with-options latex-document->texmacs) + (:option "latex->texmacs:fallback-on-pictures" "on") + (:option "latex->texmacs:source-tracking" "off") + (:option "latex->texmacs:conservative" "off") + (:option "latex->texmacs:transparent-source-tracking" "off")) + +(converter latex-class-document texmacs-tree + (:function latex-class-document->texmacs)) + +(converter latex-tree texmacs-tree + (:function latex->texmacs)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(lazy-define (convert latex test-tmtex) test-tmtex) diff --git a/progs/convert/latex/latex-command-drd.scm b/progs/convert/latex/latex-command-drd.scm new file mode 100644 index 0000000..b7ff571 --- /dev/null +++ b/progs/convert/latex/latex-command-drd.scm @@ -0,0 +1,420 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : latex-command-drd.scm +;; DESCRIPTION : Formal specification of standard LaTeX commands +;; COPYRIGHT : (C) 1999 Joris van der Hoeven +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex latex-command-drd)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Any LaTeX tag +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-rules + ((latex-tag% 'x) (latex-arity% 'x 'y)) + ((latex-supports-option% 'x #t) (latex-optional-arg% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; LaTeX commands +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-command-0% + ,(string->symbol " ") ,(string->symbol ";") + ,(string->symbol ",") ,(string->symbol ":") + - / [ ] ! * ,(string->symbol "|") i j ss SS oe OE ae AE + AA DH L NG O S TH aa dh dj l ng o P th pounds colon and lq rq + quad qquad enspace thinspace par smallskip medskip bigskip + noindent newline linebreak nobreak nolinebreak strut + pagebreak nopagebreak newpage newdoublepage clearpage cleardoublepage + newblock bgroup egroup protect cr hfil hfill hfilll appendix limits nolimits + dots maketitle tableofcontents TeX LaTeX onecolumn twocolumn + begingroup endgroup printindex today bmod toprule midrule bottomrule + + ;; AMS commands + dotsc dotsb dotsm dotsi dotso qed + ;; mathtools + coloneqq + ;; temporarily + hline hrulefill + ;; rewritten + notin vert Vert addots + implies iff gets + ;; wikipedia + infin rang + ;; bibtex + bysame + ;; for (e.g.) includegraphics + width height + ;; miscellaneous + null unskip + + ;; Algorithms + AND BlankLine Ensure ENSURE FALSE GLOBALS NOT OR PRINT Require REQUIRE + Repeat RETURN State STATE TO KwTo TRUE XOR Else ENDBODY EndFor ENDFOR + EndFunction EndIf ENDIF ENDINPUTS EndLoop ENDLOOP ENDOUTPUTS + EndProcedure ENDWHILE EndWhile Loop) + +(logic-group latex-command-1% + part* chapter* section* subsection* subsubsection* paragraph* subparagraph* + nextbib geometry + footnote overline underline not left middle right + big Big bigg Bigg bigl Bigl biggl Biggl + bigm Bigm biggm Biggm bigr Bigr biggr Biggr + bar Bar hat Hat tilde Tilde widehat widetilde vec Vec bm ring + overrightarrow overleftarrow overleftrightarrow + underrightarrow underleftarrow underleftrightarrow + grave Grave acute Acute check Check breve Breve invbreve abovering mathring + dot Dot ddot Ddot dddot ddddot mod pod pmod + label ref pageref index hspace hspace* vspace vspace* mspace + mbox hbox textnormal text not substack + ,(string->symbol "'") ,(string->symbol "`") ,(string->symbol "\"") + ^ over atop choose ~ = u v H t c d b k r textsuperscript textsubscript + thispagestyle ensuremath + mathord mathbin mathopen mathpunct mathop mathrel mathclose mathalpha + mathinner + arabic alph Alph roman Roman fnsymbol displaylines cases underbrace overbrace + phantom hphantom vphantom smash date terms + newcounter stepcounter refstepcounter value + citealt citealt* citealp* + citetext citeauthor citeauthor* citeyear onlinecite citeN + epsfig url penalty centerline fbox framebox cline cmidrule + enlargethispage + newlength newdimen newskip + Comment COMMENT For ForAll If Input KwData KwResult KwRet lnl nllabel + lElse uElse Output Until UNTIL While + etalchar MR listpart custombinding cref Cref) + +(logic-group latex-command-1% ;; . needs a special treatment + ,(string->symbol ".")) + +(logic-group latex-command-2% + binom tbinom dbinom cfrac tfrac equal href + sideset stackrel underaccent + setcounter addtocounter setlength addtolength + colorbox scalebox texorpdfstring raisebox foreignlanguage + Call Function Procedure SetKw SetKwData SetKwFunction SetKwInOut + ifthispageodd adjustbox) + +(logic-group latex-command-3% + ifthenelse resizebox fcolorbox @setfontsize eIf multicolumn) + +(logic-group latex-command-4% + mathchoice) + +(logic-group latex-command-6% + genfrac @startsection) + +(logic-rules + ((latex-command% 'x) (latex-command-0% 'x)) + ((latex-arity% 'x 0) (latex-command-0% 'x)) + ((latex-command% 'x) (latex-command-1% 'x)) + ((latex-arity% 'x 1) (latex-command-1% 'x)) + ((latex-command% 'x) (latex-command-2% 'x)) + ((latex-arity% 'x 2) (latex-command-2% 'x)) + ((latex-command% 'x) (latex-command-3% 'x)) + ((latex-arity% 'x 3) (latex-command-3% 'x)) + ((latex-command% 'x) (latex-command-4% 'x)) + ((latex-arity% 'x 4) (latex-command-4% 'x)) + ((latex-command% 'x) (latex-command-6% 'x)) + ((latex-arity% 'x 6) (latex-command-6% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; LaTeX commands with optional arguments +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-command-0*% + item ,(string->symbol "\\") + BODY ELSE INPUTS LOOP OUTPUTS REPEAT + hdashline) + +(logic-group latex-command-1*% + usepackage documentclass documentstyle sqrt bibitem cite caption + title author thanks marginpar + part chapter section subsection subsubsection paragraph subparagraph + includegraphics includegraphics* + makebox + subjclass declaretheorem footnotetext + xleftarrow xrightarrow xleftrightarrow xminus + xLeftarrow xRightarrow xLeftrightarrow xequal + xmapsto xmapsfrom citealp citet citep citet* citep* + Begin ELSIF FORALL FOR IF WHILE tcp tcp* tcc tcc* + hyperref) + +(logic-group latex-command-2*% + def newcommand renewcommand providecommand + newtheorem newtheorem* frac parbox + ElseIf uElseIf lElseIf ForEach lForEach lForAll lFor) + +(logic-group latex-command-3*% + category newenvironment renewenvironment multirow) + +(logic-rules + ((latex-command-0% 'x) (latex-command-0*% 'x)) + ((latex-optional-arg% 'x) (latex-command-0*% 'x)) + ((latex-command-1% 'x) (latex-command-1*% 'x)) + ((latex-optional-arg% 'x) (latex-command-1*% 'x)) + ((latex-command-2% 'x) (latex-command-2*% 'x)) + ((latex-optional-arg% 'x) (latex-command-2*% 'x)) + ((latex-command-3% 'x) (latex-command-3*% 'x)) + ((latex-optional-arg% 'x) (latex-command-3*% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Environments +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-environment-0% + begin-document begin-abstract begin-verbatim begin-proof + begin-matrix begin-pmatrix begin-bmatrix begin-vmatrix begin-smallmatrix + begin-cases + begin-center begin-flushleft begin-flushright + begin-picture) + +(logic-group latex-environment-0*% + begin-figure begin-table begin-figure* begin-table* + begin-algorithmic begin-algorithm begin-algorithm2e + begin-teaserfigure) + +(logic-group latex-environment-1% + begin-otherlanguage begin-otherlanguage* + begin-tabbing begin-thebibliography begin-multicols) + +(logic-group latex-environment-1*% + begin-array begin-tabular begin-minipage) + +(logic-group latex-environment-2*% + begin-tabular* begin-tabularx) + +(logic-rules + ((latex-environment% 'x) (latex-environment-0% 'x)) + ((latex-arity% 'x 0) (latex-environment-0% 'x)) + ((latex-environment% 'x) (latex-environment-1% 'x)) + ((latex-arity% 'x 1) (latex-environment-1% 'x)) + ((latex-environment% 'x) (latex-environment-2% 'x)) + ((latex-arity% 'x 2) (latex-environment-2% 'x)) + ((latex-environment% 'x) (latex-environment-3% 'x)) + ((latex-arity% 'x 3) (latex-environment-3% 'x)) + ((latex-environment-0% 'x) (latex-environment-0*% 'x)) + ((latex-optional-arg% 'x) (latex-environment-0*% 'x)) + ((latex-environment-1% 'x) (latex-environment-1*% 'x)) + ((latex-optional-arg% 'x) (latex-environment-1*% 'x)) + ((latex-environment-2% 'x) (latex-environment-2*% 'x)) + ((latex-optional-arg% 'x) (latex-environment-2*% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Enunciations +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-enunciation% + begin-theorem begin-proposition begin-lemma begin-corollary begin-proof + begin-axiom begin-definition begin-notation begin-conjecture + begin-remark begin-note begin-example begin-warning + begin-convention begin-acknowledgments + begin-exercise begin-problem + begin-solution begin-question begin-answer + begin-quote-env begin-quotation begin-verse + + begin-theorem* begin-proposition* begin-lemma* begin-corollary* + begin-axiom* begin-definition* begin-notation* begin-conjecture* + begin-remark* begin-note* begin-example* begin-warning* + begin-convention* begin-acknowledgments* + begin-exercise* begin-problem* + begin-solution* begin-question* begin-answer* + + ;; guessed + begin-th begin-thm begin-prop begin-lem begin-cor begin-corr + begin-pf begin-dem begin-preuve begin-IEEEproof + begin-ax begin-def begin-dfn begin-defn + begin-not begin-ex begin-exa begin-rem begin-war begin-conv + begin-exe begin-exc begin-exo begin-prop begin-sol begin-ans + begin-acks) + +(logic-rules + ((latex-environment-0*% 'x) (latex-enunciation% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Modifiers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-modifier-0% + normalfont rm tt sf md bf it em sl sc rmfamily ttfamily sffamily + mdseries bfseries upshape itshape slshape scshape + displaystyle textstyle scriptstyle scriptscriptstyle cal frak Bbb boldmath + tiny scriptsize footnotesize small normalsize + large Large LARGE huge Huge + black white grey red blue yellow green orange magenta brown pink + centering raggedleft raggedright flushleft flushright) + +(logic-group latex-modifier-1% + textnormalfont + textrm texttt textsf textmd textbf textup textit textsl textsc emph + mathrm mathtt mathsf mathmd mathbf mathup mathit mathsl mathnormal + mathcal mathfrak mathbb mathbbm mathscr operatorname boldsymbol + lowercase MakeLowercase uppercase MakeUppercase selectlanguage) + +(logic-group latex-modifier-1*% + color) + +(logic-group latex-modifier-2*% + textcolor) + +(logic-rules + ((latex-modifier% 'x) (latex-modifier-0% 'x)) + ((latex-arity% 'x 0) (latex-modifier-0% 'x)) + ((latex-modifier% 'x) (latex-modifier-1% 'x)) + ((latex-arity% 'x 1) (latex-modifier-1% 'x)) + ((latex-optional-arg% 'x) (latex-modifier-1*% 'x)) + ((latex-modifier% 'x) (latex-modifier-1*% 'x)) + ((latex-arity% 'x 1) (latex-modifier-1*% 'x)) + ((latex-optional-arg% 'x) (latex-modifier-2*% 'x)) + ((latex-modifier% 'x) (latex-modifier-2*% 'x)) + ((latex-arity% 'x 2) (latex-modifier-2*% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Special types of LaTeX primitives +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-control% + $ & % ,(string->symbol "#") _ { } ) + +(logic-group latex-operator% + arccos arcsin arctan arg cos cosh cot coth csc deg det dim exp gcd hom + inf ker lg lim liminf limsup ln log max min Pr sec sin sinh sup tan tanh) + +(logic-group latex-list% + begin-itemize begin-enumerate begin-description + begin-asparaitem begin-inparaitem begin-compactitem + begin-asparaenum begin-inparaenum begin-compactenum) + +(logic-group latex-math-environment-0% + begin-formula begin-equation* + begin-math begin-displaymath begin-equation + begin-eqnarray begin-eqnarray* + begin-flalign begin-flalign* + begin-align begin-align* + begin-multline begin-multline* + begin-gather begin-gather* + begin-eqsplit begin-eqsplit*) + +(logic-group latex-math-environment-1% + begin-alignat begin-alignat*) + +(logic-rules + ((latex-arity% 'x 0) (latex-control% 'x)) + ((latex-arity% 'x 0) (latex-operator% 'x)) + ((latex-environment-0*% 'x) (latex-list% 'x)) + ((latex-math-environment% 'x) (latex-math-environment-0% 'x)) + ((latex-math-environment% 'x) (latex-math-environment-1% 'x)) + ((latex-environment-1% 'x) (latex-math-environment-1% 'x)) + ((latex-environment-0% 'x) (latex-math-environment-0% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Counters +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-counter% + badness enumi enumii enumiii enumiv equation figure inputlineno + mpfootnote page setlanguage table) + +(logic-rules + ((latex-arity% 'x 0) (latex-counter% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Names +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-name% + abstractname appendixname contentname figurename indexname + litfigurename littablename partname refname tablename) + +(logic-rules + ((latex-arity% 'x 0) (latex-name% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Lengths +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-length% + ;; From latex.ltx + ;; -- lengths + @textfloatsheight arraycolsep arrayrulewidth columnsep columnseprule + columnwidth doublerulesep emergencystretch evensidemargin fboxrule + fboxsep footnotesep footskip headheight headsep itemindent labelsep + labelwidth leftmargin leftmargini leftmarginii leftmarginiii + leftmarginiv leftmarginv leftmarginvi linewidth listparindent + marginparpush marginparsep marginparwidth oddsidemargin p@ paperheight + paperwidth rightmargin tabbingsep tabcolsep textheight textwidth + topmargin unitlength z@ @bls @vpt @vipt @viipt @viiipt @ixpt @xpt @xipt + @xiipt @xivpt @xviipt @xxpt @xxvpt + ;; -- skips + topsep partopsep itemsep parsep floatsep textfloatsep intextsep + dblfloatsep dbltextfloatsep + ;; From latex classes + abovecaptionskip belowcaptionskip bibindent + ;; From fleqn + mathindent + ;; Plain TeX + maxdimen hfuzz vfuzz overfullrule hsize vsize maxdepth lineskiplimit + delimitershortfall nulldelimiterspace scriptspace mathsurround + predisplaysize displaywidth displayindent parindent hangindent hoffset + voffset baselineskip lineskip parskip abovedisplayskip + abovedisplayshortskip belowdisplayskip belowdisplayshortskip leftskip + rightskip topskip splittopskip tabskip spaceskip xspaceskip parfillskip + thinmuskip medmuskip thickmuskip hideskip smallskipamount medskipamount + bigskipamount normalbaselineskip normallineskip normallineskiplimit jot + ) + +(logic-rules + ((latex-arity% 'x 0) (latex-length% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; To be imported as pictures +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-as-pic-0% + begin-pspicture begin-pspicture* begin-tikzpicture) + +(logic-group latex-as-pic-1% + xymatrix) + +(logic-rules + ((latex-as-pic% 'x) (latex-as-pic-0% 'x)) + ((latex-as-pic% 'x) (latex-as-pic-1% 'x)) + ((latex-arity% 'x 0) (latex-as-pic-0% 'x)) + ((latex-arity% 'x 1) (latex-as-pic-1% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; To be ignored +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-ignore-0% + allowbreak notag xspace break sloppy makeatother makeatletter relax + qedhere + ignorespacesafterend ignorespaces balancecolumns + tightlist) + +(logic-group latex-ignore-0*% + displaybreak allowdisplaybreaks) + +(logic-group latex-ignore-1% + tag hyphenation) + +(logic-group latex-ignore-2% + newdir) + +(logic-rules + ((latex-ignore% 'x) (latex-ignore-0% 'x)) + ((latex-ignore% 'x) (latex-ignore-0*% 'x)) + ((latex-ignore% 'x) (latex-ignore-1% 'x)) + ((latex-ignore% 'x) (latex-ignore-2% 'x)) + ((latex-arity% 'x 0) (latex-ignore-0% 'x)) + ((latex-arity% 'x 0) (latex-ignore-0*% 'x)) + ((latex-arity% 'x 1) (latex-ignore-1% 'x)) + ((latex-arity% 'x 2) (latex-ignore-2% 'x)) + ((latex-optional-arg% 'x) (latex-ignore-1*% 'x))) diff --git a/progs/convert/latex/latex-define.scm b/progs/convert/latex/latex-define.scm new file mode 100644 index 0000000..b91e410 --- /dev/null +++ b/progs/convert/latex/latex-define.scm @@ -0,0 +1,864 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : latex-define.scm +;; DESCRIPTION : LaTeX definitions for TeXmacs extensions +;; COPYRIGHT : (C) 2005 Joris van der Hoeven +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex latex-define) + (:use (convert latex latex-texmacs-drd))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Extra TeXmacs symbols +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(smart-table latex-texmacs-macro + ;; arrows and other symbols with limits + (leftarrowlim "\\mathop{\\leftarrow}\\limits") + (rightarrowlim "\\mathop{\\rightarrow}\\limits") + (leftrightarrowlim "\\mathop{\\leftrightarrow}\\limits") + (mapstolim "\\mathop{\\mapsto}\\limits") + (longleftarrowlim "\\mathop{\\longleftarrow}\\limits") + (longrightarrowlim "\\mathop{\\longrightarrow}\\limits") + (longleftrightarrowlim "\\mathop{\\longleftrightarrow}\\limits") + (longmapstolim "\\mathop{\\longmapsto}\\limits") + (leftsquigarrowlim "\\mathop{\\leftsquigarrow}\\limits") + (rightsquigarrowlim "\\mathop{\\rightsquigarrow}\\limits") + (leftrightsquigarrowlim "\\mathop{\\leftrightsquigarrow}\\limits") + (equallim "\\mathop{=}\\limits") + (longequallim "\\mathop{\\longequal}\\limits") + (Leftarrowlim "\\mathop{\\leftarrow}\\limits") + (Rightarrowlim "\\mathop{\\rightarrow}\\limits") + (Leftrightarrowlim "\\mathop{\\leftrightarrow}\\limits") + (Longleftarrowlim "\\mathop{\\longleftarrow}\\limits") + (Longrightarrowlim "\\mathop{\\longrightarrow}\\limits") + (Longleftrightarrowlim "\\mathop{\\longleftrightarrow}\\limits") + (cdotslim "\\mathop{\\cdots}\\limits") + + ;; rotated arrows and other symbols + (mapsfrom (!group (mbox (rotatebox (!option "origin=c") "180" + (!math (mapsto)))))) + (longmapsfrom (!group (mbox (rotatebox (!option "origin=c") "180" + (!math (longmapsto)))))) + (mapmulti (!group (mbox (rotatebox (!option "origin=c") "180" + (!math "\\multimap"))))) + (leftsquigarrow (!group (mbox (rotatebox (!option "origin=c") "180" + (!math (rightsquigarrow)))))) + (upequal (!group (mbox (rotatebox (!option "origin=c") "90" + (!math "="))))) + (downequal (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math "="))))) + (longupequal (!group (mbox (rotatebox (!option "origin=c") "90" + (!math (longequal)))))) + (longdownequal (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math (longequal)))))) + (longupminus (!group (mbox (rotatebox (!option "origin=c") "90" + (!math (longminus)))))) + (longdownminus (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math (longminus)))))) + (longuparrow (!group (mbox (rotatebox (!option "origin=c") "90" + (!math (longrightarrow)))))) + (longdownarrow (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math (longrightarrow)))))) + (longupdownarrow (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math (longleftrightarrow)))))) + (Longuparrow (!group (mbox (rotatebox (!option "origin=c") "90" + (!math (Longrightarrow)))))) + (Longdownarrow (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math (Longrightarrow)))))) + (Longupdownarrow (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math (Longleftrightarrow)))))) + (mapsup (!group (mbox (rotatebox (!option "origin=c") "90" + (!math (mapsto)))))) + (mapsdown (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math (mapsto)))))) + (longmapsup (!group (mbox (rotatebox (!option "origin=c") "90" + (!math (longmapsto)))))) + (longmapsdown (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math (longmapsto)))))) + (upsquigarrow (!group (mbox (rotatebox (!option "origin=c") "90" + (!math (rightsquigarrow)))))) + (downsquigarrow (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math (rightsquigarrow)))))) + (updownsquigarrow (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math (leftrightsquigarrow)))))) + (hookuparrow (!group (mbox (rotatebox (!option "origin=c") "90" + (!math (hookrightarrow)))))) + (hookdownarrow (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math (hookrightarrow)))))) + (longhookuparrow (!group (mbox (rotatebox (!option "origin=c") "90" + (!math (longhookrightarrow)))))) + (longhookdownarrow (!group (mbox (rotatebox (!option "origin=c") "-90" + (!math (longhookrightarrow)))))) + (Backepsilon (!group (mbox (rotatebox (!option "origin=c") "180" + "E")))) + (Backsigma (!group (mbox (reflectbox (!math "\\Sigma"))))) + (Mho (!group (mbox (rotatebox (!option "origin=c") "180" + (!math "\\Omega"))))) + (btimes (!group (mbox (rotatebox (!option "origin=c") "90" + (!math "\\ltimes"))))) + + ;; asymptotic relations by Joris + (nasymp "\\not\\asymp") + (asympasymp "{\\asymp\\!\\!\\!\\!\\!\\!-}") + (nasympasymp "{\\not\\asymp\\!\\!\\!\\!\\!\\!-}") + (simsim "{\\approx\\!\\!\\!\\!\\!\\!-}") + (nsimsim "{\\not\\approx\\!\\!\\!\\!\\!\\!-}") + (triplesim "{\\approx\\!\\!\\!\\!\\!\\!\\sim}") + (ntriplesim "{\\not\\approx\\!\\!\\!\\!\\!\\!\\sim}") + (precprec "\\prec\\!\\!\\!\\prec") + (precpreceq "\\preceq\\!\\!\\!\\preceq") + (precprecprec "\\prec\\!\\!\\!\\prec\\!\\!\\!\\prec") + (precprecpreceq "\\preceq\\!\\!\\!\\preceq\\!\\!\\!\\preceq") + (succsucc "\\succ\\!\\!\\!\\succ") + (succsucceq "\\succeq\\!\\!\\!\\succeq") + (succsuccsucc "\\succ\\!\\!\\!\\succ\\!\\!\\!\\succ") + (succsuccsucceq "\\succeq\\!\\!\\!\\succeq\\!\\!\\!\\succeq") + (lleq "\\leq\\!\\!\\!\\leq") + (llleq "\\leq\\!\\!\\!\\leq\\!\\!\\!\\leq") + (ggeq "\\geq\\!\\!\\!\\geq") + (gggeq "\\geq\\!\\!\\!\\geq\\!\\!\\!\\geq") + + ;; extra literal symbols + (mathcatalan "C") + (mathd "\\mathrm{d}") + (mathD "\\mathrm{D}") + (mathe "\\mathrm{e}") + (matheuler "\\gamma") + (mathGamma "\\Gamma") + (mathlambda "\\lambda") + (mathLaplace "\\Delta") + (mathi "\\mathrm{i}") + (mathpi "\\pi") + (Alpha "\\mathrm{A}") + (Beta "\\mathrm{B}") + (Epsilon "\\mathrm{E}") + (Eta "\\mathrm{H}") + (Iota "\\mathrm{I}") + (Kappa "\\mathrm{K}") + (Mu "\\mathrm{M}") + (Nu "\\mathrm{N}") + (Omicron "\\mathrm{O}") + (Chi "\\mathrm{X}") + (Rho "\\mathrm{P}") + (Tau "\\mathrm{T}") + (Zeta "\\mathrm{Z}") + + ;; symbols from mathabx + ;; NOTE: we avoid using the mathabx package because it tends + ;; to be badly installed and incompatible with certain styles + (divides "\\mathrel{|}") + (ndivides "\\mathrel{\\nmid}") + (asterisk "\\mathord{*}") + (dottimes "\\mathbin{\\dot{\\times}}") + (precdot "\\mathrel{\\prec\\!\\!\\cdot") + + ;; negations + (nin "\\not\\in") + (nni "\\not\\ni") + (notni "\\not\\ni") + (nequiv (!annotate "\\mathrel{\\not\\equiv}" (equiv))) + (nleadsto (!annotate "\\not\\leadsto" (leadsto))) + (napproxeq (!annotate "\\mathrel{\\not\\approxeq}" (approxeq))) + (nprecapprox (!annotate "\\mathrel{\\not\\precapprox}" (precapprox))) + (npreccurlyeq (!annotate "\\mathrel{\\not\\preccurlyeq}" (preccurlyeq))) + (npreceqq (!annotate "\\mathrel{\\not\\preceqq}" (preceqq))) + (nprecsim (!annotate "\\mathrel{\\not\\precsim}" (precsim))) + (nsimeq (!annotate "\\mathrel{\\not\\simeq}" (simeq))) + (nsubset (!annotate "\\mathrel{\\not\\subset}" (subset))) + (napprox (!annotate "\\mathrel{\\not\\approx}" (approx))) + (nsqsubset (!annotate "\\mathrel{\\not\\sqsubset}" (sqsubset))) + (nsqsubseteq (!annotate "\\mathrel{\\not\\sqsubseteq}" (sqsubseteq))) + (nsqsubseteqq (!annotate "\\mathrel{\\not\\sqsubseteqq}" (sqsubseteqq))) + (nsqsupset (!annotate "\\mathrel{\\not\\sqsupset}" (sqsupset))) + (nsqsupseteq (!annotate "\\mathrel{\\not\\sqsupseteq}" (sqsupseteq))) + (nsqsupseteqq (!annotate "\\mathrel{\\not\\sqsupseteqq}" (sqsupseteqq))) + (nsuccapprox (!annotate "\\mathrel{\\not\\succapprox}" (succapprox))) + (nsucccurlyeq (!annotate "\\mathrel{\\not\\succcurlyeq}" (succcurlyeq))) + (nsucceqq (!annotate "\\mathrel{\\not\\succeqq}" (succeqq))) + (nsuccsim (!annotate "\\mathrel{\\not\\succsim}" (succsim))) + + ;; other extra symbols + (oempty "\\circ") + (exterior "\\wedge") + (Exists "\\exists") + (bigintwl "\\int") + (bigointwl "\\oint") + (bigintlim "\\int") + (bigointlim "\\oint") + (of ":") + (suchthat ":") + (barsuchthat "|") + (point ".") + (cdummy "\\cdot") + (comma "{,}") + (copyright "\\copyright") + (bignone "") + (nobracket "") + (nospace "") + (nocomma "") + (noplus "") + (nosymbol "") + (dotminus "\\mathaccent95{-}") + (dotpm "\\mathaccent95{\\pm}") + (dotmp "\\mathaccent95{\\mp}") + (dotamalg "\\mathaccent95{\\amalg}") + (dotoplus "\\mathaccent95{\\oplus}") + (dototimes "\\mathaccent95{\\otimes}") + (dotast "\\mathaccent95{*}") + (into "\\rightarrow") + (longminus "{-\\!\\!-}") + (longequal "{=\\!\\!=}") + (longhookrightarrow "{\\lhook\\joinrel\\relbar\\joinrel\\rightarrow}") + (longhookleftarrow "{\\leftarrow\\joinrel\\relbar\\joinrel\\rhook}") + (triangleup "\\triangle") + (tmprecdot "{\\prec\\hspace{-0.6em}\\cdot}\\;\\,") + (preceqdot "{\\preccurlyeq\\hspace{-0.6em}\\cdot}\\;\\,") + (llangle "{\\langle\\!\\langle}") + (rrangle "{\\rangle\\!\\rangle}") + (join "\\Join") + (um "-") + (upl "+") + (upm "\\pm") + (ump "\\mp") + (assign ":=") + (plusassign "+\\!\\!=") + (minusassign "-\\!\\!=") + (timesassign "\times\\!\\!=") + (overassign "/\\!\\!=") + (backassign "=:") + (pplus (mathbin "+\\!\\!\\!\\!+")) + (lflux "\\ll") + (gflux "\\gg") + (colons "\\,:\\,") + (transtype "\\,:\\!!>") + (tmxspace (hspace "1em")) + (lebar (mathrel (Yleft))) + (gebar (mathrel (Yright))) + (leangle (mathrel (angle))) + (geangle (mathrel (!group (mbox (reflectbox (!math (angle))))))) + (anglege (mathrel (!group (mbox (rotatebox (!option "origin=c") "180" + (!math (angle))))))) + (anglele (mathrel (!group (mbox (rotatebox (!option "origin=c") "180" + (!math (!recurse (geangle)))))))) + ;;(leqangle (mathrel (substack (!append (angle) "\\\\" (smash "-"))))) + (leqangle (mathrel (!append (angle) " \\llap " + (!group (raisebox "-1ex" (!math "-")))))) + (geqangle (mathrel (!group (mbox (reflectbox (!math (!recurse (leqangle)))))))) + (legeangle (mathrel (substack (!append (leangle) "\\\\" (!recurse (anglege)))))) + (geleangle (mathrel (substack (!append (geangle) "\\\\" (!recurse (anglele)))))) + (udots "{\\mathinner{\\mskip1mu\\raise1pt\\vbox{\\kern7pt\\hbox{.}}\\mskip2mu\\raise4pt\\hbox{.}\\mskip2mu\\raise7pt\\hbox{.}\\mskip1mu}}") + (subsetsim (underset (sim) (subset))) + (supsetsim (underset (sim) (supset))) + (rightmap (!group (!append (shortmid) "\\!\\!\\!-"))) + (leftmap (!group (!append "-\\!\\!\\!" (shortmid)))) + (leftrightmap (!group (!append (shortmid) "\\!\\!\\!-\\!\\!\\!" + (shortmid)))) + (LRleftrightarrow (!group (!append (Lleftarrow) "\\!\\!\\!" (Rrightarrow)))) + (Llongleftarrow (!group (!append (Lleftarrow) "\\!" (equiv)))) + (Llongrightarrow (!group (!append (equiv) "\\!" (Rrightarrow)))) + (Llongleftrightarrow (!group (!append (Lleftarrow) "\\!" (equiv) + "\\!" (Rrightarrow)))) + (threeleftarrows + (mathrel (substack (!append (leftarrow) "\\\\[-0.6ex]" + (leftarrow) "\\\\[-0.6ex]" + (leftarrow))))) + (fourleftarrows + (mathrel (substack (!append (leftarrow) "\\\\[-0.6ex]" + (leftarrow) "\\\\[-0.6ex]" + (leftarrow) "\\\\[-0.6ex]" + (leftarrow))))) + (threerightarrows + (mathrel (substack (!append (rightarrow) "\\\\[-0.6ex]" + (rightarrow) "\\\\[-0.6ex]" + (rightarrow))))) + (fourrightarrows + (mathrel (substack (!append (rightarrow) "\\\\[-0.6ex]" + (rightarrow) "\\\\[-0.6ex]" + (rightarrow) "\\\\[-0.6ex]" + (rightarrow))))) + (longleftrightarrows + (mathrel (substack (!append (longleftarrow) "\\\\[-0.6ex]" + (longrightarrow))))) + (longleftleftarrows + (mathrel (substack (!append (longleftarrow) "\\\\[-0.6ex]" + (longleftarrow))))) + (longthreeleftarrows + (mathrel (substack (!append (longleftarrow) "\\\\[-0.6ex]" + (longleftarrow) "\\\\[-0.6ex]" + (longleftarrow))))) + (longfourleftarrows + (mathrel (substack (!append (longleftarrow) "\\\\[-0.6ex]" + (longleftarrow) "\\\\[-0.6ex]" + (longleftarrow) "\\\\[-0.6ex]" + (longleftarrow))))) + (longrightleftarrows + (mathrel (substack (!append (longrightarrow) "\\\\[-0.6ex]" + (longleftarrow))))) + (longrightrightarrows + (mathrel (substack (!append (longrightarrow) "\\\\[-0.6ex]" + (longrightarrow))))) + (longthreerightarrows + (mathrel (substack (!append (longrightarrow) "\\\\[-0.6ex]" + (longrightarrow) "\\\\[-0.6ex]" + (longrightarrow))))) + (longfourrightarrows + (mathrel (substack (!append (longrightarrow) "\\\\[-0.6ex]" + (longrightarrow) "\\\\[-0.6ex]" + (longrightarrow) "\\\\[-0.6ex]" + (longrightarrow)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Extra TeXmacs macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(smart-table latex-texmacs-macro + ;; Nullary macros + (tmunsc "\\_") + (emdash "---") + (tmat "\\symbol{\"40}") + (tmbsl "\\ensuremath{\\backslash}") + (tmdummy "$\\mbox{}$") + (TeXmacs "T\\kern-.1667em\\lower.5ex\\hbox{E}\\kern-.125emX\\kern-.1em\\lower.5ex\\hbox{\\textsc{m\\kern-.05ema\\kern-.125emc\\kern-.05ems}}") + (madebyTeXmacs (footnote (!recurse (withTeXmacstext)))) + (withTeXmacstext + (!append (!translate "This document has been produced using the GNU") " " + (!group (!recurse (TeXmacs))) " " (!translate "text editor") " (" + (!translate "see") " " + (url "https://www.texmacs.org") ")")) + (citewebsite + (!append (!translate "This document has been written using") " GNU " + (!group (!recurse (TeXmacs))) "; " (!translate "see") " " + (url "https://www.texmacs.org") ".")) + (tmmade (!recurse (tikzframe (Backsigma)))) + (scheme "{\\sc Scheme}") + (tmsep ", ") + (tmSep "; ") + (pari "{\\sc Pari}") + (textdots "...") + (filldots "{\\dotfill\\hfill\\hbox{}}") + (infixand (text " and ")) + (infixor (text " or ")) + (infixiff (text " iff ")) + + ;; Unary macros + (tmrsub (ensuremath (!append "_{" (textrm 1) "}"))) + (tmrsup (textsuperscript 1)) + (tmverbatim (text (!group (ttfamily) (!group 1)))) + (tmtextrm (text (!group (rmfamily) (!group 1)))) + (tmtextsf (text (!group (sffamily) (!group 1)))) + (tmtexttt (text (!group (ttfamily) (!group 1)))) + (tmtextmd (text (!group (mdseries) (!group 1)))) + (tmtextbf (text (!group (bfseries) (!group 1)))) + (tmtextup (text (!group (upshape) (!group 1)))) + (tmtextsl (text (!group (slshape) (!group 1)))) + (tmtextit (text (!group (itshape) (!group 1)))) + (tmtextsc (text (!group (scshape) (!group 1)))) + (tmmathbf (ensuremath (!recurse (boldsymbol 1)))) + (tmmathmd (ensuremath 1)) + (tmop (ensuremath (operatorname 1))) + (tmstrong (textbf 1)) + (tmem (!group "\\em " 1 "\\/")) + (tmtt (texttt 1)) + (tmdate (today)) + (tmname (textsc 1)) + (tmsamp (textsf 1)) + (tmabbr 1) + (tmdfn (textbf 1)) + (tmkbd (texttt 1)) + (tmvar (texttt 1)) + (tmacronym (textsc 1)) + (tmperson (textsc 1)) + (tmscript (text (scriptsize (!math 1)))) + (tmdef 1) + (dueto (textup (textbf (!append "(" 1 ") ")))) + (op 1) + (todo (!group (!append (color "red!75!black") "[To do: " 1 "]"))) + (tmoutput 1) + (tmerrput (!append (color "red!50!black") 1)) + (tmtiming (!append (hfill) (footnotesize) (color "black!50") 1 (par))) + (tmsubtitle (thanks (!append (textit (!translate "Subtitle:")) " " 1))) + (tmrunningtitle (!append (!translate "Running title:") " " 1)) + (tmrunningauthor (!append (!translate "Running author:") " " 1)) + (tmaffiliation (!append (!nextline) 1)) + (tmemail (!append (!nextline) (textit (!translate "Email:")) " " (texttt 1))) + (tmhomepage (!append (!nextline) (textit (!translate "Web:")) " " (texttt 1))) + (tmfnaffiliation (thanks (!append (textit (!translate "Affiliation:")) " " 1))) + (tmfnemail (thanks (!append (textit (!translate "Email:")) " " (texttt 1)))) + (tmfnhomepage (thanks (!append (textit (!translate "Web:")) " " (texttt 1)))) + (tmacmhomepage (titlenote (!append (textit (!translate "Web:")) " " 1))) + (tmacmmisc (titlenote (!append (textit (!translate "Misc:")) " " 1))) + (tmieeeemail (!append (textit (!translate "Email:")) " " 1)) + (tmnote (thanks (!append (textit (!translate "Note:")) " " 1))) + (tmmisc (thanks (!append (textit (!translate "Misc:")) " " 1))) + (citetexmacs + (!append (!translate "This document has been written using") " GNU " + (!group (!recurse (TeXmacs))) " " (cite 1) ".")) + (key (!append + (fcolorbox "black" "gray!25!white" + (raisebox "0pt" (!option "5pt") (!option "0pt") (texttt 1))) + (hspace "0.5pt"))) + (uhat (underaccent (hat) 1)) + (uwidehat (underaccent (widehat (hphantom 1)) 1)) + (utilde (underaccent (tilde) 1)) + (uwidetilde (underaccent (widetilde (hphantom 1)) 1)) + (uvec (underaccent (vec) 1)) + (ubreve (underaccent (breve) 1)) + (uinvbreve (underaccent (invbreve) 1)) + (ucheck (underaccent (check) 1)) + (uring (underaccent (ring) 1)) + (uacute (underaccent (acute) 1)) + (ugrave (underaccent (grave) 1)) + (underdot (underaccent (dot) 1)) + (uddot (underaccent (ddot) 1)) + (udddot (underaccent (dddot (hphantom 1)) 1)) + (uddddot (underaccent (ddddot (hphantom 1)) 1)) + (widespacing 1) + (gb (!append (texttt "[\\!\\![") 1 (texttt "]\\!\\!]"))) + (gbt (!append (texttt "[\\!\\![\\!\\![") 1 (texttt "]\\!\\!]\\!\\!]"))) + + ;; With options + (tmcodeinline ((!option "") (!group (ttfamily) (!group 2)))) + + ;; Binary macros + (tmcolor (!group (color 1) (!group 2))) + (tmsummarizeddocumentation + (trivlist (!append (item (!option "")) (mbox "") "\\large\\bf" 1))) + (tmsummarizedgrouped (trivlist (!append (item (!option "[")) (mbox "") 1))) + (tmsummarizedexplain + (trivlist (!append (item (!option "")) (mbox "") "\\bf" 1))) + (tmsummarizedplain (trivlist (!append (item (!option "")) (mbox "") 1))) + (tmsummarizedtiny (trivlist (!append (item (!option "")) (mbox "") 1))) + (tmsummarizedraw (trivlist (!append (item (!option "")) (mbox "") 1))) + (tmsummarizedenv + (trivlist (!append (item (!option "$\\bullet$")) (mbox "") 1))) + (tmsummarizedstd + (trivlist (!append (item (!option "$\\bullet$")) (mbox "") 1))) + (tmsummarized + (trivlist (!append (item (!option "$\\bullet$")) (mbox "") 1))) + + (tmdetaileddocumentation + (trivlist (!append (item (!option "")) (mbox "") "\\large\\bf" 2))) + (tmdetailedgrouped (trivlist (!append (item (!option "[")) (mbox "") 2))) + (tmdetailedexplain + (trivlist (!append (item (!option "")) (mbox "") "\\bf" 2))) + (tmdetailedplain (trivlist (!append (item (!option "")) (mbox "") 2))) + (tmdetailedtiny (trivlist (!append (item (!option "")) (mbox "") 2))) + (tmdetailedraw (trivlist (!append (item (!option "")) (mbox "") 2))) + (tmdetailedenv (trivlist (!append (item (!option "$\\circ$")) (mbox "") 2))) + (tmdetailedstd (trivlist (!append (item (!option "$\\circ$")) (mbox "") 2))) + (tmdetailed (trivlist (!append (item (!option "$\\circ$")) (mbox "") 2))) + + (tmfoldeddocumentation + (trivlist (!append (item (!option "")) (mbox "") "\\large\\bf" 1))) + (tmunfoldeddocumentation + (trivlist (!append (item (!option "")) (mbox "") + (!group "\\large\\bf" 1) "\\\\" + (item (!option "")) (mbox "") 2))) + (tmfoldedsubsession + (trivlist (!append (item (!option "$\\bullet$")) (mbox "") 1))) + (tmunfoldedsubsession + (trivlist (!append (item (!option "$\\circ$")) (mbox "") 1 "\\\\" + (item (!option "")) (mbox "") 2 ))) + (tmfoldedgrouped + (trivlist (!append (item (!option "[")) (mbox "") 1))) + (tmunfoldedgrouped + (trivlist (!append (item (!option "$\\lceil$")) (mbox "") 1 "\\\\" + (item (!option "$\\lfloor$")) (mbox "") 2 ))) + (tmfoldedexplain (trivlist (!append (item (!option "")) "\\bf" 1))) + (tmunfoldedexplain + (trivlist (!append (item (!option "")) (mbox "") + (!group "\\bf" 1) "\\\\" + (item (!option "")) (mbox "") 2 ))) + (tmfoldedplain (trivlist (!append (item (!option "")) (mbox "") 1))) + (tmunfoldedplain + (trivlist (!append (item (!option "")) (mbox "") 1 "\\\\" + (item (!option "")) (mbox "") 2 ))) + (tmfoldedenv (trivlist (!append (item (!option "$\\bullet$")) (mbox "") 1))) + (tmunfoldedenv + (trivlist (!append (item (!option "$\\circ$")) (mbox "") 1 "\\\\" + (item (!option "")) (mbox "") 2 ))) + (tmfoldedstd (trivlist (!append (item (!option "$\\bullet$")) (mbox "") 1))) + (tmunfoldedstd + (trivlist (!append (item (!option "$\\circ$")) (mbox "") 1 "\\\\" + (item (!option "")) (mbox "") 2 ))) + (tmfolded (trivlist (!append (item (!option "$\\bullet$")) (mbox "") 1))) + (tmunfolded (trivlist (!append (item (!option "$\\circ$")) (mbox "") 1 "\\\\" + (item (!option "")) (mbox "") 2 ))) + (tminput + (trivlist (!append (item (!option (!append (color "rgb:black,10;red,9;green,4;yellow,2") 1))) + (!group (!append (color "blue!50!black") (mbox "") 2))))) + (tminputmath + (trivlist (!append (item (!option 1)) (ensuremath 2)))) + (tmhlink (!group (!append (color "blue") 1))) + (tmaction (!group (!append (color "blue") 1))) + (ontop (genfrac "" "" "0pt" "" 1 2)) + (subindex (index (!append 1 "!" 2))) + (renderfootnote (footnotetext (!append (tmrsup 1) " " 2))) + (renderfootnotestar (footnotetext (!append (tmrsup 1) " " 3))) + (tmlinenumber (!append (custombinding 1) + (tmlinenote (footnotesize 1) 2 "0cm"))) + + ;; Ternary macros + (tmsession (!group (!append (tt) 3))) + (tmfoldediomath + (trivlist (!append (item (!option (!append (color "rgb:black,10;red,9;green,4;yellow,2") 1))) + (!group (!append (color "blue!50!black") (ensuremath 2)))))) + (tmunfoldediomath + (trivlist (!append (item (!option (!append (color "rgb:black,10;red,9;green,4;yellow,2") 1))) + (!group (!append (color "blue!50!black") (ensuremath 2))) + (item (!option "")) (mbox "") 3))) + (tmfoldedio + (trivlist (!append (item (!option (!append (color "rgb:black,10;red,9;green,4;yellow,2") 1))) + (mbox "") (!group (!append (color "blue!50!black") 2))))) + (tmunfoldedio + (trivlist (!append (item (!option (!append (color "rgb:black,10;red,9;green,4;yellow,2") 1))) + (mbox "") (!group (!append (color "blue!50!black") 2)) + (item (!option "")) (mbox "") 3))) + (tmlinenote + (!append (tmdummy) + (marginpar (adjustbox + (!append "right=0cm, lap=" 2 + "-\\textwidth-\\marginparsep, raise=" 3) + 1)))) + (subsubindex (index (!append 1 "!" 2 "!" 3))) + (tmref 1) + (glossaryentry (!append (item (!option (!append 1 (hfill)))) 2 (dotfill) 3)) + + ;; Tetrary macros + (tmscriptinput (fbox (!append (fbox (!append (sf) 2)) " " + (!append (tt) 3)))) + (tmscriptoutput (!append 4)) + (tmconverterinput (fbox (!append (fbox (!append (sf) 2)) " " + (!append (tt) 3)))) + (tmconverteroutput (!append 4)) + (subsubsubindex (index (!append 1 "!" 2 "!" 3 "!" 4)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Deprecated extra macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(smart-table latex-texmacs-macro + (labeleqnum "\\addtocounter{equation}{-1}\\refstepcounter{equation}\\addtocounter{equation}{1})") + (eqnumber (!append "\\hfill(\\theequation" (!recurse (labeleqnum)) ")")) + (leqnumber (!append "(\\theequation" (!recurse (labeleqnum)) ")\\hfill")) + (reqnumber (!append "\\hfill(\\theequation" (!recurse (labeleqnum)) ")")) + (skey (!recurse (key (!append "shift-" 1)))) + (ckey (!recurse (key (!append "ctrl-" 1)))) + (akey (!recurse (key (!append "alt-" 1)))) + (mkey (!recurse (key (!append "meta-" 1)))) + (hkey (!recurse (key (!append "hyper-" 1))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Extra TeXmacs environments +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(smart-table latex-texmacs-environment + ("proof" + (!append (noindent) (textbf (!append (!translate "Proof") "\\ ")) + --- + (hspace* (fill)) (!math (Box)) (medskip))) + ("proof*" + (!append (noindent) (textbf (!append 1 "\\ ")) + --- + (hspace* (fill)) (!math (Box)) (medskip))) + ("leftaligned" + ((!begin "flushleft") ---)) + ("rightaligned" + ((!begin "flushright") ---)) + ("quoteenv" + ((!begin "quote") ---)) + ("tmcode" + ((!option "") + ((!begin "alltt") ---))) + ("tmparmod" + ((!begin "list" "" (!append "\\setlength{\\topsep}{0pt}" + "\\setlength{\\leftmargin}{" 1 "}" + "\\setlength{\\rightmargin}{" 2 "}" + "\\setlength{\\parindent}{" 3 "}" + "\\setlength{\\listparindent}{\\parindent}" + "\\setlength{\\itemindent}{\\parindent}" + "\\setlength{\\parsep}{\\parskip}")) + (!append "\\item[]" + ---))) + ("tmparsep" + (!append (begingroup) "\\setlength{\\parskip}{" 1 "}" + --- + (endgroup))) + ("tmcompact" + ((!begin "tmparsep" "0em") ---)) + ("tmcompressed" + ((!begin "tmparsep" "0.25em") ---)) + ("tmamplified" + ((!begin "tmparsep" "0.75em") ---)) + ("tmjumpin" + ((!begin "tmparmod" "1.5em" "0pt" "-1.5em") ---)) + ("tmindent" + ((!begin "tmparmod" "1.5em" "0pt" "0pt") ---)) + ("tmlisting" + ((!begin "linenumbers") (!append (resetlinenumber) ---))) + ("elsequation" ((!begin "eqnarray") (!append --- "&&"))) + ("elsequation*" ((!begin "eqnarray*") (!append --- "&&"))) + ("theglossary" + ((!begin "list" "" (!append "\\setlength{\\labelwidth}{6.5em}" + "\\setlength{\\leftmargin}{7em}" + "\\small")) ---))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; TeXmacs list environments +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-macro (latex-texmacs-itemize env lab) + `(smart-table latex-texmacs-environment + (,env + ((!begin "itemize") + (!append "\\renewcommand{\\labelitemi}{" ,lab "}" + "\\renewcommand{\\labelitemii}{" ,lab "}" + "\\renewcommand{\\labelitemiii}{" ,lab "}" + "\\renewcommand{\\labelitemiv}{" ,lab "}" + ---))))) + +(define-macro (latex-texmacs-enumerate env lab) + `(smart-table latex-texmacs-environment + (,env ((!begin "enumerate" (!option ,lab)) ---)))) + +(define-macro (latex-texmacs-description env) + `(smart-table latex-texmacs-environment + (,env ((!begin "description") ---)))) + +(latex-texmacs-itemize "itemizeminus" "$-$") +(latex-texmacs-itemize "itemizedot" "$\\bullet$") +(latex-texmacs-itemize "itemizearrow" "$\\rightarrow$") +(latex-texmacs-enumerate "enumeratenumeric" "1.") +(latex-texmacs-enumerate "enumerateroman" "i.") +(latex-texmacs-enumerate "enumerateromancap" "I.") +(latex-texmacs-enumerate "enumeratealpha" "a{\\textup{)}}") +(latex-texmacs-enumerate "enumeratealphacap" "A.") +(latex-texmacs-description "descriptioncompact") +(latex-texmacs-description "descriptionaligned") +(latex-texmacs-description "descriptiondash") +(latex-texmacs-description "descriptionlong") +(latex-texmacs-description "descriptionparagraphs") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Extra preamble definitions which are needed to export certain macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(smart-table latex-texmacs-preamble + (newmdenv + (!append (mdfsetup (!append "linecolor=black,linewidth=0.5pt," + "skipabove=0.5em,skipbelow=0.5em," + "hidealllines=true,innerleftmargin=0pt," + "innerrightmargin=0pt,innertopmargin=0pt," + "innerbottommargin=0pt" )) "\n")) + (tikzframe + (!append + (!ignore (tikz)) + "\\newcommand{\\tikzframe}[1]{%\n" + " \\tikz[baseline=(X.base)]\n" + " \\node[draw=black,semithick,rectangle,inner sep=2pt,rounded corners=2pt]\n" + " (X) {#1};}\n")) + (nonconverted + (!append "\\newcommand{\\nonconverted}[1]{\\mbox{}}\n")) + (tmkeywords + (!append (newcommand (tmkeywords) + (!append (textbf (!translate "Keywords:")) " ")) + "\n")) + (tmacm + (!append (newcommand (tmacm) + (!append + (textbf + (!translate "A.C.M. subject classification:")) " ")) + "\n")) + (tmarxiv + (!append (newcommand (tmarxiv) + (!append + (textbf + (!translate "arXiv subject classification:")) " ")) + "\n")) + (tmpacs + (!append (newcommand (tmpacs) + (!append + (textbf + (!translate "P.A.C.S. subject classification:")) + " ")) + "\n")) + (tmmsc + (!append (newcommand (tmmsc) + (!append + (textbf + (!translate "A.M.S. subject classification:")) " ")) + "\n")) + (fmtext (!append "\\newcommand{\\fmtext}[2][]{\\fntext[#1]{" + (!translate "Misc:") " #2}}\n")) + (tdatetext (!append "\\newcommand{\\tdatetext}[2][]{\\tnotetext[#1]{" + (!translate "Date:") " #2}}\n")) + (tmisctext (!append "\\newcommand{\\tmisctext}[2][]{\\tnotetext[#1]{" + (!translate "Misc:") " #2}}\n")) + (tsubtitletext (!append "\\newcommand{\\tsubtitletext}[2][]{\\tnotetext[#1]{" + (!translate "Subtitle:") " #2}}\n")) + (thankshomepage (!append "\\newcommand{\\thankshomepage}[2][]{\\thanks[#1]{" + (!translate "URL:") " #2}}\n")) + (thanksemail (!append "\\newcommand{\\thanksemail}[2][]{\\thanks[#1]{" + (!translate "Email:") " #2}}\n")) + (thanksdate (!append "\\newcommand{\\thanksdate}[2][]{\\thanks[#1]{" + (!translate "Date:") " #2}}\n")) + (thanksamisc (!append "\\newcommand{\\thanksamisc}[2][]{\\thanks[#1]{" + (!translate "Misc:") " #2}}\n")) + (thanksmisc (!append "\\newcommand{\\thanksmisc}[2][]{\\thanks[#1]{" + (!translate "Misc:") " #2}}\n")) + (thankssubtitle (!append "\\newcommand{\\thankssubtitle}[2][]{\\thanks[#1]{" + (!translate "Subtitle:") " #2}}\n")) + (qed (!append (providecommand "\\qed" (ensuremath (Box))) "\n")) + (mho + (!append + "\\renewcommand{\\mho}{\\mbox{\\rotatebox[origin=c]{180}{$\\omega$}}}")) + (invbreve + (!append + "\\usepackage[T3,T1]{fontenc}\n" + "\\DeclareSymbolFont{tipa}{T3}{cmr}{m}{n}\n" + "\\DeclareMathAccent{\\invbreve}{\\mathalpha}{tipa}{16}\n")) + (custombinding + (!append + "\\newcounter{tmcounter}\n" + "\\newcommand{\\custombinding}[1]{%\n" + " \\setcounter{tmcounter}{#1}%\n" + " \\addtocounter{tmcounter}{-1}%\n" + " \\refstepcounter{tmcounter}}\n")) + (tmfloat + (!append + (!ignore (ifthenelse) (captionof) (widthof)) + "\\newcommand{\\tmfloatcontents}{}\n" + "\\newlength{\\tmfloatwidth}\n" + "\\newcommand{\\tmfloat}[5]{\n" + " \\renewcommand{\\tmfloatcontents}{#4}\n" + " \\setlength{\\tmfloatwidth}{\\widthof{\\tmfloatcontents}+1in}\n" + " \\ifthenelse{\\equal{#2}{small}}\n" + ;; FIXME: the length test frequently produces an error: + ;; '! Missing = inserted for \ifdim'. + ;; I (Joris) did not manage to understand this LaTeX mess. + ;;" {\\ifthenelse{\\lengthtest{\\tmfloatwidth > \\linewidth}}\n" + ;;" {\\setlength{\\tmfloatwidth}{\\linewidth}}{}}\n" + " {\\setlength{\\tmfloatwidth}{0.45\\linewidth}}\n" + " {\\setlength{\\tmfloatwidth}{\\linewidth}}\n" + " \\begin{minipage}[#1]{\\tmfloatwidth}\n" + " \\begin{center}\n" + " \\tmfloatcontents\n" + " \\captionof{#3}{#5}\n" + " \\end{center}\n" + " \\end{minipage}}\n")) + (addtocountergroup (!append "\\newcommand{\\addtocountergroup}[2]{}\n")) + (groupcommoncounter (!append "\\newcommand{\\groupcommoncounter}[1]{}\n"))) + +;;(define-macro (latex-texmacs-long prim x l m r) +;; `(smart-table latex-texmacs-preamble +;; (,(string->symbol (substring prim 1 (string-length prim))) +;; (!append +;; "\\def" ,prim "fill@{\\arrowfill@" ,l ,m ,r "}\n" +;; "\\providecommand{" ,prim "}[2][]{" +;; "\\ext@arrow 0099" ,prim "fill@{#1}{#2}}\n")))) + +(define-macro (latex-texmacs-long prim x l m r) + `(smart-table latex-texmacs-preamble + (,(string->symbol (substring prim 1 (string-length prim))) + (!append + "\\providecommand{" ,prim "}[2][]{" + "\\mathop{" ,x "}\\limits_{#1}^{#2}}\n")))) + +(latex-texmacs-long "\\xminus" "-" + "\\DOTSB\\relbar" "\\relbar" "\\DOTSB\\relbar") +(latex-texmacs-long "\\xleftrightarrow" "\\longleftrightarrow" + "\\leftarrow" "\\relbar" "\\rightarrow") +(latex-texmacs-long "\\xmapsto" "\\longmapsto" + "\\vdash" "\\relbar" "\\rightarrow") +(latex-texmacs-long "\\xmapsfrom" "\\leftarrow\\!\\!\\dashv" + "\\leftarrow" "\\relbar" "\\dashv") +(latex-texmacs-long "\\xequal" "=" + "\\DOTSB\\Relbar" "\\Relbar" "\\DOTSB\\Relbar") +(latex-texmacs-long "\\xLeftarrow" "\\Longleftarrow" + "\\Leftarrow" "\\Relbar" "\\Relbar") +(latex-texmacs-long "\\xRightarrow" "\\Longrightarrow" + "\\Relbar" "\\Relbar" "\\Rightarrow") +(latex-texmacs-long "\\xLeftrightarrow" "\\Longleftrightarrow" + "\\Leftarrow" "\\Relbar" "\\Rightarrow") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Plain style theorems +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define-macro (latex-texmacs-thmenv prim name before after . opt-mode) + (let* ((head (if (null? opt-mode) (list) (list `(:mode ,(car opt-mode))))) + (prim* (string-append prim "*")) + (nonum (string-append "nn" prim)) + (thenonum (string-append "\\the" nonum))) + `(smart-table latex-texmacs-env-preamble + ,@head + (,prim (!append ,@before + (newtheorem ,prim (!translate ,name)) + ,@after "\n")) + (,prim* (!append (newcounter ,nonum) "\n" + "\\def" ,thenonum "{\\unskip}\n" + ,@before + (newtheorem ,prim* (!option ,nonum) (!translate ,name)) + ,@after "\n"))))) + +(define-macro (latex-texmacs-theorem prim name) + `(latex-texmacs-thmenv ,prim ,name () ())) + +(define-macro (latex-texmacs-remark prim name) + `(latex-texmacs-thmenv + ,prim ,name ("{" (!recurse (theorembodyfont "\\rmfamily"))) ("}"))) + +(define-macro (latex-texmacs-exercise prim name) + `(latex-texmacs-thmenv + ,prim ,name ("{" (!recurse (theorembodyfont "\\rmfamily\\small"))) ("}"))) + +(latex-texmacs-theorem "theorem" "Theorem") +(latex-texmacs-theorem "proposition" "Proposition") +(latex-texmacs-theorem "lemma" "Lemma") +(latex-texmacs-theorem "corollary" "Corollary") +(latex-texmacs-theorem "axiom" "Axiom") +(latex-texmacs-theorem "definition" "Definition") +(latex-texmacs-theorem "notation" "Notation") +(latex-texmacs-theorem "conjecture" "Conjecture") +(latex-texmacs-remark "remark" "Remark") +(latex-texmacs-remark "note" "Note") +(latex-texmacs-remark "example" "Example") +(latex-texmacs-remark "convention" "Convention") +(latex-texmacs-remark "warning" "Warning") +(latex-texmacs-remark "acknowledgments" "Acknowledgments") +(latex-texmacs-remark "answer" "Answer") +(latex-texmacs-remark "question" "Question") +(latex-texmacs-exercise "exercise" "Exercise") +(latex-texmacs-exercise "problem" "Problem") +(latex-texmacs-exercise "solution" "Solution") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Ornamented environments +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(smart-table latex-texmacs-env-preamble + ("tmpadded" (!append (newmdenv (!option "") "tmpadded") "\n")) + ("tmoverlined" + (!append (newmdenv (!option "topline=true,innertopmargin=1ex") + "tmoverlined") "\n")) + ("tmunderlined" + (!append (newmdenv (!option "bottomline=true,innerbottommargin=1ex") + "tmunderlined") "\n")) + ("tmbothlined" + (!append (newmdenv (!option "topline=true,bottomline=true,innertopmargin=1ex,innerbottommargin=1ex") + "tmbothlined") "\n")) + ("tmframed" + (!append (newmdenv (!option "hidealllines=false,innertopmargin=1ex,innerbottommargin=1ex,innerleftmargin=1ex,innerrightmargin=1ex") + "tmframed") "\n")) + ("tmornamented" + (!append (newmdenv (!option "hidealllines=false,innertopmargin=1ex,innerbottommargin=1ex,innerleftmargin=1ex,innerrightmargin=1ex") + "tmornamented") "\n"))) diff --git a/progs/convert/latex/latex-drd.scm b/progs/convert/latex/latex-drd.scm new file mode 100644 index 0000000..7ae7133 --- /dev/null +++ b/progs/convert/latex/latex-drd.scm @@ -0,0 +1,286 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : latex-drd.scm +;; DESCRIPTION : Formal specification of the part of LaTeX +;; which is understood by TeXmacs +;; COPYRIGHT : (C) 1999-2022 Joris van der Hoeven +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex latex-drd) + (:use (convert latex latex-overload))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Order in which packages should be included +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-table latex-package-priority% + ("geometry" 10) + ("amsmath" 20) + ("amssymb" 30) + ("graphicx" 40) + ("wasysym" 50) + ("stmaryrd" 60) + ("textcomp" 60) + ("enumerate" 70) + ("epsfig" 80) + ("mathrsfs" 90) + ("bbm" 100) + ("dsfont" 110) + ("euscript" 120) + ("multicol" 130) + ("hyperref" 140) + ("mathtools" 150) + ("cleveref" 160)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies between style files and packages +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-table latex-depends% + ("amsart" "amstex") + ("amstex" "amsmath") + ("amstex" "amsthm")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies of commands on packages +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-table latex-needs% + (!verbatim "alltt") + (!verbatim* "alltt") + (begin-alltt "alltt") + + (begin-tabularx "tabularx") + + (geometry "geometry") + (epsfig "epsfig") + (includegraphics "graphicx") + (rotatebox "graphicx") + (scalebox "graphicx") + (reflectbox "graphicx") + (adjustbox "adjustbox") + + (mathscr "mathrsfs") + (EuScript "euscript") + (mathbbm "bbm") + (mathbbmss "bbm") + (mathds "dsfont") + (mathfrak "amssymb") + (mathbb "amssymb") + (theorembodyfont "theorem") + (substack "mathtools") + + (begin-align "amsmath") + (begin-align* "amsmath") + (begin-alignat "amsmath") + (begin-alignat* "amsmath") + (begin-xalignat "amsmath") + (begin-xxalignat "amsmath") + (begin-flalign "amsmath") + (begin-flalign* "amsmath") + (begin-gather "amsmath") + (begin-gather* "amsmath") + (begin-multline "amsmath") + (begin-multline* "amsmath") + (begin-split "amsmath") + + (text "amsmath") + (binom "amsmath") + (dbinom "amsmath") + (tbinom "amsmath") + (dddot "amsmath") + (ddddot "amsmath") + (genfrac "amsmath") + (mod "amsmath") + (pod "amsmath") + (overset "amsmath") + (underset "amsmath") + (operatorname "amsmath") + (boldsymbol "amsmath") + (overleftrightarrow "amsmath") + (underleftarrow "amsmath") + (underrightarrow "amsmath") + (underleftrightarrow "amsmath") + + (underaccent "accents") + (ring "accents") + + (ifthenelse "ifthen") + (captionof "capt-of") + (widthof "calc") + + (color "xcolor") + (fcolorbox "xcolor") + (textcolor "xcolor") + + (euro "eurosym") + + (mdfsetup ("tikz" "mdframed")) + (tikz "tikz") + + (omicron "pslatex") + (multicols "multicol") + (bundle "epic") + (chunk "epic") + (bundle "ecltree") + (chunk "ecltree") + + (url "hyperref") + (href "hyperref") + (hyperref "hyperref") + + (cref "cleveref") + (Cref "cleveref") + + (citet "natbib") + (citep "natbib") + (citet* "natbib") + (citep* "natbib") + (citealt "natbib") + (citealp "natbib") + (citealt* "natbib") + (citealp* "natbib") + (citetext "natbib") + (citeauthor "natbib") + (citeauthor* "natbib") + (citeyear "natbib") + + (index "makeidx") + (printindex "makeidx") + + (inparaenum "paralist") + + (listpart "expdlist") + + (ifthispageodd "scrextend") + + (begin-linenumbers "lineno") + (resetlinenumber "lineno")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Page size settings +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-table latex-paper-opts% + ("page-top" "top") + ("page-bot" "bottom") + ("page-odd" "left") + ("page-even" "left") + ("page-right" "right") + ("page-height" "paperheight") + ("page-width" "paperwidth") + ("page-type" "page-type") + ("page-orientation" "page-orientation")) + +(logic-table latex-paper-type% + ("a0" "a0paper") + ("a1" "a1paper") + ("a2" "a2paper") + ("a3" "a3paper") + ("a4" "a4paper") + ("a5" "a5paper") + ("a6" "a6paper") + ("a7" "papersize={74mm,105mm}") + ("a8" "papersize={52mm,74mm") + ("a9" "papersize={37mm,52mm}") + ("b0" "b0paper") + ("b1" "b1paper") + ("b2" "b2paper") + ("b3" "b3paper") + ("b4" "b4paper") + ("b5" "b5paper") + ("b6" "b6paper") + ("b7" "papersize={88mm,125mm}") + ("b8" "papersize={62mm,88mm}") + ("b9" "papersize={44mm,62mm}") + ("legal" "legalpaper") + ("letter" "letterpaper") + ("executive" "executivepaper") + ("archA" "papersize={9in,12in}") + ("archB" "papersize={12in,18in}") + ("archC" "papersize={18in,24in}") + ("archD" "papersize={24in,36in}") + ("archE" "papersize={36in,48in}") + ("10x14" "papersize={10in,14in}") + ("11x17" "papersize={11in,17in}") + ("C5" "papersize={162mm,229mm}") + ("Comm10" "papersize={297pt,684pt}") + ("DL" "papersize={110mm,220mm}") + ("halfletter" "papersize={140mm,216mm}") + ("halfexecutive" "papersize={133mm,184mm}") + ("ledger" "papersize={432mm,279mm}") + ("Monarch" "papersize={98mm,190mm}") + ("csheet" "papersize={432mm,559mm}") + ("dsheet" "papersize={559mm,864mm}") + ("esheet" "papersize={864mm,1118mm}") + ("flsa" "papersize={216mm,330mm}") + ("flse" "papersize={216mm,330mm}") + ("folio" "papersize={216mm,330mm}") + ("lecture note" "papersize={15.5cm,23.5cm}") + ("note" "papersize={216mm,279mm}") + ("quarto" "papersize={215mm,275mm}") + ("statement" "papersize={140mm,216mm}") + ("tabloid" "papersize={279mm,432mm}")) + +;; cpp interface with reversed access + +(tm-define (latex-paper-opts s) + (with r (query `(latex-paper-opts% 'x ,s)) + (if (nnull? r) (cdaar r) "undefined"))) + +(tm-define (latex-paper-type s) + (with r (query `(latex-paper-type% 'x ,s)) + (if (nnull? r) (cdaar r) "undefined"))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Routines for consulting the database (might become deprecated) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (latex-resolve s) + (define (safe-string2symbol s) + (if (== s "") (string->symbol " ") (string->symbol s))) + + (if (string-starts? s "\\") + (set! s (substring s 1 (string-length s)))) + + (with arity (logic-ref latex-arity% (safe-string2symbol s)) + (if (logic-in? (safe-string2symbol s) latex-optional-arg%) + (set! arity (- -1 arity))) + (if (string-starts? s "end-") + (begin + (set! s (string-append "begin-" (substring s 4 (string-length s)))) + (set! arity 0))) + (values (safe-string2symbol s) arity))) + +(tm-define (latex-arity tag) + "Get the arity of a LaTeX @tag" + (receive (s arity) (latex-resolve tag) + (or arity 0))) + +(tm-define (latex-type tag) + "Get the type of a LaTeX @tag" + (receive (s arity) (latex-resolve tag) + (cond ((not arity) "undefined") + ((logic-in? s latex-command%) "command") + ((logic-in? s latex-length%) "length") + ((logic-in? s latex-ignore%) "ignore") + ((logic-in? s latex-as-pic%) "as-picture") + ((logic-in? s latex-name%) "name") + ((logic-in? s latex-counter%) "counter") + ((logic-in? s latex-modifier%) "modifier") + ((logic-in? s latex-control%) "control") + ((logic-in? s latex-operator%) "operator") + ((logic-in? s latex-list%) "list") + ((logic-in? s latex-math-environment%) "math-environment") + ((logic-in? s latex-enunciation%) "enunciation") + ((logic-in? s latex-environment%) "environment") + ((logic-in? s latex-texmacs%) "texmacs") + ((logic-in? s latex-symbol%) "symbol") + ((logic-in? s latex-big-symbol%) "big-symbol") + (else "undefined")))) diff --git a/progs/convert/latex/latex-overload.scm b/progs/convert/latex/latex-overload.scm new file mode 100644 index 0000000..df4e9e2 --- /dev/null +++ b/progs/convert/latex/latex-overload.scm @@ -0,0 +1,143 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : latex-overload.scm +;; DESCRIPTION : LaTeX re-definitions for specific styles/packages +;; COPYRIGHT : (C) 2005 Joris van der Hoeven +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex latex-overload) + (:use (convert latex latex-define))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Letter and article styles +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(smart-table latex-texmacs-macro + (:require (latex-has-style? "letter")) + (appendix "")) + +(define-macro (latex-texmacs-section name inside style) + `(smart-table latex-texmacs-macro + (:require (latex-has-style? ,style)) + (,name (!append (medskip) (bigskip) "\n\n" (noindent) (textbf ,inside))))) + +(define-macro (latex-texmacs-paragraph name inside style) + `(smart-table latex-texmacs-macro + (:require (latex-has-style? ,style)) + (,name (!append (smallskip) "\n\n" (noindent) (textbf ,inside))))) + +(latex-texmacs-section chapter (!append "\\huge " 1) "article") +(latex-texmacs-section chapter (!append "\\huge " 1) "letter") +(latex-texmacs-section section (!append "\\LARGE " 1) "letter") +(latex-texmacs-section subsection (!append "\\Large " 1) "letter") +(latex-texmacs-section subsubsection (!append "\\large " 1) "letter") +(latex-texmacs-paragraph paragraph 1 "letter") +(latex-texmacs-paragraph subparagraph 1 "letter") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; amsthm package +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(smart-table latex-texmacs-macro + (:require (latex-depends? "amsthm")) + (qed #f)) + +(smart-table latex-texmacs-environment + (:require (or (latex-depends? "amsthm") + (latex-has-texmacs-style? "amsart"))) + ("proof" #f)) + +(define-macro (ams-texmacs-theorem abbr full) + `(smart-table latex-texmacs-env-preamble + (:require (latex-depends? "amsthm")) + (,abbr (!append "\\theoremstyle{plain}\n" + (newtheorem ,abbr (!translate ,full)) "\n")))) + +(define-macro (ams-texmacs-remark abbr full) + `(smart-table latex-texmacs-env-preamble + (:require (latex-depends? "amsthm")) + (,abbr (!append "\\theoremstyle{remark}\n" + (newtheorem ,abbr (!translate ,full)) "\n")))) + +(define-macro (ams-texmacs-exercise abbr full) + `(smart-table latex-texmacs-env-preamble + (:require (latex-depends? "amsthm")) + (,abbr (!append "\\newtheoremstyle{indent-exercise}{3pt}{3pt}" + "{\\small}{\\parindent}{\\bf\\small}{.}{.5em}{}{}\n" + "\\theoremstyle{indent-exercise}\n" + (newtheorem ,abbr (!translate ,full)) "\n")))) + +(ams-texmacs-theorem "theorem" "Theorem") +(ams-texmacs-theorem "proposition" "Proposition") +(ams-texmacs-theorem "lemma" "Lemma") +(ams-texmacs-theorem "corollary" "Corollary") +(ams-texmacs-theorem "axiom" "Axiom") +(ams-texmacs-theorem "definition" "Definition") +(ams-texmacs-theorem "notation" "Notation") +(ams-texmacs-theorem "conjecture" "Conjecture") +(ams-texmacs-remark "remark" "Remark") +(ams-texmacs-remark "note" "Note") +(ams-texmacs-remark "example" "Example") +(ams-texmacs-remark "convention" "Convention") +(ams-texmacs-remark "acknowledgments" "Acknowledgments") +(ams-texmacs-remark "warning" "Warning") +(ams-texmacs-remark "answer" "Answer") +(ams-texmacs-remark "question" "Question") +(ams-texmacs-exercise "exercise" "Exercise") +(ams-texmacs-exercise "problem" "Problem") +(ams-texmacs-exercise "solution" "Solution") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Framed session package +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(smart-table latex-texmacs-macro + (:require (latex-has-texmacs-package? "framed-session")) + (tmerrput ((!begin "tmframed" (!option "skipabove=0,skipbelow=0,backgroundcolor={red!15},linecolor={red!50!black}")) + (!append (color "red!50!black") 1))) + (tmfoldedsubsession + ((!begin "tmframed" (!option "skipabove=0,skipbelow=0,backgroundcolor={rgb:white,10;red,9;green,4;yellow,2},linecolor={black!50}")) + (trivlist (!append (item (!option "$\\bullet$")) (mbox "") 1)))) + (tmunfoldedsubsession + (!append + ((!begin "tmframed" (!option "skipabove=0,skipbelow=0,backgroundcolor={rgb:white,10;red,9;green,4;yellow,2},linecolor={black!50}")) + (trivlist (!append (item (!option "$\\circ$")) (mbox "") 1))) + ((!begin "tmframed" (!option "skipabove=0,skipbelow=0,backgroundcolor={rgb:white,50;red,9;green,4;yellow,2},linecolor={black!50}")) + (trivlist (!append (item (!option "")) (mbox "") 2 ))))) + (tminput + ((!begin "tmframed" (!option "skipabove=0,skipbelow=0,backgroundcolor={yellow!15},linecolor={black!15}")) + (trivlist (!append (item (!option (!append (color "rgb:black,10;red,9;green,4;yellow,2") 1))) + (!group (!append (color "blue!50!black") (mbox "") 2)))))) + (tminputmath + ((!begin "tmframed" (!option "skipabove=0,skipbelow=0,backgroundcolor={yellow!15},linecolor={black!15}")) + (trivlist (!append (item (!option 1)) (mbox "") (ensuremath 2))))) + + + (tmfoldediomath + ((!begin "tmframed" (!option "skipabove=0,skipbelow=0,backgroundcolor={yellow!15},linecolor={black!15}")) + (trivlist (!append (item (!option (!append (color "rgb:black,10;red,9;green,4;yellow,2") 1))) + (mbox "") (!group (!append (color "blue!50!black") (ensuremath 2))))))) + (tmunfoldediomath + (!append ((!begin "tmframed" (!option "skipabove=0,skipbelow=0,backgroundcolor={yellow!15},linecolor={black!15}")) + (trivlist (!append (item (!option (!append (color "rgb:black,10;red,9;green,4;yellow,2") 1))) + (mbox "") (!group (!append (color "blue!50!black") (ensuremath 2)))))) + ((!begin "tmframed" (!option "skipabove=0,skipbelow=0,backgroundcolor=white,linewidth=0pt")) + (trivlist (!append (item (!option "")) (mbox "") 3))))) + (tmfoldedio + ((!begin "tmframed" (!option "skipabove=0,skipbelow=0,backgroundcolor={yellow!15},linecolor={black!15}")) + (trivlist (!append (item (!option (!append (color "rgb:black,10;red,9;green,4;yellow,2") 1))) + (mbox "") (!group (!append (color "blue!50!black") 2)))))) + (tmunfoldedio + (!append ((!begin "tmframed" (!option "skipabove=0,skipbelow=0,backgroundcolor={yellow!15},linecolor={black!15}")) + (trivlist (!append (item (!option (!append (color "rgb:black,10;red,9;green,4;yellow,2") 1))) + (mbox "") (!group (!append (color "blue!50!black") 2))))) + ((!begin "tmframed" (!option "skipabove=0,skipbelow=0,backgroundcolor=white,linewidth=0pt")) + (trivlist (!append (item (!option "")) (mbox "") 3)))))) diff --git a/progs/convert/latex/latex-symbol-drd.scm b/progs/convert/latex/latex-symbol-drd.scm new file mode 100644 index 0000000..109c588 --- /dev/null +++ b/progs/convert/latex/latex-symbol-drd.scm @@ -0,0 +1,257 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : latex-symbol-drd.scm +;; DESCRIPTION : LaTeX symbols supported by TeXmacs +;; COPYRIGHT : (C) 1999 Joris van der Hoeven +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex latex-symbol-drd) + (:use (convert latex latex-command-drd))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Basic symbols and big symbols +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-symbol% + ;; Greek letters + Gamma Delta Theta Lambda Xi Pi Sigma Upsilon Phi Psi Omega + alpha beta gamma delta epsilon + varepsilon zeta eta theta vartheta + iota kappa lambda mu nu omicron + xi pi varpi rho + varrho sigma varsigma tau upsilon + phi varphi chi psi omega + + ;; Binary operations + pm mp times div ast star circ bullet cdot + cap cup uplus sqcap sqcup vee wedge setminus wr + diamond triangleleft triangleright land lor lnot + oplus ominus otimes oslash odot bigcirc amalg notin + + ;; Relations + leq le geq ge equiv models prec + succ sim perp preceq succeq + simeq mid ll gg asymp + parallel subset supset approx bowtie + subseteq supseteq cong + ne neq smile sqsubseteq sqsupseteq + doteq frown in ni propto + vdash dashv + + ;; Arrows + leftarrow rightarrow uparrow downarrow + Leftarrow Rightarrow Uparrow Downarrow + nearrow searrow swarrow nwarrow + leftrightarrow updownarrow Updownarrow Leftrightarrow + leftharpoonup leftharpoondown rightharpoonup rightharpoondown + hookleftarrow hookrightarrow + to mapsto longmapsto + longrightarrow longleftarrow longleftrightarrow + Longrightarrow Longleftarrow Longleftrightarrow + + ;; Miscellaneous symbols + ldots cdots vdots ddots hdots aleph + prime forall infty hbar emptyset + exists nabla surd triangle + imath jmath ell neg + top flat natural sharp wp + bot clubsuit diamondsuit heartsuit spadesuit + Re Im angle partial textbackslash + dag ddag dagger ddagger guillemotleft guillemotright + + ;; Delimiters + uparrow Uparrow downarrow Downarrow + updownarrow Updownarrow + lfloor rfloor lceil rceil + langle rangle backslash + + ;; Big delimiters + rmoustache lmoustache rgroup lgroup + lbrack rbrack lbrace rbrace + arrowvert Arrowvert bracevert) + +(logic-group latex-big-symbol% + sum prod coprod + bignone bigtimes bigoplus bigotimes bigodot + bigvee bigwedge bigsqcup bigcup bigcap bigpluscup + bigtriangledown bigtriangleup + int bigiint bigiiint bigiiiint bigidotsint oint bigoiint bigoiiint + bigintwl bigiintwl bigiiintwl bigiiiintwl bigidotsintwl + bigointwl bigoiintwl bigoiiintwl + bigupint bigupiint bigupiiint bigupoint bigupoiint bigupoiiint + bigupintwl bigupiintwl bigupiiintwl bigupointwl bigupoiintwl bigupoiiintwl) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Symbols from latexsym package +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-latexsym-symbol% + mho Join Box Diamond leadsto + sqsubset sqsupset lhd rhd unlhd unrhd) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Symbols from amssymb package +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-ams-symbol% + ;;` + ;; Box sqsubset sqsupset lhd unlhd rhd unrhd + Bbbk Bumpeq Cap Cup Finv Game Lleftarrow Lsh + Rrightarrow Rsh Subset Supset Vdash Vvdash + angle approxeq backepsilon backprime backsim backsimeq barwedge + because beth between bigstar blacklozenge blacksquare blacktriangle + blacktriangledown blacktriangleleft blacktriangleright box boxdot + boxminus boxplus boxtimes bumpeq centerdot checkmark circeq + circlearrowleft circlearrowright circledR circledS circledast + circledcirc circleddash complement curlyeqprec curlyeqsucc curlyvee + curlywedge curvearrowleft curvearrowright daleth diagdown diagup + digamma divideontimes doteqdot dotplus doublebarwedge downdownarrows + downharpoonleft downharpoonright eqcirc eqsim eqslantgtr eqslantless + eth fallingdotseq frown geqq geqslant ggg gimel gnapprox gneq gneqq + gnsim gtrapprox gtrdot gtreqless gtreqqless gtrless gtrsim gvertneqq + hslash intercal leftarrowtail leftleftarrows leftrightarrows + leftrightharpoons leftrightsquigarrow leftthreetimes leqq leqslant + lessapprox lessdot lesseqgtr lesseqqgtr lessgtr lesssim + llcorner lll lnapprox lneq lneqq lnsim looparrowleft looparrowright + lozenge lrcorner ltimes lvert lVert lvertneqq maltese measuredangle models + multimap nLeftarrow nLeftrightarrow nRightarrow nVDash nVdash + ncong nexists ngeq ngeqq ngeqslant ngtr nleftarrow nleftrightarrow + nleq nleqq nleqslant nless nmid nparallel nprec npreceq nrightarrow + nshortmid nshortparallel nsim nsubseteq nsubseteqq nsucc nsucceq + nsupseteq nsupseteqq ntriangleleft ntrianglelefteq ntriangleright + ntrianglerighteq nvDash nvdash pitchfork precapprox preccurlyeq + precnapprox precneqq precnsim precsim propto rhd rightarrowtail + rightleftarrows rightleftharpoons rightrightarrows rightsquigarrow + rightthreetimes risingdotseq rtimes rvert rVert shortleftarrow shortmid + shortparallel shortrightarrow smalldash smallfrown smallsetminus + smallsmile smile sphericalangle subseteqq + subsetneq subsetneqq succapprox succcurlyeq succnapprox succneqq + succnsim succsim supseteqq supsetneq supsetneqq therefore + thickapprox thicksim triangle triangledown trianglelefteq + triangleq trianglerighteq twoheadleftarrow twoheadrightarrow + ulcorner upharpoonleft upharpoonright upuparrows + urcorner vDash varkappa varnothing varpropto varsubsetneq + varsubsetneqq varsupsetneq varsupsetneqq vartriangle + vartriangleleft vartriangleright veebar yen) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Symbols from wasysym package +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-wasy-symbol% + agemO APLbox APLcomment APLdownarrowbox APLdown APLinput + APLleftarrowbox APLrightarrowbox APLstar APLuparrowbox APLup apprge + apprle aquarius ascnode ataribox bell blacksmiley + Bowtie brokenvert cancer capricornus cent checked + CIRCLE Circle clock conjunction currency davidsstar + descnode dh diameter DOWNarrow eighthnote female + frownie fullnote gemini halfnote hexagon hexstar + invdiameter inve invneg jupiter kreuz LEFTarrow + LEFTCIRCLE Leftcircle leftmoon leftturn libra logof + male mercury neptune octagon openo opposition + pentagon permil phone pisces pluto pointer + quarternote recorder RIGHTarrow RIGHTCIRCLE Rightcircle + rightmoon rightturn sagittarius saturn + scorpio smiley square sun taurus Thorn + thorn twonotes UParrow uranus varangle varhexagon + varhexstar varlightning vernal VHF virgo + ;;wasy-38 wasy-58 wasy-80 wasy-81 wasy-82 + wasyBox wasyDiamond wasyleadsto wasylhd wasylozenge + wasypropto wasyrhd wasysqsubset wasysqsupset wasytherefore + wasyunlhd wasyunrhd XBox) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Symbols from stmaryrd package +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-stmary-symbol% + Arrownot arrownot baro bbslash binampersand bindnasrepma + boxast boxbar boxbox boxbslash boxcircle + ;;boxdot + boxempty boxslash curlyveedownarrow curlyveeuparrow + curlywedgedownarrow curlywedgeuparrow fatbslash fatsemi fatslash + inplus interleave large-llbracket large-rrbracket Lbag lbag + leftarrowtriangle leftrightarroweq leftrightarrowtriangle + leftslice lightning llbracket llceil llfloor llparenthesis + Mapsfromchar mapsfromchar Mapstochar merge minuso moo + niplus nnearrow nnwarrow nplus ntrianglelefteqslant + ntrianglerighteqslant obar oblong obslash ogreaterthan + olessthan ovee owedge Rbag rbag rightarrowtriangle rightslice + rrbracket rrceil rrfloor rrparenthesis shortdownarrow + shortleftarrow shortrightarrow shortuparrow ssearrow sslash + sswarrow subsetpluseq subsetplus supsetpluseq supsetplus talloblong + trianglelefteqslant trianglerighteqslant varbigcirc varcurlyvee + varcurlywedge varoast varobar varobslash varocircle + varodot varogreaterthan varolessthan varominus varoplus varoslash + varotimes varovee varowedge vartimes Ydown Yleft Yright Yup) + +(logic-group latex-stmary-big-symbol% + bigbox bigcurlyvee bigcurlywedge biginterleave + bignplus bigparallel bigsqcap) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Symbols from mathabx package +;; NOTE: we avoid using the mathabx package because it tends +;; to be badly installed and incompatible with certain styles +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;(logic-group latex-mathabx-symbol% +;; divides ndivides npreccurlyeq asterisk +;; dottimes nequiv precdot) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Symbols from textcomp package +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-textcomp-symbol% + textcent textcurrency textyen textbrokenbar textasciidieresis textlnot + textasciimacron textdegree textpm texttwosuperior textthreesuperior + textasciiacute textmu textonesuperior textonequarter textonehalf + textthreequarters texttimes textdiv) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Symbols from upgreek package +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-upgreek-symbol% + upalpha upbeta upgamma updelta upepsilon + upvarepsilon upzeta upeta uptheta upvartheta + upiota upkappa uplambda upmu upnu upomicron + upxi uppi upvarpi uprho + upvarrho upsigma upvarsigma uptau upupsilon + upphi upvarphi upchi uppsi upomega + + Upalpha Upbeta Upgamma Updelta Upepsilon + Upzeta Upeta Uptheta Upiota Upkappa Uplambda + Upmu Upnu Upomicron Upxi Uppi Uprho Upsigma + Uptau Upupsilon Upphi Upchi Uppsi Upomega) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Rules +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-rules + ((latex-arity% 'x 0) (latex-symbol% 'x)) + ((latex-arity% 'x 0) (latex-big-symbol% 'x)) + ((latex-symbol% 'x) (latex-latexsym-symbol% 'x)) + ((latex-needs% 'x "latexsym") (latex-latexsym-symbol% 'x)) + ((latex-symbol% 'x) (latex-ams-symbol% 'x)) + ((latex-needs% 'x "amssymb") (latex-ams-symbol% 'x)) + ((latex-symbol% 'x) (latex-wasy-symbol% 'x)) + ((latex-needs% 'x "wasysym") (latex-wasy-symbol% 'x)) + ((latex-symbol% 'x) (latex-stmary-symbol% 'x)) + ((latex-needs% 'x "stmaryrd") (latex-stmary-symbol% 'x)) + ((latex-big-symbol% 'x) (latex-stmary-big-symbol% 'x)) + ((latex-needs% 'x "stmaryrd") (latex-stmary-big-symbol% 'x)) + ;;((latex-symbol% 'x) (latex-mathabx-symbol% 'x)) + ;;((latex-needs% 'x "mathabx") (latex-mathabx-symbol% 'x)) + ((latex-symbol% 'x) (latex-textcomp-symbol% 'x)) + ((latex-needs% 'x "textcomp") (latex-textcomp-symbol% 'x)) + ((latex-symbol% 'x) (latex-upgreek-symbol% 'x)) + ((latex-needs% 'x "upgreek") (latex-upgreek-symbol% 'x))) diff --git a/progs/convert/latex/latex-texmacs-drd.scm b/progs/convert/latex/latex-texmacs-drd.scm new file mode 100644 index 0000000..25aa999 --- /dev/null +++ b/progs/convert/latex/latex-texmacs-drd.scm @@ -0,0 +1,324 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : latex-texmacs-drd.scm +;; DESCRIPTION : TeXmacs extensions to LaTeX +;; COPYRIGHT : (C) 2005 Joris van der Hoeven +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex latex-texmacs-drd) + (:use (convert latex latex-symbol-drd))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Extra TeXmacs symbols +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-texmacs-symbol% + ;; arrows and other symbols with limits + leftarrowlim rightarrowlim leftrightarrowlim mapstolim + longleftarrowlim longrightarrowlim longleftrightarrowlim longmapstolim + leftsquigarrowlim rightsquigarrowlim leftrightsquigarrowlim + equallim longequallim Leftarrowlim Rightarrowlim + Leftrightarrowlim Longleftarrowlim Longrightarrowlim Longleftrightarrowlim + cdotslim + + ;; further arrows + threeleftarrows threerightarrows + fourleftarrows fourrightarrows + longleftrightarrows longleftleftarrows + longthreeleftarrows longthreerightarrows + longrightleftarrows longrightrightarrows + longfourleftarrows longfourrightarrows + LRleftrightarrow Llongleftarrow Llongrightarrow Llongleftrightarrow + + ;; rotated arrows and other symbols + mapsfrom longmapsfrom mapmulti leftsquigarrow + upequal downequal longupequal longdownequal longupminus longdownminus + longuparrow longdownarrow longupdownarrow + Longuparrow Longdownarrow Longupdownarrow + mapsup mapsdown longmapsup longmapsdown + upsquigarrow downsquigarrow updownsquigarrow + hookuparrow hookdownarrow longhookuparrow longhookdownarrow + Backepsilon Backsigma Mho btimes + + ;; asymptotic relations by Joris + nasymp asympasymp nasympasymp simsim nsimsim + precprec precpreceq precprecprec precprecpreceq + succsucc succsucceq succsuccsucc succsuccsucceq + lleq llleq ggeq gggeq triplesim ntriplesim + + ;; replacements for symbols from mathabx + divides ndivides asterisk dottimes precdot + + ;; extra literal symbols + mathcatalan mathd mathD mathe matheuler + mathGamma mathlambda mathLaplace mathi mathpi + Alpha Beta Epsilon Eta Iota Kappa Mu Nu Omicron Chi Rho Tau Zeta + + ;; negations + nin nni notni nequiv nleadsto + npreccurlyeq npreceqq nprecsim + nsimeq nsubset napprox nsqsubset nsqsubseteq nsqsubseteqq + nsqsupset nsqsupseteq nsqsupseteqq + nsucccurlyeq nsucceqq nsuccsim + + ;; other extra symbols + oempty exterior Exists bigintwl bigointwl + of suchthat barsuchthat asterisk point cdummy comma copyright + bignone nobracket nospace nocomma noplus nosymbol + dotminus dotpm dotmp dotamalg dottimes dotoplus dototimes dotast + into longminus longequal + longhookrightarrow longhookleftarrow + triangleup tmprecdot preceqdot + llangle rrangle join um upl upm ump pplus + assign plusassign minusassign timesassign overassign backassign + lflux gflux colons transtype + lebar gebar leangle geangle leqangle geqangle + anglele anglege legeangle geleangle + udots subsetsim supsetsim + rightmap leftmap leftrightmap + tmxspace) + +(logic-rules + ((latex-texmacs-arity% 'x 0) (latex-texmacs-symbol% 'x)) + ((latex-symbol% 'x) (latex-texmacs-symbol% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Extra TeXmacs macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-texmacs-0% + tmunsc emdash tmhrule tmat tmbsl tmdummy + TeXmacs madebyTeXmacs withTeXmacstext citewebsite tmmade + scheme tmsep tmSep pari qed textdots hrule filldots + infixand infixor infixiff) + +(logic-group latex-texmacs-1% + citetexmacs key tmrsub tmrsup keepcase + tmtextrm tmtextsf tmtexttt tmtextmd tmtextbf + tmtextup tmtextsl tmtextit tmtextsc tmmathbf tmmathmd + tmverbatim tmop tmstrong tmem tmtt tmname tmsamp tmabbr + tmdfn tmkbd tmvar tmacronym tmperson tmscript tmdef + dueto op todo tmdate tmoutput tmerrput tmtiming + tmsubtitle tmrunningtitle tmrunningauthor + tmaffiliation tmemail tmhomepage + tmfnaffiliation tmfnemail tmfnhomepage + tmacmhomepage tmacmmisc tmieeeemail tmnote tmmisc + uhat uwidehat utilde uwidetilde + uvec ubreve uinvbreve ucheck uring uacute ugrave + underdot uddot udddot uddddot + widespacing nonconverted + groupcommoncounter + ;; NOTE: for personal use from vdh style package + gb gbt) + +(logic-group latex-texmacs-1*% + tmcodeinline) + +(logic-group latex-texmacs-2% + tmcolor + tmsummarizeddocumentation tmsummarizedgrouped tmsummarizedexplain + tmsummarizedplain tmsummarizedtiny tmsummarizedraw tmsummarizedenv + tmsummarizedstd tmsummarized + tmdetaileddocumentation tmdetailedgrouped tmdetailedexplain + tmdetailedplain tmdetailedtiny tmdetailedraw tmdetailedenv + tmdetailedstd tmdetailed + tmfoldeddocumentation tmunfoldeddocumentation + tmfoldedsubsession tmunfoldedsubsession + tmfoldedgrouped tmunfoldedgrouped tmfoldedexplain tmunfoldedexplain + tmfoldedplain tmunfoldedplain tmfoldedenv tmunfoldedenv + tmfoldedstd tmunfoldedstd tmfolded tmunfolded + tminput tminputmath tmhlink tmaction ontop subindex + renderfootnote tmlinenumber + addtocountergroup) + +(logic-group latex-texmacs-3% + tmsession tmfoldedio tmunfoldedio tmfoldediomath tmunfoldediomath + tmlinenote subsubindex tmref glossaryentry natbib-triple + renderfootnotestar) + +(logic-group latex-texmacs-4% + tmscriptinput tmscriptoutput tmconverterinput tmconverteroutput + subsubsubindex) + +(logic-rules + ((latex-texmacs% 'x) (latex-texmacs-0% 'x)) + ((latex-texmacs% 'x) (latex-texmacs-1% 'x)) + ((latex-texmacs% 'x) (latex-texmacs-1*% 'x)) + ((latex-texmacs% 'x) (latex-texmacs-2% 'x)) + ((latex-texmacs% 'x) (latex-texmacs-3% 'x)) + ((latex-texmacs% 'x) (latex-texmacs-4% 'x)) + ((latex-texmacs-arity% 'x 0) (latex-texmacs-0% 'x)) + ((latex-texmacs-arity% 'x 1) (latex-texmacs-1% 'x)) + ((latex-texmacs-arity% 'x 1) (latex-texmacs-1*% 'x)) + ((latex-texmacs-arity% 'x 2) (latex-texmacs-2% 'x)) + ((latex-texmacs-arity% 'x 3) (latex-texmacs-3% 'x)) + ((latex-texmacs-arity% 'x 4) (latex-texmacs-4% 'x)) + ((latex-texmacs-option% 'x #t) (latex-texmacs-1*% 'x)) + ((latex-command-0% 'x) (latex-texmacs-0% 'x)) + ((latex-command-1% 'x) (latex-texmacs-1% 'x)) + ((latex-command-1*% 'x) (latex-texmacs-1*% 'x)) + ((latex-command-2% 'x) (latex-texmacs-2% 'x)) + ((latex-command-3% 'x) (latex-texmacs-3% 'x)) + ((latex-command-4% 'x) (latex-texmacs-4% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Extra TeXmacs environments +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-table latex-texmacs-env-arity% + ("proof" 0) + ("proof*" 1) + ("leftaligned" 0) + ("rightaligned" 0) + ("tmcode" 0) + ("tmparmod" 3) + ("tmparsep" 1) + ("tmcompact" 0) + ("tmcompressed" 0) + ("tmamplified" 0) + ("tmjumpin" 0) + ("tmindent" 0) + ("tmlisting" 0) + ("elsequation" 0) + ("elsequation*" 0) + ("theglossary" 1)) + +(logic-table latex-texmacs-option% + ("tmcode" #t)) + +(logic-group latex-texmacs-environment-0% + begin-proof begin-leftaligned begin-rightaligned begin-quoteenv + begin-tmcompact begin-tmcompressed begin-tmamplified begin-tmjumpin + begin-tmindent begin-tmlisting begin-elsequation begin-elsequation*) + +(logic-group latex-texmacs-environment-0*% + begin-tmcode) + +(logic-group latex-texmacs-environment-1% + begin-proof* begin-tmparsep begin-theglossary) + +(logic-group latex-texmacs-environment-3% + begin-tmparmod) + +(logic-rules + ((latex-texmacs-arity% 'x 0) (latex-texmacs-environment-0% 'x)) + ((latex-texmacs-arity% 'x 0) (latex-texmacs-environment-0*% 'x)) + ((latex-texmacs-arity% 'x 1) (latex-texmacs-environment-1% 'x)) + ((latex-texmacs-arity% 'x 3) (latex-texmacs-environment-3% 'x)) + ((latex-texmacs-option% 'x #t) (latex-texmacs-environment-0*% 'x)) + ((latex-environment-0% 'x) (latex-texmacs-environment-0% 'x)) + ((latex-environment-0*% 'x) (latex-texmacs-environment-0*% 'x)) + ((latex-environment-1% 'x) (latex-texmacs-environment-1% 'x)) + ((latex-environment-3% 'x) (latex-texmacs-environment-3% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; TeXmacs list environments +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-table latex-texmacs-env-arity% + ("itemizeminus" 0) + ("itemizedot" 0) + ("itemizearrow" 0) + ("enumeratenumeric" 0) + ("enumerateroman" 0) + ("enumerateromancap" 0) + ("enumeratealpha" 0) + ("enumeratealphacap" 0) + ("descriptioncompact" 0) + ("descriptionaligned" 0) + ("descriptiondash" 0) + ("descriptionlong" 0) + ("descriptionparagraphs" 0)) + +(logic-group latex-texmacs-list% + begin-itemizeminus begin-itemizedot begin-itemizearrow + begin-enumeratenumeric begin-enumerateroman begin-enumerateromancap + begin-enumeratealpha begin-enumeratealphacap + begin-descriptioncompact begin-descriptionaligned + begin-descriptiondash begin-descriptionlong begin-descriptionparagraphs) + +(logic-rules + ((latex-texmacs-arity% 'x 0) (latex-texmacs-list% 'x)) + ((latex-list% 'x) (latex-texmacs-list% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Commands requiring special definitions in the preamble +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-texmacs-preamble-command% + newmdenv tikzframe + tmkeywords tmacm tmarxiv tmpacs tmmsc + fmtext tdatetext tmisctext tsubtitletext + thankshomepage thanksemail thanksdate thanksamisc thanksmisc thankssubtitle + mho tmfloat + + xminus xleftrightarrow xmapsto xmapsfrom xequal + xLeftarrow xRightarrow xLeftrightarrow) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Environments requiring special definitions in the preamble +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-texmacs-env-preamble-environment% + "tmpadded" "tmoverlined" "tmunderlined" "tmbothlined" + "tmframed" "tmornamented") + +(logic-group latex-texmacs-theorem-environment% + "theorem" "proposition" "lemma" "corollary" + "axiom" "definition" "notation" "conjecture" + "remark" "note" "example" "convention" + "warning" "acknowledgments" "answer" "question" + "exercise" "problem" "solution" + + "theorem*" "proposition*" "lemma*" "corollary*" + "axiom*" "definition*" "notation*" "conjecture*" + "remark*" "note*" "example*" "convention*" + "warning*" "acknowledgments*" "answer*" "question*" + "exercise*" "problem*" "solution*") + +(logic-group latex-texmacs-theorem% + begin-theorem begin-proposition begin-lemma begin-corollary + begin-axiom begin-definition begin-notation begin-conjecture + begin-remark begin-note begin-example begin-convention + begin-warning begin-acknowledgments begin-answer begin-question + begin-exercise begin-problem begin-solution + + begin-theorem* begin-proposition* begin-lemma* begin-corollary* + begin-axiom* begin-definition* begin-notation* begin-conjecture* + begin-remark* begin-note* begin-example* begin-convention* + begin-warning* begin-acknowledgments* begin-answer* begin-question* + begin-exercise* begin-problem* begin-solution*) + +(logic-rules + ((latex-texmacs-env-preamble-environment% 'x) + (latex-texmacs-theorem-environment% 'x)) + ((latex-texmacs-arity% 'x 0) (latex-texmacs-theorem% 'x)) + ((latex-environment-0% 'x) (latex-texmacs-theorem% 'x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; These macros are defined by TeXmacs in certain styles +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-texmacs-0% + appendix) + +(logic-group latex-texmacs-1% + chapter section subsection paragraph subparagraph) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Deprecated extra macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-texmacs-0% + labeleqnum eqnumber leqnumber reqnumber) + +(logic-group latex-texmacs-1% + skey ckey akey mkey hkey) diff --git a/progs/convert/latex/latex-tools.scm b/progs/convert/latex/latex-tools.scm new file mode 100644 index 0000000..3318cee --- /dev/null +++ b/progs/convert/latex/latex-tools.scm @@ -0,0 +1,631 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : latex-tools.scm +;; DESCRIPTION : Routines for expansion of macros and preamble construction +;; COPYRIGHT : (C) 2005 Joris van der Hoeven +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex latex-tools) + (:use (convert latex latex-drd) + (convert latex texout))) + +(tm-define tmtex-cjk-document? #f) +(tm-define tmtex-use-catcodes? #f) +(tm-define tmtex-use-unicode? #f) +(tm-define tmtex-use-ascii? #f) +(tm-define tmtex-use-macros? #f) + +(define latex-language "english") +(define latex-style "generic") +(define latex-packages '()) +(define latex-extra-packages '()) +(define latex-virtual-packages '()) +(define latex-all-packages '()) +(define latex-texmacs-style "generic") +(define latex-texmacs-packages '()) +(define latex-dependencies '("generic")) + +(define latex-packages-option (make-ahash-table)) +(define latex-uses-table (make-ahash-table)) +(define latex-catcode-table (make-ahash-table)) +(define latex-macro-table (make-ahash-table)) +(define latex-env-table (make-ahash-table)) +(define latex-preamble-table (make-ahash-table)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Setting and testing global parameters +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (latex-set-language lan) + (set! latex-language lan)) + +(tm-define (latex-set-style sty) + (set! latex-style sty) + (latex-set-dependencies)) + +(tm-define (latex-set-packages ps) + (set! latex-packages ps) + (latex-set-dependencies)) + +(tm-define (latex-set-extra ps) + (set! latex-extra-packages ps) + (latex-set-dependencies)) + +(tm-define (latex-add-extra p) + (when (nin? p latex-extra-packages) + (set! latex-extra-packages (cons p latex-extra-packages)) + (latex-set-dependencies))) + +(tm-define (latex-set-virtual-packages ps) + (set! latex-virtual-packages ps) + (latex-set-dependencies)) + +(tm-define (latex-set-texmacs-style sty) + (set! latex-texmacs-style sty)) + +(tm-define (latex-set-texmacs-packages l) + (set! latex-texmacs-packages l)) + +(define (latex-set-dependencies) + (set! latex-all-packages + (list-remove-duplicates (append latex-packages + latex-extra-packages + latex-virtual-packages))) + (set! latex-dependencies + (latex-packages-dependencies (cons latex-style latex-all-packages)))) + +(tm-define (latex-has-style? sty) + (== sty latex-style)) + +(tm-define (latex-has-package? p) + (in? p latex-packages)) + +(tm-define (latex-has-texmacs-style? sty) + (== sty latex-texmacs-style)) + +(tm-define (latex-has-texmacs-package? p) + (in? p latex-texmacs-packages)) + +(tm-define (latex-depends? p) + (in? p latex-dependencies)) + +(tm-define (latex-book-style?) + (in? latex-style '("book" "svmono"))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Catcode generation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (latex-catcode-defs-char c) + (let* ((s (string-convert (list->string (list c)) "Cork" "UTF-8")) + (r (string-convert s "UTF-8" "LaTeX"))) + (if (and (!= r s) (!= (string c) "\n")) + (ahash-set! latex-catcode-table (string c) r)))) + +(define (latex-catcode-defs-sub doc) + (cond ((string? doc) (for-each latex-catcode-defs-char (string->list doc))) + ((list? doc) (for-each latex-catcode-defs-sub doc)))) + +(define (latex-catcode-defs-char* c) + (if (in? c '(#\< #\>)) + (ahash-set! latex-catcode-table (string c) + (number->string (char->integer c))))) + +(define (env? t x) + (and (list>0? t) (func? (car t) '!begin) (list>1? (car t)) (== x (cadar t)))) + +(define (latex-is-math? t) + (or (func? t '!math) + (func? t '!eqn) + (env? t "equation") + (env? t "gather") + (env? t "multline") + (env? t "split") + (env? t "equation*") + (env? t "gather*") + (env? t "multline*") + (env? t "align") + (env? t "flalign") + (env? t "alignat") + (env? t "align*") + (env? t "flalign*") + (env? t "alignat*"))) + +(define (latex-is-text? t) + (func? t 'text)) + +(define (latex-is-verb? t) + ;; TODO: consider also macros which expect verbatim args + (or (func? t '!verb) (func? t '!verbatim) + (func? t '!verbatim*) (func? t 'tmverbatim))) + +(define (latex-catcode-defs-sub* doc text?) + (cond ((and text? (string? doc)) + (for-each latex-catcode-defs-char* (string->list doc))) + ((and (list? doc) (latex-is-text? doc)) + (for-each (cut latex-catcode-defs-sub* <> #t) doc)) + ((and (list? doc) (or (latex-is-math? doc) (latex-is-verb? doc))) + (for-each (cut latex-catcode-defs-sub* <> #f) doc)) + ((list? doc) + (for-each (cut latex-catcode-defs-sub* <> text?) doc)))) + +(define (latex-catcode-def key im) + (string-append "\\catcode`\\" key "=\\active \\def" key "{" im "}\n")) + +(tm-define (latex-catcode-defs doc) + (:synopsis "Return necessary catcode definitions for @doc") + (string-append + (if tmtex-use-catcodes? + (begin + (set! latex-catcode-table (make-ahash-table)) + (latex-catcode-defs-sub doc) + (let* ((l1 (ahash-table->list latex-catcode-table)) + (l2 (list-sort l1 (lambda (x y) (string<=? (car x) (car y))))) + (l3 (map (lambda (x) (latex-catcode-def (car x) (cdr x))) l2))) + (apply string-append l3))) "") + (begin + (set! latex-catcode-table (make-ahash-table)) + (latex-catcode-defs-sub* doc #t) + (let* ((l1 (ahash-table->list latex-catcode-table)) + (l2 (list-sort l1 (lambda (x y) (string<=? (car x) (car y))))) + (keys (map car l2)) + (ims (map (lambda (x) + (string-append + "\n\\fontencoding{T1}\\selectfont\\symbol{" + (cdr x) + "}\\fontencoding{\\encodingdefault}")) + l2)) + (l3 (map latex-catcode-def keys ims))) + (apply string-append l3))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Subroutines for reading the database +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (env-begin? x) + (or (func? x '!begin) (func? x '!begin*))) + +(define (latex-texmacs-arity x) + (if (env-begin? x) + (latex-texmacs-arity + (string->symbol (string-append "begin-" (tex-env-name (cadr x))))) + (logic-ref latex-texmacs-arity% x))) + +(define (latex-needs? x) + (if (env-begin? x) + (latex-needs? + (string->symbol (string-append "begin-" (tex-env-name (cadr x))))) + (logic-ref latex-needs% x))) + +(define (latex-texmacs-option? x) + (if (env-begin? x) + (latex-texmacs-option? + (string->symbol (string-append "begin-" (tex-env-name (cadr x))))) + (logic-ref latex-texmacs-option% x))) + +(define (latex-texmacs-macro-body x) + (smart-ref latex-texmacs-macro x)) + +(define (latex-texmacs-environment-body x) + (smart-ref latex-texmacs-environment (tex-env-name x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Macro and environment expansion +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (latex-substitute t args) + (cond ((number? t) (list-ref args t)) + ((== t '---) (car args)) + ((func? t '!recurse 1) + (latex-expand-macros (latex-substitute (cadr t) args))) + ((func? t '!translate 1) + (translate-from-to (cadr t) "english" latex-language)) + ((list? t) (map (cut latex-substitute <> args) t)) + (else t))) + +(tm-define (latex-expand-macros t) + (:synopsis "Expand all TeXmacs macros occurring in @t") + (if (npair? t) t + (let* ((head (car t)) + (tail (map latex-expand-macros (cdr t))) + (body (latex-texmacs-macro-body head)) + (arity (and body (latex-texmacs-arity head))) + (env (and (env-begin? head) + (latex-texmacs-environment-body (cadr head)))) + (envar (and env (latex-texmacs-arity head)))) + (cond ((and body (== (length tail) arity)) + ;;(latex-substitute body t) + (latex-substitute body (cons head tail))) + ((and env (== (length tail) 1) (== (length (cddr head)) envar)) + ;;(latex-substitute env (append (cdr t) (cddr head))) + (latex-substitute env (append tail (cddr head)))) + (else (cons head tail)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Compute macro and environment definitions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (latex-expand-def t protect?) + (cond ((and protect? (number? t)) (set! t `(!group ,t)) (set! protect? #f)) + ((and (not protect?) (func? t '!option) (set! protect? #t)))) + (cond ((== t '---) "#-#-#") + ((number? t) (string-append "#" (number->string t))) + ((func? t '!recurse 1) (latex-expand-def (cadr t) protect?)) + ((func? t '!translate 1) + (translate-from-to (cadr t) "english" latex-language)) + ((list? t) (map (cut latex-expand-def <> protect?) t)) + (else t))) + +;; TODO: to be rewritten with better factorisation +(define (latex-macro-defs-sub t) + (when (pair? t) + (if (and (or (func? t 'newcommand) (func? t 'renewcommand)) + (> (length t) 2)) + (for-each latex-macro-defs-sub (cddr t)) + (for-each latex-macro-defs-sub (cdr t))) + (let* ((body (and (not (latex-needs? (car t))) + (latex-texmacs-macro-body (car t)))) + (arity (and body (latex-texmacs-arity (car t)))) + (option (and body (latex-texmacs-option? (car t)))) + (args (if option (filter (lambda (x) + (not (and (list? x) + (== (car x) '!option)))) + (cdr t)) + (cdr t)))) + (when (and body (== (length args) arity)) + (if option (set! arity (+ 1 arity))) + (ahash-set! latex-macro-table (car t) + (list arity (latex-expand-def body #f))) + (latex-macro-defs-sub body))) + (let* ((body (and (env-begin? (car t)) + (not (latex-needs? (car t))) + (latex-texmacs-environment-body (cadar t)))) + (arity (and body (latex-texmacs-arity (car t)))) + (option (and body (latex-texmacs-option? (car t)))) + (args (and body + (if option (filter (lambda (x) + (not (and (list? x) + (== (car x) '!option)))) + (car t)) + (car t))))) + (when (and body (== (length args) (+ arity 2))) + (if option (set! arity (+ 1 arity))) + (ahash-set! latex-env-table (cadar t) + (list arity (latex-expand-def body #f))) + (latex-macro-defs-sub body))) + (with body (or (and (not (latex-needs? (car t))) + (smart-ref latex-texmacs-preamble (car t))) + (and (env-begin? (car t)) + (not (latex-needs? (car t))) + (smart-ref latex-texmacs-env-preamble (cadar t)))) + (when body + (ahash-set! latex-preamble-table + (if (env-begin? (car t)) (cadar t) (car t)) body) + (latex-macro-defs-sub body))))) + +(define (latex<=? x y) + (if (symbol? x) (set! x (symbol->string x))) + (if (symbol? y) (set! y (symbol->string y))) + (if (env-begin? x) (set! x (cadr x))) + (if (env-begin? y) (set! y (cadr y))) + (string<=? x y)) + +(tm-define (latex-macro-defs t) + (:synopsis "Return necessary macro and environment definitions for @doc") + (set! latex-macro-table (make-ahash-table)) + (set! latex-env-table (make-ahash-table)) + (set! latex-preamble-table (make-ahash-table)) + (latex-macro-defs-sub t) + (let* ((c1 (ahash-table->list latex-macro-table)) + (c2 (list-sort c1 (lambda (x y) (latex<=? (car x) (car y))))) + (c3 (map (cut cons '!newcommand <>) c2)) + (e1 (ahash-table->list latex-env-table)) + (e2 (list-sort e1 (lambda (x y) (latex<=? (car x) (car y))))) + (e3 (map (cut cons '!newenvironment <>) e2)) + (p1 (ahash-table->list latex-preamble-table)) + (p2 (list-sort p1 (lambda (x y) (latex<=? (car x) (car y))))) + (p3 (map cdr (map (cut latex-expand-def <> #f) p2)))) + (cons '!append (append c3 e3 p3)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Serialization of TeXmacs preambles +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (latex-macro-def name arity body) + (with option "" + (if (and (list>1? body) (list? (car body)) (== (caar body) '!option)) + (begin + (set! option (serialize-latex (latex-expand-def (cadar body) #f))) + (set! option (string-append "[" option "]")) + (set! body (cadr body)))) + (set! body (serialize-latex (latex-expand-def body #f))) + (set! body (string-replace body "\n\n" "*/!!/*")) + (set! body (string-replace body "\n" " ")) + (set! body (string-replace body "*/!!/*" "\n\n")) + (set! arity (if (= arity 0) "" + (string-append "[" (number->string arity) "]"))) + (string-append "\\newcommand{\\" (symbol->string name) "}" + arity option "{" body "}\n"))) + +(define (latex-env-def name arity body) + (with option "" + (if (and (list>1? body) (list? (car body)) (== (caar body) '!option)) + (begin + (set! option (serialize-latex (latex-expand-def (cadar body) #f))) + (set! option (string-append "[" option "]")) + (set! body (cadr body)))) + (set! body (serialize-latex (latex-expand-def body #f))) + (set! body (string-replace body "%\n#-#-#" "#-#-#")) + (set! body (string-replace body "%\n #-#-#" "#-#-#")) + (set! body (string-replace body "\n\n" "*/!!/*")) + (set! body (string-replace body "\n " " ")) + (set! body (string-replace body "\n" " ")) + (set! body (string-replace body " #-#-# " "}{")) + (set! body (string-replace body "#-#-# " "}{")) + (set! body (string-replace body "#-#-#" "}{")) + (set! body (string-replace body "*/!!/*" "\n\n")) + (set! arity (if (= arity 0) "" + (string-append "[" (number->string arity) "]"))) + (string-append "\\newenvironment{" (tex-env-name name) "}" + arity option "{" body "}\n"))) + +(tm-define (latex-serialize-preamble t) + (:synopsis "Serialize a LaTeX preamble @t") + (cond ((string? t) t) + ((func? t '!append) + (apply string-append (map latex-serialize-preamble (cdr t)))) + ((func? t '!newcommand 3) (apply latex-macro-def (cdr t))) + ((func? t '!newenvironment 3) (apply latex-env-def (cdr t))) + (else (serialize-latex t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Package dependencies management +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (latex-package-direct-dependencies p) + (logic-ref-list latex-depends% p)) + +(define (insert-dependencies l p) + (if (null? p) l + (if (in? (car p) l) + (insert-dependencies l (cdr p)) + (with deps (latex-package-direct-dependencies (car p)) + (insert-dependencies (append l (list (car p))) + (append deps (cdr p))))))) + +(tm-define (latex-packages-dependencies ps) + (:synopsis "Determine all dependencies of packages @ps") + (insert-dependencies (list) ps)) + +(define (non-redundant-package? p among) + (with c (latex-packages-dependencies (list-difference among (list p))) + (not (in? p c)))) + +(tm-define (latex-packages-simplify ps) + (:synopsis "Remove all implied packages in package list @ps") + (list-filter ps (lambda (p) (non-redundant-package? p ps)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Compute usepackage command for a document +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (latex-command-uses s) + (with packlist (logic-ref-list latex-needs% s) + (for-each (cut ahash-set! latex-uses-table <> #t) packlist))) + +(define (latex-use-which-package l) + (when (and (list? l) (nnull? l)) + (let ((x (car l))) + (when (symbol? x) + (with s (symbol->string x) + (cond ((string-starts? s "left\\") + (latex-command-uses (string->symbol (string-drop s 5)))) + ((string-starts? s "right\\") + (latex-command-uses (string->symbol (string-drop s 6)))) + (else (latex-command-uses x))))) + (if (and (list? x) (>= (length l) 2) (== (car x) '!begin)) + (latex-command-uses + (string->symbol (string-append "begin-" (cadr x))))) + (if (match? x '(!begin "enumerate" (!option :%1))) + (ahash-set! latex-uses-table "enumerate" #t)) + (for-each latex-use-which-package (cdr l))))) + +(define (latex-use-package-compare l r) + (let* ((tl (logic-ref latex-package-priority% l)) + (tr (logic-ref latex-package-priority% r)) + (vl (if tl tl 999999)) + (vr (if tr tr 999999))) + (< vl vr))) + +(define (filter-packages l) + (filter (lambda (x) (nin? x (tmtex-provided-packages))) l)) + +(define (filter-packages* l) + (filter (lambda (x) (nin? (cAr x) (tmtex-provided-packages))) l)) + +(define (make-use-package l) + (with po (ahash-ref latex-packages-option (cAr l)) + (let* ((optl (if (not po) (cDr l) (append (cDr l) po))) + (opt (apply string-append (list-intersperse optl ","))) + (sty (cAr l))) + (with opts (if (== opt "") "" (string-append "[" opt "]")) + (string-append "\\usepackage" opts "{" sty "}\n"))))) + +(tm-define (latex-ifacconf-style?) + (== tmtex-style "ifacconf")) + +(tm-define (latex-as-use-package l1) + (let* ((l2 (sort l1 latex-use-package-compare)) + (l3 (filter + (lambda (x) + (and (string? x) + (not (ahash-ref latex-packages-option x)))) + l2)) + (l3* (map (lambda (x) + (map force-string x)) + (filter + list>0? + (map + (lambda (x) + (if (ahash-ref latex-packages-option x) (list x) x)) + l2)))) + (l4 (filter-packages l3)) + (l4* (filter-packages* l3*)) + (l5 (list-intersperse l4 ",")) + (s (apply string-append l5)) + (s* (apply string-append (map make-use-package l4*)))) + (if (== s "") s* (string-append "\\usepackage{" s "}\n" s*)))) + +(tm-define (latex-use-package-command doc) + (:synopsis "Return the usepackage command for @doc") + (set! latex-uses-table (make-ahash-table)) + (latex-use-which-package doc) + (for (p (ahash-table->list latex-packages-option)) + (ahash-set! latex-uses-table (car p) #t)) + (let* ((l1 latex-all-packages) + (s1 (latex-as-use-package (list-difference l1 '("amsthm")))) + (l2 (map car (ahash-table->list latex-uses-table))) + (s2 (latex-as-use-package (list-difference l2 l1)))) + (string-append s1 s2))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Page size settings +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (latex-preamble-page-type init) + (let* ((l0 (ahash-table->list init)) + (l1 (map car l0)) + (l2 (map cdr l0)) + (l3 (map (cut logic-ref latex-paper-opts% <>) l1)) + (l4 (map (lambda (key val) + (cond ((not val) #f) + ((== key "page-type") + (or (logic-ref latex-paper-type% val) '())) + ((== key "page-orientation") val) + ((and (string? key) (!= val "auto")) + (string-append key "=" (tmtex-decode-length val))) + (else #f))) l3 l2)) + (l5 (filter string? l4)) + (page-opts (list-intersperse l5 ","))) + (if (nnull? page-opts) + `(!append (geometry (!concat ,@page-opts)) "\n") ""))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Color definitions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (html-color->latex-xcolor s) + "Take an hexa html color string and return an hex triplet string" + (upcase-all + (cond ((string-starts? s "#") (html-color->latex-xcolor (string-tail s 1))) + ((== 3 (string-length s)) + (let ((r (substring s 0 1)) + (g (substring s 1 2)) + (b (substring s 2 3))) + (string-append r r g g b b))) + ((== 4 (string-length s)) (html-color->latex-xcolor (string-take s 3))) + ((== 6 (string-length s)) s) + ((== 8 (string-length s)) (string-take s 6)) + (else s)))) + +(define (latex-colors-defs colors) + (apply string-append + (map (lambda (x) + (string-append + "\\definecolor{" (string-replace x " " "") "}{HTML}{" + (html-color->latex-xcolor (get-hex-color x)) "}\n")) + colors))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Building the preamble +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (latex-make-option l) + (string-append "[" (apply string-append (list-intersperse l ",")) "]")) + +(define (set-packages-option pack opts colors) + (cond ((nnull? opts) + (ahash-set! latex-packages-option pack opts)) + ((nnull? colors) + (ahash-set! latex-packages-option pack (list ""))))) + +(tm-define (latex-extra-preamble) "") + +(tm-define (latex-preamble text style lan init colors colormaps) + (:synopsis "Compute preamble for @text") + (with-global tmtex-style (if (list? style) (cAr style) style) + (set! latex-packages-option (make-ahash-table)) + (set-packages-option "xcolor" colormaps colors) + (let* ((Page (latex-preamble-page-type init)) + (Macro (latex-macro-defs text)) + (Colors (latex-colors-defs colors)) + (Text (list '!tuple Page Macro Colors text)) + (pre-page (latex-serialize-preamble Page)) + (pre-macro (latex-serialize-preamble Macro)) + (pre-colors (latex-serialize-preamble Colors)) + (pre-catcode (latex-catcode-defs Text)) + (pre-uses (latex-use-package-command Text)) + (pre-extra (latex-extra-preamble))) + (values + (cond ((and (in? "amsthm" latex-all-packages) + (== style "amsart")) "[amsthm]") + ((list? style) (latex-make-option (cDr style))) + (else "")) + (string-append pre-uses pre-extra) + (string-append pre-page) + (string-append pre-catcode pre-macro pre-colors))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Clean-up the produced LaTeX for use with MathJax +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (latex-mathjax-text l arg) + (with x (latex-mathjax-pre arg) + (cond ((or (npair? x) (nlist? x)) `(,l ,x)) + ((func? x 'tmtextsf 1) (latex-mathjax-text 'textsf (cadr x))) + ((func? x 'tmtexttt 1) (latex-mathjax-text 'texttt (cadr x))) + ((func? x 'tmtextit 1) (latex-mathjax-text 'textit (cadr x))) + ((func? x 'tmtextbf 1) (latex-mathjax-text 'textbf (cadr x))) + ((func? x 'tmtextrm 1) (latex-mathjax-text l (cadr x))) + ((func? x 'tmtextup 1) (latex-mathjax-text l (cadr x))) + (else `(,l ,x))))) + +(tm-define (latex-mathjax-pre x) + (:synopsis "Produce cleaner LaTeX for @x for use with MathJax, pass 1") + (cond ((or (npair? x) (nlist? x)) x) + ((func? x 'text 1) + (latex-mathjax-text 'text (cadr x))) + ((func? x 'dotminus 0) `(dot "-")) + ((func? x 'dotpm 0) `(dot (pm))) + ((func? x 'dotmp 0) `(dot (mp))) + ((func? x 'dotamalg 0) `(dot (amalg))) + ((func? x 'dotplus 0) `(dot "+")) + ((func? x 'dottimes 0) `(dot (times))) + ((func? x 'dotast 0) `(dot (ast))) + ((func? x 'dag) `(dagger)) + ((and (func? x 'color 2) (func? (cadr x) '!option 1)) + ;; NOTE : MathJax has broken color support, so ignore certain colors + ;; FIXME: this hack may have to be suppressed when MathJax improves + "") + (else (cons (car x) (map latex-mathjax-pre (cdr x)))))) + +(tm-define (latex-mathjax x) + (:synopsis "Produce cleaner LaTeX for @x for use with MathJax, pass 2") + (cond ((or (npair? x) (nlist? x)) x) + ((func? x 'ensuremath 1) (latex-mathjax (cadr x))) + ((func? x 'hspace* 1) `(hspace ,(latex-mathjax (cadr x)))) + ((func? x 'mathbbm 1) `(mathbb ,(latex-mathjax (cadr x)))) + ((func? x 'fill 0) "3cm") + ((func? x 'newcommand) "") + ((func? x 'custombinding) "") + ((func? x 'nobreak) "") + ((func? x 'label) "") + (else (cons (car x) (map latex-mathjax (cdr x)))))) diff --git a/progs/convert/latex/test-tmtex.scm b/progs/convert/latex/test-tmtex.scm new file mode 100644 index 0000000..7a7cae8 --- /dev/null +++ b/progs/convert/latex/test-tmtex.scm @@ -0,0 +1,288 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : test-tmtex.scm +;; DESCRIPTION : Test suite for tmtex.scm +;; COPYRIGHT : (C) 2013 François Poulain, Joris van der Hoeven, +;; (C) 2002 David Allouche +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex test-tmtex) + (:use (convert latex init-latex) + (convert latex tmtex))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Misc +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (stree->tm-snippet st) + (texmacs->generic (stree->tree st) "texmacs-snippet")) + +(define (tm-snippet->tree s) + (generic->texmacs s "texmacs-snippet")) + +(define (texmacs->latex s) + (convert s "texmacs-snippet" "latex-snippet")) + +(define (latex->texmacs s) + (convert s "latex-snippet" "texmacs-snippet")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Idempotence +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (define (regtest-tmtex-table) +;; (regtest-table-library) +;; ;; basic shorthands for latex table output +;; (define (!row l) `(!row ,@l)) +;; (define (!table ll) `(!table ,@(map !row ll))) +;; (define (tabular c ll) `((!begin "tabular" ,c) ,(!table ll))) +;; (define (!row-hline l) `((!row ,@l) (hline))) +;; (define (!table-hline ll) `(!table (hline) ,@(append-map !row-hline ll))) +;; (define (tabular-hline c ll) `((!begin "tabular" ,c) ,(!table-hline ll))) +;; ;; more shorthands +;; (define (simple-table) (table '(("a")))) +;; (define (simple-tformat) (tformat '() '(("a")))) +;; (define (expect-simple c) (tabular c '(("a")))) +;; (define (expect-hline c) (tabular-hline c '(("a")))) +;; ;(tmtex-initialize) +;; (regression-test-group +;; "tmtex, tables" "table" +;; tmtex :none +;; (test "naked table" (simple-table) (expect-simple "l")) +;; (test "naked tformat" (simple-tformat) (expect-simple "l")) +;; (test "simple tabular" `(tabular ,(simple-tformat)) (expect-simple "l")) +;; (test "simple tabular*" `(tabular* ,(simple-tformat)) (expect-simple "c")) +;; (test "simple block" `(block ,(simple-tformat)) (expect-hline "|l|")) +;; (test "simple block*" `(block* ,(simple-tformat)) (expect-hline "|c|")) +;; ;; These conversions are only meaningful in math mode! +;; ;; (test "simple matrix" `(matrix ,(simple-tformat)) +;; ;; `(!concat (#{left\(}#) ,(expect-simple "c") (#{right\)}#))) +;; ;; (test "simple det" `(det ,(simple-tformat)) +;; ;; `(!concat (left|) ,(expect-simple "c") (right|))) +;; ;; (test "simple choice" `(choice ,(simple-tformat)) +;; ;; `(!concat (left\{) ,(expect-simple "c") (right.))) +;; (test "tabular*, two cells" `(tabular* ,(tformat '() '(("a" "b")))) +;; (tabular "cc" '(("a" "b")))) +;; (test "tabular*, four cells" +;; `(tabular* ,(tformat '() '(("a" "b") ("c" "d")))) +;; (tabular "cc" '(("a" "b") ("c" "d")))) +;; (test "tabular*, first col aligned right" +;; `(tabular* ,(tformat (list (colwith "1" "cell-halign" "r")) +;; '(("a" "b") ("c" "d")))) +;; (tabular "rc" '(("a" "b") ("c" "d")))) +;; (test "tabular*, whole table aligned right" +;; `(tabular* ,(tformat (list (allwith "cell-halign" "r")) +;; '(("a" "b") ("c" "d")))) +;; (tabular "rr" '(("a" "b") ("c" "d")))) +;; (test "tabular*, one row border" +;; `(tabular* ,(tformat (list (rowwith "1" "cell-bborder" "1ln")) +;; '(("a" "b") ("c" "d")))) +;; `((!begin "tabular" "cc") (!table ,@(!row-hline '("a" "b")) +;; ,(!row '("c" "d"))))) +;; (test "tabular*, one col border" +;; `(tabular* ,(tformat (list (colwith "1" "cell-bborder" "1ln")) +;; '(("a" "b") ("c" "d")))) +;; (tabular "cc" '(("a" "b") ("c" "d")))))) + +;; TODO: getting menus entries : +;; find . -name '*menu.scm' -exec grep 'make' {} \; | sed -e 's/^\s\+//' | grep -v '^;' +(define idempotence-test-suite-0 + '( + ;; Cork table + "\x00 \x01 \x02 \x03 \x04 \x05 \x06 \x07" + "\x08 \x09 \x0a \x0b \x0c \x0d \x0e \x0f" + "\x10 \x11 \x12 \x13 \x14 \x15 \x16 \x17" + "\x18 \x19 \x1a \x1b \x1c \x1d \x1e \x1f" + "\x20 \x21 \x22 \x23 \x24 \x25 \x26 \x27" + "\x28 \x29 \x2a \x2b \x2c \x2d \x2e \x2f" + "\x30 \x31 \x32 \x33 \x34 \x35 \x36 \x37" + "\x38 \x39 \x3a \x3b \x3d \x3f" + "\x40 \x41 \x42 \x43 \x44 \x45 \x46 \x47" + "\x48 \x49 \x4a \x4b \x4c \x4d \x4e \x4f" + "\x50 \x51 \x52 \x53 \x54 \x55 \x56 \x57" + "\x58 \x59 \x5a \x5b \x5c \x5d \x5e \x5f" + "\x60 \x61 \x62 \x63 \x64 \x65 \x66 \x67" + "\x68 \x69 \x6a \x6b \x6c \x6d \x6e \x6f" + "\x70 \x71 \x72 \x73 \x74 \x75 \x76 \x77" + "\x78 \x79 \x7a \x7b \x7c \x7d \x7e Esc" + "\x80 \x81 \x82 \x83 \x84 \x85 \x86 \x87" + "\x88 \x89 \x8a \x8b \x8c \x8d \x8e \x8f" + "\x90 \x91 \x92 \x93 \x94 \x95 \x96 \x97" + "\x98 \x99 \x9a \x9b \x9c \x9d \x9e \x9f" + "\xa0 \xa1 \xa2 \xa3 \xa4 \xa5 \xa6 \xa7" + "\xa8 \xa9 \xaa \xab \xac \xad \xae \xaf" + "\xb0 \xb1 \xb2 \xb3 \xb4 \xb5 \xb6 \xb7" + "\xb8 \xb9 \xba \xbb \xbc \xbd \xbe \xbf" + "\xc0 \xc1 \xc2 \xc3 \xc4 \xc5 \xc6 \xc7" + "\xc8 \xc9 \xca \xcb \xcc \xcd \xce \xcf" + "\xd0 \xd1 \xd2 \xd3 \xd4 \xd5 \xd6 \xd7" + "\xd8 \xd9 \xda \xdb \xdc \xdd \xde \xdf" + "\xe0 \xe1 \xe2 \xe3 \xe4 \xe5 \xe6 \xe7" + "\xe8 \xe9 \xea \xeb \xec \xed \xee \xef" + "\xf0 \xf1 \xf2 \xf3 \xf4 \xf5 \xf6 \xf7" + "\xf8 \xf9 \xfa \xfb \xfc \xfd \xfe \xff" + + ;; breaking + (next-line) + (no-indent) + (line-break) + (no-break) + (no-break) + (page-break) + (no-page-break) + (new-page) + (new-dpage) + (new-page) + (new-dpage) + + ;; spaces and lengths + (hline) + (htab "0pt") + + (space "-0.17em") + (space "0.17em") + (space "0.17em") + (space "0.22em") + (space "0.5em") + (space "0.27em") + (space "1em") + (space "2em") + (vspace "0.5fn") + (vspace "1fn") + (vspace "2fn") + + ;; symbols + "..." + (math "*") + (math "|") + (math "<||>") + (math "") + (math "") + (math "") + (math "") + (math ":") + (math "") + (math "") + (math "|") + (math "<||>") + (math (math "")) + (math "") + (math "") + (math "\\") + (math "|") + (math "<||>") + (math "{") + (math "}") + + ;; Greek letters + (math "" "" "" "" "" "" "") + (math "" "" "" "" "" "" "") + (math "" "" "" "" "" "") + (math "" "" "" "" "" "" "") + (math "" "" "" "") + (math "" "" "" "" "") + (math "" "" "" "" "") + + ;; Binary>" "") + (math "" "" "" "
" "" "" "" "") + (math "" "" "" "" "" "" "") + (math "" "" "" "" "") + (math "" "" "" "" "" "") + (math "" "" "" "" "" "") + + ;; Relations>") + (math "" "" "" "" "" "" "") + (math "" "" "" "" "") + (math "" "" "" "" "") + (math "" "" "" "" "") + (math "" "" "" "" "") + (math "" "" "" "" "" "") + (math "" "" "" "" "") + (math "" "") + + ;; Arrows>") + (math "" "" "" "") + (math "" "" "" "") + (math "" "" "" "") + (math "" "" "" "") + (math "" "" "") + (math "" "" "") + (math "" "" "") + (math "" "" "") + (math "" "" "") + + ;; Delimiters + (math "" "" "" "") + (math "" "") + + ;; misc + (date "") + (with-TeXmacs-text) + (the-index "idx" "") + (table-of-contents "toc" (document "")))) + +(define idempotence-test-suite-1 + '( + ;; Content based tags + strong em dfn samp name person cite cite* abbr acronym verbatim kbd code + code* var)) + +(define (test-latex-idempotence) + (letrec ((conv (lambda (s) + (with ltx (texmacs->latex s) + (latex->texmacs ltx)))) + (test (lambda (s) + (== s (conv s)))) + (proc (lambda (st) + (let* ((s (stree->tm-snippet st)) + (test? (test s)) + (tag (if test? 'concat 'document)) + (msg (if test? "test passed: " "test failed: ")) + (color (if test? "dark green" "dark red")) + (res (if test? '() + `((math " ") + ,(tm-snippet->tree (conv s)))))) + `(concat (with "color" ,color ,msg) (,tag ,st ,@res)))))) + `(document + (strong (concat "Idempotence testing: " (TeXmacs)(math " ") + (LaTeX) (math " ") (TeXmacs))) + ,@(map proc idempotence-test-suite-0) + ,@(map (lambda (x) (proc `(,x "test"))) idempotence-test-suite-1)))) + +(define (test-latex-idempotence*) + (letrec ((conv (lambda (s) + (with ltx (texmacs->latex s) + (texmacs->latex (latex->texmacs ltx))))) + (test (lambda (s) (== (texmacs->latex s) (conv s)))) + (proc (lambda (st) + (let* ((s (stree->tm-snippet st)) + (test? (test s)) + (tag (if test? 'concat 'document)) + (msg (if test? "test passed: " "test failed: ")) + (color (if test? "dark green" "dark red")) + (res (if test? '() + `((math " ") + ,(tm-snippet->tree (conv s)))))) + `(concat (with "color" ,color ,msg) (,tag ,st ,@res)))))) + `(document + (strong (concat "Idempotence testing: " (LaTeX) (math " ") + (TeXmacs) (math " ") (LaTeX))) + ,@(map proc idempotence-test-suite-0) + ,@(map (lambda (x) (proc `(,x "test"))) idempotence-test-suite-1)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Interface +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (test-tmtex) + (stree->tree + `(document + ,(test-latex-idempotence) + "" + ,(test-latex-idempotence*)))) diff --git a/progs/convert/latex/texout.scm b/progs/convert/latex/texout.scm new file mode 100644 index 0000000..6c1c47f --- /dev/null +++ b/progs/convert/latex/texout.scm @@ -0,0 +1,497 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : texout.scm +;; DESCRIPTION : generation of TeX/LaTeX from scheme expressions +;; COPYRIGHT : (C) 2002 Joris van der Hoeven +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex texout) + (:use (convert latex latex-tools) + (convert tools output))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Make environment names acceptable +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tex-env-name s) + (if (string? s) (string-replace s "-" "") s)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Interface for unicode output +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (uses-cyrillic? t) + (and tmtex-use-ascii? + (cond ((func? t '!widechar 1) + (with s (string-convert (symbol->string (cadr t)) "UTF-8" "LaTeX") + (or (string-starts? s "{\\cyr") + (string-starts? s "{\\CYR")))) + ((pair? t) (list-or (map uses-cyrillic? (cdr t)))) + (else #f)))) + +(define (uses-xlatin? t) + (and tmtex-use-ascii? + (cond ((string? t) + (with s (string-convert t "UTF-8" "LaTeX") + (and (!= s t) + (string-occurs? "{\\k " s) + (or (string-occurs? "{\\k a}" s) + (string-occurs? "{\\k e}" s) + (string-occurs? "{\\k A}" s) + (string-occurs? "{\\k E}" s))))) + ((pair? t) (list-or (map uses-xlatin? (cdr t)))) + (else #f)))) + +(define (output-tex s) + (output-text (if tmtex-use-ascii? (string-convert s "UTF-8" "LaTeX") s))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Outputting preamble and postamble +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (collection->ahash-table init) + (let* ((t (make-ahash-table)) + (l (if (func? init 'collection) (cdr init) '())) + (f (lambda (x) (ahash-set! t (cadr x) (caddr x))))) + (for-each f l) + t)) + +(define (drop-blank s) + (string-replace s " " "")) + +(define (latex-stree-contains? t u) + (cond ((== t u) #t) + ((and (string? t) (string? u)) (string-contains? t (drop-blank u))) + ((nlist? t) #f) + ((null? t) #f) + (else (or (latex-stree-contains? (car t) u) + (in? #t (map (lambda (x) + (latex-stree-contains? x u)) (cdr t))))))) +(define (attached_macro? t) + (and (func? t '!concat 4) + (== (cadr t) '(!preamble "%%%%%%%%%% Start TeXmacs macros\n")))) + +(define (detach-macros t) + (cond ((attached_macro? t) (fifth t)) + ((list>0? t) (map-in-order detach-macros t)) + (else t))) + +(define (texout-file l) + (let* ((doc-body (car l)) + (has-preamble? (latex-stree-contains? doc-body "\\begin{document}")) + (has-end? (latex-stree-contains? doc-body "\\end{document}")) + (styles (if (null? (cadr l)) (list "article") (cadr l))) + (style (car styles)) + (style* (if (nlist? style) style (cAr style))) + (needs (caddr l)) + (prelan (car needs)) + (colors (cadr needs)) + (colormaps (caddr needs)) + (lan (if (== prelan "") "english" prelan)) + (init (collection->ahash-table (cadddr l))) + (doc-preamble (car (cddddr l))) + (doc-misc (append '(!concat) doc-preamble (list doc-body))) + (doc-src (cdr (cddddr l))) + (post-begin "") + (pre-end "")) + + (if (not has-preamble?) + (begin + (set! doc-body (detach-macros doc-body)) + (receive + (tm-style-options tm-uses tm-init tm-preamble) + (latex-preamble doc-misc style lan init colors colormaps) + (output-verbatim "\\documentclass") + (output-verbatim tm-style-options) + (output-verbatim "{" style* "}\n") + (with main-lang (cAr lan) + (cond ((== main-lang "korean") + (output-verbatim "\\usepackage{hangul}\n")) + ((in? main-lang '("chinese" "chineset" "japanese")) + (with opt (cond ((== main-lang "japanese") "{min}") + ((== main-lang "chineset") "{bsmi}") + ((== main-lang "chinese") "{gbsn}")) + (set! post-begin + (string-append "\\begin{CJK*}{UTF8}" opt "\n")) + (set! pre-end "\n\\end{CJK*}") + (output-verbatim "\\usepackage{CJK}\n"))) + (else + (cond ((or (uses-cyrillic? doc-preamble) + (uses-cyrillic? doc-body)) + (output-verbatim "\\usepackage[T2A,T1]{fontenc}\n")) + ((or (uses-xlatin? doc-preamble) + (uses-xlatin? doc-body)) + (output-verbatim "\\usepackage[T1]{fontenc}\n"))) + (with langs + (apply string-append (list-intersperse lan ", ")) + (output-verbatim "\\usepackage[" langs "]{babel}\n")) + (if tmtex-use-unicode? + (output-verbatim "\\usepackage[utf8]{inputenc}\n"))))) + (when (and (string? style*) + (or (string-starts? style* "acm") + (string-starts? style* "sig")) + (string? tm-uses) + (string-occurs? "amssymb" tm-uses)) + (output-verbatim "\\let\\Bbbk\\relax\n")) + (output-verbatim tm-uses) + (if (string-occurs? "makeidx" (latex-use-package-command doc-body)) + (output-verbatim "\\makeindex\n")) + (output-verbatim tm-init) + + (if (!= tm-preamble "") + (begin + (output-lf) + (output-verbatim "%%%%%%%%%% Start TeXmacs macros\n") + (output-verbatim tm-preamble) + (output-verbatim "%%%%%%%%%% End TeXmacs macros\n"))) + (if (nnull? doc-preamble) + (begin + (output-lf) + (map-in-order (lambda (x) (texout x) (output-lf)) doc-preamble)))) + + (output-lf) + (output-tex "\\begin{document}") + (output-lf) + (output-tex post-begin) + (output-lf))) + (texout doc-body) + (if (not has-end?) + (begin + (output-lf) + (output-tex pre-end) + (output-lf) + (output-tex "\\end{document}") + (output-lf))) + (if (nnull? doc-src) (texout (car doc-src))))) + +(define (texout-usepackage x) + (output-verbatim "\\usepackage{" x "}\n")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Outputting main flow +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (texout-comment l) + (set-output-comment #t) + (output-tex "% ") + (texout l) + (set-output-comment #f) + (output-lf)) + +(tm-define (texout-preamble l) + (output-verbatim l)) + +(define (empty-line? x) + (or (== x "") + (func? x '!marker) + (and (func? x '!concat) + (list-and (map empty-line? (cdr x)))))) + +(tm-define (texout-document l) + (if (nnull? l) + (begin + (texout (car l)) + (if (empty-line? (car l)) + (output-tex "\\ ")) + (if (nnull? (cdr l)) + (begin + (output-lf) + (output-lf))) + (texout-document (cdr l))))) + +(define (texout-paragraph l) + (if (nnull? l) + (begin + (texout (car l)) + (if (nnull? (cdr l)) (output-lf)) + (texout-paragraph (cdr l))))) + +(define (texout-table l) + (if (nnull? l) + (begin + (if (func? (car l) '!row) + (begin + (texout-row* (cdar l)) + (if (nnull? (cdr l)) + (begin + (output-tex "\\\\") + (output-lf)))) + (begin + (texout (car l)) + (if (nnull? (cdr l)) (output-lf)))) + (texout-table (cdr l))))) + +(define (texout-row l) + (if (nnull? l) + (begin + (texout (car l)) + (if (nnull? (cdr l)) (output-tex " & ")) + (texout-row (cdr l))))) + +(define (texout-row* l) + ;; Dirty hack to avoid [ strings at start of a row + ;; because of confusion with optional argument of \\ + (if (and (pair? l) (string? (car l)) (string-starts? (car l) "[")) + (set! l `((!concat (!group "") ,(car l)) ,@(cdr l)))) + (if (and (pair? l) (func? (car l) '!concat) + (string? (cadar l)) (string-starts? (cadar l) "[")) + (set! l `((!concat (!group "") ,@(cdar l)) ,@(cdr l)))) + (texout-row l)) + +(define (texout-want-space x1 x2) ;; spacing rules + (and (not (or (and (string? x1) (!= x1 "") + (in? (string-take-right x1 1) '("(" "["))) + (in? x1 '(({) (nobreak))) + (and (string? x2) (!= x2 "") + (in? (string-take x2 1) '("," ")" "]"))) + (in? x2 '((}) (nobreak))) + (== x1 " ") (== x2 " ") + (func? x2 '!nextline) + (== x2 "'") (func? x2 '!sub) (func? x2 '!sup) + (func? x1 '&) (func? x2 '&) + (func? x1 '!nbsp) (func? x2 '!nbsp) + (func? x1 '!nbhyph) (func? x2 '!nbhyph) + (and (== x1 "'") (nlist? x2)))) + (or (in? x1 '("," ";" ":")) + (func? x1 'tmop) (func? x2 'tmop) + (func? x1 '!symbol) (func? x2 '!symbol) + (and (list-1? x1) (symbol? (car x1)) + (string-alpha? (symbol->string (car x1))) + (string? x2) (> (string-length x2) 0)) + (and (nlist? x1) (nlist? x2))))) + +(define (texout-concat-sub prev l) + (when (nnull? l) + (if (func? (car l) '!marker) + (begin + (texout (car l)) + (texout-concat-sub prev (cdr l))) + (begin + (if (and prev (texout-want-space prev (car l))) (texout " ")) + (texout (car l)) + (texout-concat-sub (car l) (cdr l)))))) + +(define (texout-concat l) + (texout-concat-sub #f l)) + +(tm-define (texout-multiline? x) + (cond ((npair? x) #f) + ((in? (car x) '(!begin !nextline !newline !linefeed !eqn !table)) #t) + ((and (in? (car x) '(!document !paragraph)) (> (length (cdr x)) 1)) #t) + ((npair? (cdr x)) #f) + (else (or (texout-multiline? (cadr x)) + (texout-multiline? `(!concat ,@(cddr x))))))) + +(define (texout-indent x) + (if (texout-multiline? x) + (begin + (output-indent 2) + (output-lf) + (texout x) + (output-indent -2) + (output-lf)) + (texout x))) + +(define (texout-unindent x) + (with old-indent (get-output-indent) + (set-output-indent 0) + (texout x) + (set-output-indent old-indent))) + +(define (texout-linefeed) + (output-lf)) + +(define (texout-newline) + (output-lf) + (output-lf)) + +(define (texout-nextline) + (output-tex "\\\\") + (output-lf)) + +(define (texout-nbsp) + (output-tex "~")) + +(define (texout-nbhyph) + (output-tex "\\mbox{-}")) + +(define (texout-verb x) + (cond ((not (string-index x #\|)) (output-verb "\\verb|" x "|")) + ((not (string-index x #\$)) (output-verb "\\verb$" x "$")) + ((not (string-index x #\@)) (output-verb "\\verb@" x "@")) + ((not (string-index x #\!)) (output-verb "\\verb!" x "!")) + ((not (string-index x #\9)) (output-verb "\\verb9" x "9")) + ((not (string-index x #\X)) (output-verb "\\verbX" x "X")) + (else (output-verb "\\verbď" x "ď")))) + +(define (texout-verbatim x) + (output-lf-verbatim "\\begin{alltt}\n" x "\n\\end{alltt}")) + +(define (texout-verbatim* x) + (output-lf-verbatim x)) + +(define (texout-invariant x) + (output-invariant x)) + +(define (texout-group x) + (output-tex "{") + (texout x) + (output-tex "}")) + +(define (texout-marker tag arg) + (with s (string-append "{\\" (symbol->string tag) "{" arg "}}") + (output-marker s))) + +(define (texout-empty? x) + (cond ((== x "") #t) + ((func? x '!concat) (list-and (map-in-order texout-empty? (cdr x)))) + ((func? x '!document 1) (texout-empty? (cadr x))) + (else #f))) + +(define (texout-double-math? x) + (or (and (match? x '((:or !document !concat) :%1)) + (texout-double-math? (cadr x))) + (and (match? x '((!begin :%1) :%1)) + (in? (cadar x) '("eqnarray" "eqnarray*" "leqnarray*"))))) + +(define (texout-math x) + (cond ((texout-empty? x) (noop)) + ((texout-double-math? x) (texout x)) + ((match? x '((!begin "center") :%1)) + (texout `((!begin "equation") ,(cadr x)))) + ((and (output-test-end? "$") (not (output-test-end? "\\$"))) + (output-remove 1) + (output-tex " ") + (texout x) + (output-tex "$")) + (else + (output-tex "$") + (texout x) + (output-tex "$")))) + +(define (texout-eqn x) + (output-tex "\\[ ") + (output-indent 3) + (texout x) + (output-indent -3) + (output-tex " \\]")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Outputting macro applications and environments +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (texout-arg x) + (output-tex (string-append "#" x))) + +(define (texout-args l) + (if (nnull? l) + (begin + (if (and (list? (car l)) (== (caar l) '!option)) + (begin + (output-tex "[") + (texout (cadar l)) + (output-tex "]")) + (begin + (output-tex "{") + (texout (car l)) + (output-tex "}"))) + (texout-args (cdr l))))) + +(define (texout-apply what args) + (output-tex + (if (string? what) what (string-append "\\" (symbol->string what)))) + (texout-args args)) + +(define (texout-protect? env) + (in? env (list "tmparmod" "tmparsep"))) + +(define (texout-begin* what args inside) + (set! what (tex-env-name what)) + (output-tex (string-append "\\begin{" what "}")) + (texout-args args) + (if (texout-protect? what) (output-tex "%")) + (output-lf) + (texout inside) + (output-lf) + (output-tex (string-append "\\end{" what "}"))) + +(define (texout-begin what args inside) + (set! what (tex-env-name what)) + (output-tex (string-append "\\begin{" what "}")) + (texout-args args) + (if (texout-protect? what) (output-tex "%")) + (output-indent 2) + (output-lf) + (texout inside) + (output-indent -2) + (output-lf) + (output-tex (string-append "\\end{" what "}"))) + +(define (texout-script where l) + (let ((x (car l))) + (cond ((and (== x '(prime)) (== where "^")) + (output-tex "'")) + ((and (func? x '!concat) (== where "^") + (pair? (cdr x)) (== (cadr x) '(prime)) + (list-and (map (cut == <> '(prime)) (cdr x)))) + (output-tex (apply string-append (map (lambda a "'") (cdr x))))) + ((and (string? x) (= (string-length x) 1) (nin? x (list "<" ">"))) + (output-tex where) + (output-tex x)) + (else + (output-tex where) + (texout-args l))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Main output routines +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (texout x) + (cond ((string? x) (output-tex x)) + ((nlist>0? x) (display* "TeXmacs] badly formatted stree:\n" x "\n")) + ((== (car x) '!widechar) (output-tex (symbol->string (cadr x)))) + ((== (car x) '!file) (texout-file (cdr x))) + ((== (car x) '!preamble) (texout-preamble (cadr x))) + ((== (car x) '!comment) (texout-comment (cadr x))) + ((== (car x) '!document) (texout-document (cdr x))) + ((== (car x) '!paragraph) (texout-paragraph (cdr x))) + ((== (car x) '!table) (texout-table (cdr x))) + ((== (car x) '!concat) (texout-concat (cdr x))) + ((== (car x) '!append) (for-each texout (cdr x))) + ((== (car x) '!symbol) (texout (cadr x))) + ((== (car x) '!linefeed) (texout-linefeed)) + ((== (car x) '!indent) (texout-indent (cadr x))) + ((== (car x) '!unindent) (texout-unindent (cadr x))) + ((== (car x) '!newline) (texout-newline)) + ((== (car x) '!nextline) (texout-nextline)) + ((== (car x) '!nbsp) (texout-nbsp)) + ((== (car x) '!nbhyph) (texout-nbhyph)) + ((== (car x) '!verb) (texout-verb (cadr x))) + ((== (car x) '!verbatim) (texout-verbatim (cadr x))) + ((== (car x) '!verbatim*) (texout-verbatim* (cadr x))) + ((== (car x) '!invariant) (texout-invariant (cadr x))) + ((== (car x) '!arg) (texout-arg (cadr x))) + ((== (car x) '!group) (texout-group (cons '!append (cdr x)))) + ((== (car x) '!marker) (texout-marker (cadr x) (caddr x))) + ((== (car x) '!math) (texout-math (cadr x))) + ((== (car x) '!eqn) (texout-eqn (cadr x))) + ((== (car x) '!sub) (texout-script "_" (cdr x))) + ((== (car x) '!sup) (texout-script "^" (cdr x))) + ((== (car x) '!annotate) (texout (cadr x))) + ((== (car x) '!ignore) (noop)) + ((and (list? (car x)) (== (caar x) '!begin)) + (texout-begin (cadar x) (cddar x) (cadr x))) + ((and (list? (car x)) (== (caar x) '!begin*)) + (texout-begin* (cadar x) (cddar x) (cadr x))) + (else (texout-apply (car x) (cdr x))))) + +(tm-define (serialize-latex x) + (texout x) + (output-produce)) + diff --git a/progs/convert/latex/textest.scm b/progs/convert/latex/textest.scm new file mode 100644 index 0000000..ebaa068 --- /dev/null +++ b/progs/convert/latex/textest.scm @@ -0,0 +1,222 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : textest.scm +;; DESCRIPTION : test LaTeX conversion routines +;; COPYRIGHT : (C) 2002 Joris van der Hoeven +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex textest) + (:use + (convert tools tmpre) (convert tools output) + (convert latex tmtex) (convert latex texout))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; TeX output +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define tex-expression + '(!document + "Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat." + (!paragraph + "Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat." + ((!begin "equation") + ((!begin "array" "ccc") + (!table + (!row "a" "b" "c") + (!row "x" "y" "z") + (!row "a" "b" "c")))) + "Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat.") + ((!begin "itemize") + (!document + (!concat + (item) + " Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat.") + (!concat + (item) + " Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat. Hallo allemaal laten we eens even kijken hoe het hiermee staat."))) + (!concat + "The formula " + (!math + (!concat + (frac "1" "2") + " + " + (frac "1" "3") + " + " + (frac (sqrt "3") "4") + " + " + (frac "1" "5") + " + " + (frac "1" "6") + " + " + (frac "1" "7"))) + " is funny no? " + "The formula " + (!math + (!concat + (frac "1" (!concat "x" (!sub "2"))) + " + " + (frac "1" "3") + " + " + (frac "1" "4") + " + " + (frac "1" "5") + " + " + (frac "1" "6") + " + " + (frac "1" "7"))) + " is funny no? " + "The formula " + (!math + (!concat + (frac "1" "2") + " + " + (frac "1" "3") + " + " + (frac "1" "4") + " + " + (frac "1" "5") + " + " + (frac "1" "6") + " + " + (frac "1" "7"))) + " is funny no? " + "The formula " + (!math + (!concat + (frac "1" "2") + " + " + (frac "1" "3") + " + " + (frac "1" "4") + " + " + (frac "1" "5") + " + " + (frac "1" "6") + " + " + (frac "1" "7"))) + " is funny no? "))) + +(define (test-tex-document) + (list '!file + tex-expression + (list "article" "vdh") + "french" + "~")) + +(define (out) + (let ((s (serialize-latex (test-tex-document)))) + ;;(display s) + ;;(display "\n") + s)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; TeX conversion +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define text-document + '(document + (make-title + (concat + (title "Een testje") + (author "Joris van der Hoeven"))) + (assign + "test" + (macro "x" "y" + (with "font-size" "1.4" "font-series" "bold" + (concat (arg "y") " and " (arg "x"))))) + (theorem + (document + "Hopsakee" + (equation* + (concat "" (rsup "2") + "+" (rsup "2") + "=" (rsup "2"))) + "Bla bla bla" + (eqnarray* + (table + (row "a" "=" "b") + (row "c" "=" "d"))) + "Bla bla bla" + (equation + (concat + "=" + (choice + (tformat + (cwith "1" "-1" "1" "2" "cell-halign" "l") + (cwith "1" "-1" "3" "4" "cell-halign" "r") + (table + (row "a" "b" "c" "d") + (row "e" "f" "g" "h")))))) + "Bla bla bla")) + (concat + "Hopsakee, eens even kijken hoe {#~$dit$~#} er uit ziet. Hopsakee, eens even kijken hoe dit er uit ziet. Hopsakee, eens even kijken hoe dit er uit ziet. " + (with "font-series" "bold" "Hopsakee") + " " + (cite "Joris" "Piet") + (vspace "1.5fn")) + (example + (document + (label "Hallo") + (enumerate-numeric + (document + (concat (item) "Eerste punt. " (verbatim "Holala") " en hopsa") + (verbatim + (document + "Hopsakee" + " hola hop" + " geintje")) + "En weer verder" + (concat (item* "hop") "Tweede punt.") + (concat (item) "Derde punt."))))) + (with "mode" "math" + (concat + (big "sum") + (with "mode" "text" "Hallo") + "+" + (wide "a+b" "^") + "+" + (wide "" "~") + "+" + (wide (wide "x" "^") "^") + "+12*x+cos x+" + (left "[") + (frac "1" "2") + "+k" + (rsub (sqrt "3")) + (right "]") + "++" + (sqrt "5" "n") + (neg "") + "a+b" + (rsub + (tabular + (table + (row "a" "b") + (row "c" "d")))) + "+c" + (rprime ""))) + "Hopsakee" + (input "1]" "x := a & b & c") + (surround + (with "color" "red" "Theorem 1. ") + (Box) + "Hopsakee, eens even kijken hoe dit er uit ziet. Hopsakee, eens even kijken hoe dit er uit ziet. Hopsakee, eens even kijken hoe dit er uit ziet.") + (float "float" "tbh" (document (big-figure "Test" "Een plaatje."))) + "Voor meer informatie, schrijf aan vdhoeven@texmacs.org")) + +(define (pre) + (tmtex-initialize) + (tmpre-produce text-document)) + +(define (tex) + (tmtex-initialize) + (tmtex (tmpre-produce text-document))) + +(tm-define (test) + (serialize-latex (texmacs->latex text-document '()))) diff --git a/progs/convert/latex/tmtex-acm.scm b/progs/convert/latex/tmtex-acm.scm new file mode 100644 index 0000000..761f96e --- /dev/null +++ b/progs/convert/latex/tmtex-acm.scm @@ -0,0 +1,369 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : tmtex-acm.scm +;; DESCRIPTION : special conversions for acm styles +;; COPYRIGHT : (C) 2012 Joris van der Hoeven, Francois Poulain +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex tmtex-acm) + (:use (convert latex tmtex) + (convert latex latex-define))) + +(tm-define (tmtex-transform-style x) + (:mode acm-style?) + (cond ((== x "acmconf") "acm_proc_article-sp") + ((== x "sig-alternate") x) + ((== x "acmsmall") `("format=acmsmall" "acmart")) + ((== x "acmlarge") `("format=acmlarge" "acmart")) + ((== x "acmtog") `("format=acmtog" "acmart")) + ((== x "sigconf") `("format=sigconf" "acmart")) + ((== x "sigchi") `("format=sigchi" "acmart")) + ((== x "sigplan") `("format=sigplan" "acmart")) + (else x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; New ACM metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-make-acm-art-title titles miscs tr) + (let* ((titles (tmtex-concat-Sep (map cadr titles))) + (content `(,@titles ,@miscs))) + (if (null? content) '() + `((title (!indent (!paragraph ,@content))))))) + +(define (rewrite-author a) + (cond ((not (func? a 'author 1)) (list a)) + ((not (func? (cadr a) '!paragraph)) (list a)) + (else (cons `(author ,(cadr (cadr a))) (cddr (cadr a)))))) + +(tm-define (tmtex-append-authors l) + (:mode acm-art-style?) + (set! l (filter nnull? l)) + (with r (append-map rewrite-author l) + `((!document ,@r)))) + +(tm-define (tmtex-make-doc-data titles subtitles authors dates miscs notes + subtits-l dates-l miscs-l notes-l tr ar) + (:mode acm-art-style?) + `(!document + ,@(tmtex-make-acm-art-title titles miscs tr) + ,@subtitles + ,@notes + ,@(tmtex-append-authors authors) + ,@dates + (maketitle))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; New ACM specific titlemarkup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-doc-subtitle t) + (:mode acm-art-style?) + `(subtitle ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-note t) + (:mode acm-art-style?) + (set! t (tmtex-remove-line-feeds t)) + `(titlenote ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-misc t) + (:mode acm-art-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmacmmisc ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-date t) + (:mode acm-art-style?) + `(date ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-name t) + (:mode acm-art-style?) + `(author ,(tmtex-inline (cadr t)))) + +(define (get-affiliation-lines aff) + (if (func? aff 'concat) + (list-filter (cdr aff) (lambda (x) (!= x '(next-line)))) + (list aff))) + +(tm-define (tmtex-author-affiliation t) + (:mode acm-art-style?) + (let* ((l (if (null? (cdr t)) '() (get-affiliation-lines (cadr t)))) + (r (list))) + (when (nnull? l) + (set! r (rcons r `(institution ,(tmtex (car l))))) + (set! l (cdr l))) + (when (nnull? l) + (set! r (rcons r `(streetaddress ,(tmtex (car l))))) + (set! l (cdr l))) + (when (nnull? l) + (set! r (rcons r `(city ,(tmtex (car l))))) + (set! l (cdr l))) + (when (nnull? l) + (set! r (rcons r `(country ,(tmtex (car l))))) + (set! l (cdr l))) + `(affiliation (!paragraph ,@r)))) + +(tm-define (tmtex-author-email t) + (:mode acm-art-style?) + (set! t (tmtex-remove-line-feeds t)) + `(email ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-homepage t) + (:mode acm-art-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmacmhomepage ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-note t) + (:mode acm-art-style?) + (set! t (tmtex-remove-line-feeds t)) + `(authornote ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-misc t) + (:mode acm-art-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmacmmisc ,(tmtex (cadr t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Old ACM metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-append-authors l) + (:mode acm-conf-style?) + (set! l (filter nnull? l)) + (if (null? l) l + (let* ((n (number->string (length l))) + (sep '(!concat (!linefeed) (alignauthor) (!linefeed)))) + (set! l (list-intersperse (map cadr l) sep)) + `((!document (numberofauthors ,n) + (author (!indent (!concat (alignauthor) " " ,@l)))))))) + +(tm-define (tmtex-make-author names affiliations emails urls miscs notes + affs-l emails-l urls-l miscs-l notes-l) + (:mode acm-conf-style?) + (let* ((names (tmtex-concat-Sep (map cadr names))) + (result `(,@names ,@urls ,@notes ,@miscs ,@affiliations ,@emails))) + (if (null? result) '() + `(author (!concat ,@result))))) + +(define (tmtex-make-acm-conf-title titles notes miscs) + (let* ((titles (tmtex-concat-Sep (map cadr titles))) + (result `(,@titles ,@notes ,@miscs))) + (if (null? result) '() + `((title (!concat ,@result)))))) + +(tm-define (tmtex-make-doc-data titles subtitles authors dates miscs notes + subtits-l dates-l miscs-l notes-l tr ar) + (:mode acm-conf-style?) + `(!document + ,@(tmtex-make-acm-conf-title titles notes miscs) + ,@subtitles + ,@(tmtex-append-authors authors) + ,@dates + (maketitle))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Old ACM specific titlemarkup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (acm-line-break t) + `(!concat (!nextline) ,t)) + +(tm-define (tmtex-doc-subtitle t) + (:mode acm-conf-style?) + `(subtitle ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-note t) + (:mode acm-conf-style?) + (set! t (tmtex-remove-line-feeds t)) + `(titlenote ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-misc t) + (:mode acm-conf-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmacmmisc ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-date t) + (:mode acm-conf-style?) + `(date ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-affiliation t) + (:mode acm-conf-style?) + (with aff-lines + (if (list>0? (cadr t)) + (map (lambda (x) + (if (== x '(next-line)) + '(!nextline) + `(affaddr ,(tmtex x)))) + (cdadr t)) + (if (null? (cdr t)) '() `((affaddr ,(tmtex (cadr t)))))) + (acm-line-break `(!concat ,@aff-lines)))) + +(tm-define (tmtex-author-email t) + (:mode acm-conf-style?) + (set! t (tmtex-remove-line-feeds t)) + (acm-line-break `(email ,(tmtex (cadr t))))) + +(tm-define (tmtex-author-homepage t) + (:mode acm-conf-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmacmhomepage ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-note t) + (:mode acm-conf-style?) + (set! t (tmtex-remove-line-feeds t)) + `(titlenote ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-misc t) + (:mode acm-conf-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmacmmisc ,(tmtex (cadr t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ACM specific abstract markup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract) + (:mode acm-style?) + (with result `(,@abstract ,@acm ,@arxiv ,@msc ,@pacs ,@keywords) + (if (null? result) "" `(!document ,@result)))) + +(tm-define (tmtex-abstract-keywords t) + (:mode acm-style?) + (with args (tmtex-concat-sep (map tmtex (cdr t))) + `(keywords ,@(map tmtex args)))) + +(tm-define (tmtex-abstract-acm t) + (:mode acm-style?) + (with l (cond ((== (length (cdr t)) 0) '("" "" "")) + ((== (length (cdr t)) 1) (append (cdr t) '("" ""))) + ((== (length (cdr t)) 2) (append (cdr t) '(""))) + ((== (length (cdr t)) 3) (cdr t)) + (else (append (sublist (cdr t) 0 3) + `((!option ,(fourth (cdr t)))) + (sublist (cdr t) 4 (length (cdr t)))))) + `(category ,@(map tmtex l)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ACM specific misc markup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-acm-conferenceinfo s l) + (:mode acm-style?) + `(conferenceinfo ,@(map tmtex l))) + +(tm-define (tmtex-acm-copyright-year s l) + (:mode acm-style?) + `(CopyrightYear ,@(map tmtex l))) + +(tm-define (tmtex-acm-crdata s l) + (:mode acm-style?) + `(crdata ,@(map tmtex l))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Put 'maketitle' after abstract +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define removed-maketitle? #f) +(define added-maketitle? #f) + +(define (remove-maketitle t) + (cond ((nlist? t) t) + ((and (func? t '!document) (== (cAr t) '(maketitle))) + (set! removed-maketitle? #t) + (cDr t)) + (else (map remove-maketitle t)))) + +(define (add-maketitle-sub l) + (cond ((null? l) l) + ((and (pair? (car l)) (== (caar l) '(!begin "abstract"))) + (set! added-maketitle? #t) + (cons (car l) (cons '(maketitle) (cdr l)))) + (else (cons (add-maketitle (car l)) + (add-maketitle-sub (cdr l)))))) + +(define (add-maketitle t) + (cond ((nlist? t) t) + ((func? t '!document) + (cons (car t) (add-maketitle-sub (cdr t)))) + (else (map add-maketitle t)))) + +(tm-define (tmtex-postprocess x) + (:mode acm-style?) + (set! removed-maketitle? #f) + (set! added-maketitle? #f) + (let* ((y (remove-maketitle x)) + (z (add-maketitle y))) + (if (and removed-maketitle? added-maketitle?) z x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ACM specific macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group latex-texmacs-3% + (:mode acm-style?) + category) + +(smart-table latex-texmacs-macro + (:mode acm-style?) + (qed #f) + (nequiv #f) + (category "")) + +(smart-table latex-texmacs-environment + (:mode acm-style?) + ("proof" #f)) + +;;(tm-define (tmtex-cite-detail s l) +;; (:mode acm-style?) +;; (tmtex-cite-detail-poor s l)) + +(smart-table latex-texmacs-env-preamble + (:mode acm-art-style?) + ("theorem" #f) + ("conjecture" #f) + ("proposition" #f) + ("lemma" #f) + ("corollary" #f) + ("definition" #f) + ("example" #f)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Missing theorem types +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-macro (acm-theorem prim name) + `(latex-texmacs-thmenv ,prim ,name () () + acm-art-style?)) + +(define-macro (acm-remark prim name) + `(latex-texmacs-thmenv ,prim ,name + ("\\theoremstyle{acmdefinition}\n") + ("\n\\theoremstyle{acmplain}") + acm-art-style?)) + +(define-macro (acm-exercise prim name) + `(latex-texmacs-thmenv ,prim ,name + ("\\theoremstyle{acmdefinition}\n") + ("\n\\theoremstyle{acmplain}") + acm-art-style?)) + +(acm-theorem "axiom" "Axiom") +(acm-theorem "notation" "Notation") +(acm-remark "remark" "Remark") +(acm-remark "note" "Note") +(acm-remark "convention" "Convention") +(acm-remark "warning" "Warning") +(acm-remark "acknowledgments" "Acknowledgments") +(acm-remark "answer" "Answer") +(acm-remark "question" "Question") +(acm-remark "remark" "Remark") +(acm-remark "problem" "Problem") +(acm-remark "solution" "Solution") +(acm-exercise "exercise" "Exercise") +(acm-exercise "problem" "Problem") +(acm-exercise "solution" "Solution") diff --git a/progs/convert/latex/tmtex-ams.scm b/progs/convert/latex/tmtex-ams.scm new file mode 100644 index 0000000..d715a5a --- /dev/null +++ b/progs/convert/latex/tmtex-ams.scm @@ -0,0 +1,177 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : tmtex-ams.scm +;; DESCRIPTION : special conversions for AMS styles +;; COPYRIGHT : (C) 2012 Joris van der Hoeven, François Poulain +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex tmtex-ams) + (:use (convert latex tmtex) + (convert latex latex-define))) + +(tm-define (tmtex-transform-style x) + (:mode ams-style?) x) + +(tm-define (tmtex-provided-packages) + (:mode ams-style?) + '("amsmath")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; AMS data preprocessing +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (stree-contains? t u) + (cond ((== t u) #t) + ((nlist? t) #f) + ((null? t) #f) + (else (or (stree-contains? (car t) u) + (in? #t (map (lambda (x) (stree-contains? x u)) (cdr t))))))) + +(define (insert-maketitle-after t u) + (cond ((nlist? t) t) + ((== (car t) u) `(!document ,t (maketitle))) + (else `(,(car t) ,@(map (lambda (x) (insert-maketitle-after x u)) + (cdr t)))))) + +(tm-define (tmtex-style-preprocess doc) + (:mode ams-style?) + (cond ((stree-contains? doc 'abstract-data) + (insert-maketitle-after doc 'abstract-data)) + ((stree-contains? doc 'doc-data) + (insert-maketitle-after doc 'doc-data)) + (else doc))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; AMS metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-make-author names affiliations emails urls miscs notes + affs-l emails-l urls-l miscs-l notes-l) + (:mode ams-style?) + (let* ((names (map (lambda (x) `(author ,x)) + (list-intersperse (map cadr names) '(tmSep)))) + (result `(,@names ,@affiliations ,@emails ,@urls ,@notes ,@miscs))) + (if (null? result) '() `(!paragraph ,@result)))) + +(tm-define (tmtex-make-doc-data titles subtitles authors dates miscs notes + subtits-l dates-l miscs-l notes-l tr ar) + (:mode ams-style?) + (let* ((title-opt (if (null? tr) '() `((!option ,@(tmtex-concat-Sep tr))))) + (titles (tmtex-concat-Sep (map cadr titles))) + (titles (if (null? titles) '() `((title ,@title-opt ,@titles)))) + (title-data `(,@titles ,@subtitles ,@notes ,@miscs)) + (title-data (if (null? title-data) '() `((!paragraph ,@title-data)))) + (authors* (filter pair? authors))) + (if (and (null? title-data) (null? authors*) (null? dates)) '() + `(!document ,@title-data ,@authors* ,@dates)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; AMS specific titlemarkup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-doc-running-title t) + (:mode ams-style?) + (tmtex (cadr t))) + +(tm-define (tmtex-doc-subtitle t) + (:mode ams-style?) + `(tmsubtitle ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-note t) + (:mode ams-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmnote ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-misc t) + (:mode ams-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmmisc ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-date t) + (:mode ams-style?) + `(date ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-affiliation t) + (:mode ams-style?) + `(address ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-email t) + (:mode ams-style?) + (set! t (tmtex-remove-line-feeds t)) + `(email ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-homepage t) + (:mode ams-style?) + (set! t (tmtex-remove-line-feeds t)) + `(urladdr ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-note t) + (:mode ams-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmnote ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-misc t) + (:mode ams-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmmisc ,(tmtex (cadr t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; AMS specific abstract markup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (move-in-abstract what in) + (if (null? in) + (if (null? what) '() `(((!begin "abstract") (document ,@what)))) + `(((!begin "abstract") (!document ,@(map cadr in) ,@what))))) + +(tm-define (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract) + (:mode ams-style?) + (with class `(,@acm ,@arxiv ,@pacs) + (set! abstract (move-in-abstract class abstract))) + (with result `(,@abstract ,@msc ,@keywords) + (if (null? result) "" `(!document ,@result)))) + +(tm-define (tmtex-abstract-keywords t) + (:mode ams-style?) + (with args (tmtex-concat-sep (map tmtex (cdr t))) + `(keywords ,@args))) + +(tm-define (tmtex-abstract-msc t) + (:mode ams-style?) + (with args (tmtex-concat-Sep (map tmtex (cdr t))) + `(subjclass ,@args))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; AMS specific macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(smart-table latex-texmacs-macro + (:mode ams-style?) + (qed #f)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; AMS theorems +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-macro (ams-latex-texmacs-remark prim name) + `(latex-texmacs-thmenv ,prim ,name + ("{" (!recurse (theoremstyle "remark"))) ("}") + ams-style?)) + +(ams-latex-texmacs-remark "remark" "Remark") +(ams-latex-texmacs-remark "note" "Note") +(ams-latex-texmacs-remark "example" "Example") +(ams-latex-texmacs-remark "convention" "Convention") +(ams-latex-texmacs-remark "warning" "Warning") +(ams-latex-texmacs-remark "acknowledgments" "Acknowledgments") +(ams-latex-texmacs-remark "answer" "Answer") +(ams-latex-texmacs-remark "question" "Question") +(ams-latex-texmacs-remark "exercise" "Exercise") +(ams-latex-texmacs-remark "problem" "Problem") +(ams-latex-texmacs-remark "solution" "Solution") diff --git a/progs/convert/latex/tmtex-beamer.scm b/progs/convert/latex/tmtex-beamer.scm new file mode 100644 index 0000000..74ed19e --- /dev/null +++ b/progs/convert/latex/tmtex-beamer.scm @@ -0,0 +1,250 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : tmtex-beamer.scm +;; DESCRIPTION : special conversions for Beamer style +;; COPYRIGHT : (C) 2012 Joris van der Hoeven, François Poulain +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex tmtex-beamer) + (:use (convert latex tmtex))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Beamer style options +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-transform-style x) + (:mode beamer-style?) + "beamer") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Beamer document preprocessing +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (stree-transform l what by) + (cond ((or (null? l) (nlist? l)) l) + ((== (car l) what) `(,by ,@(cdr l))) + (else + (map (lambda (x) (stree-transform x what by)) l)))) + +(define (beamer-make-slides doc) + (set! doc (stree-transform doc 'hidden 'slide)) + (stree-transform doc 'shown 'slide)) + +(tm-define (tmtex-style-preprocess doc) + (:mode beamer-style?) + (beamer-make-slides doc)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Beamer metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-make-author names affiliations emails urls miscs notes + affs-l emails-l urls-l miscs-l notes-l) + (:mode beamer-style?) + (let* ((names (tmtex-concat-Sep (map cadr names))) + (result `(,@names ,@urls ,@notes ,@miscs))) + (if (null? result) '() `(author (!paragraph ,@result))))) + +(define (beamer-append in l) + (set! l (filter nnull? l)) + (if (< (length l) 1) l + (with lf `(!concat (!linefeed) (and) (!linefeed)) + `((,in + (!indent (!concat ,@(list-intersperse (map cadr l) lf)))))))) + +(define (svjour-make-title titles notes miscs) + (let* ((titles (tmtex-concat-Sep (map cadr titles))) + (result `(,@titles ,@notes ,@miscs))) + (if (null? result) '() + `((title (!concat ,@result)))))) + +(define (svjour-make-doc-data titles subtits authors affs dates miscs notes tr ar) + `(!document + ,@(svjour-make-title titles notes miscs) + ,@subtits + ,@tr + ,@ar + ,@(beamer-append 'author authors) + ,@(beamer-append 'institute affs) + ,@dates + (maketitle))) + +(tm-define (tmtex-doc-data s l) + (:mode beamer-style?) + (set! l (map tmtex-replace-documents l)) + (let* ((subtitles (map tmtex-doc-subtitle + (tmtex-select-args-by-func 'doc-subtitle l))) + (notes (map tmtex-doc-note + (tmtex-select-args-by-func 'doc-note l))) + (miscs (map tmtex-doc-misc + (tmtex-select-args-by-func 'doc-misc l))) + (dates (map tmtex-doc-date + (tmtex-select-args-by-func 'doc-date l))) + (authors (map tmtex-doc-author + (tmtex-select-args-by-func 'doc-author l))) + (ar (map tmtex-doc-running-author + (tmtex-select-args-by-func 'doc-running-author l))) + (titles (map tmtex-doc-title + (tmtex-select-args-by-func 'doc-title l))) + (tr (map tmtex-doc-running-title + (tmtex-select-args-by-func 'doc-running-title l))) + (affs (map tmtex-affiliation-group + (cluster-by-affiliations + (tmtex-select-args-by-func 'doc-author l))))) + (svjour-make-doc-data titles subtitles authors affs dates miscs notes tr ar))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Beamer affiliation clustering +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (beamer-clear-aff aff a filter?) + (with datas (cdadr a) + (if (and filter? + (== `(,aff) + (filter (lambda (x) (== 'author-affiliation (car x))) datas))) + '() + `(doc-author (author-data ,@(filter (lambda (x) (!= aff x)) datas)))))) + +(define (next-affiliation l) + (cond ((or (null? l) (nlist? l)) #f) + ((in? (car l) '(doc-author author-data)) (next-affiliation (cdr l))) + ((== (car l) 'author-affiliation) l) + ((list? (car l)) + (with na (next-affiliation (car l)) + (if na na (next-affiliation (cdr l))))) + (else #f))) + +(define (cluster-by-affiliations l) + (if (nlist? l) l + (let* ((aff (next-affiliation l)) + (hasaff (filter (lambda (x) + (or (not aff) + (and (list? x) (list? (cdr x)) + (list? (cadr x)) + (in? aff (cdadr x))))) l)) + (hasaff* (map (lambda (x) (beamer-clear-aff aff x #f)) hasaff)) + (l* (map (lambda (x) (beamer-clear-aff aff x #t)) l)) + (l* (filter nnull? l*)) + (aff* `(affiliation-group + ,(if aff (cadr aff) '()) ,@hasaff*))) + (if aff (append `(,aff*) (cluster-by-affiliations l*)) `(,aff*))))) + +(tm-define (tmtex-affiliation-group t) + (with old-tmtex-make-author (eval tmtex-make-author) + (set! tmtex-make-author + (lambda (names affiliations emails urls miscs notes + affs-l emails-l urls-l miscs-l notes-l) + (with names (tmtex-concat-Sep (map cadr names)) + (cond ((and (null? names) (null? emails)) '()) + ((or (null? names) (null? emails)) + `(!concat ,@names)) ;hack + (else `(!concat ,@names)))))) ;hack + (let* ((affs (cadr t)) + (affs (if (null? affs) '() + `((!concat (!linefeed)(at)(!linefeed) ,(tmtex affs))))) + (auth-sep '(!concat " " (and) " ")) + (authors (map tmtex-doc-author (cddr t))) + (authors (list-intersperse authors auth-sep))) + (set! tmtex-make-author (eval old-tmtex-make-author)) + (if (and (null? authors) (null? affs)) '() + `(institute (!concat ,@authors ,@affs)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Beamer specific titlemarkup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-doc-running-title t) + (:mode beamer-style?) + `(titlerunning ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-subtitle t) + (:mode beamer-style?) + `(subtitle ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-note t) + (:mode beamer-style?) + `(tmnote ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-misc t) + (:mode beamer-style?) + `(tmmisc ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-date t) + (:mode beamer-style?) + `(date ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-running-author t) + (:mode beamer-style?) + `(authorrunning ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-affiliation t) + (:mode beamer-style?) + `(institute ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-email t) + (:mode beamer-style?) + `(email ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-homepage t) + (:mode beamer-style?) + `(tmfnhomepage ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-note t) + (:mode beamer-style?) + `(tmnote ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-misc t) + (:mode beamer-style?) + `(tmmisc ,(tmtex (cadr t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Beamer specific abstract markup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract) + (:mode beamer-style?) + (:require (not llncs?)) + (with result `(,@abstract ,@arxiv ,@acm ,@msc ,@pacs ,@keywords) + (if (null? result) "" `(!document ,@result)))) + +(tm-define (tmtex-abstract-keywords t) + (:mode beamer-style?) + (:require (not llncs?)) + (with args (list-intersperse (map tmtex (cdr t)) '(!group (and))) + `(keywords (!concat ,@args)))) + +(tm-define (tmtex-abstract-msc t) + (:mode beamer-style?) + (:require (not llncs?)) + (with args (list-intersperse (map tmtex (cdr t)) '(!group (and))) + `(subclass (!concat ,@args)))) + +(tm-define (tmtex-abstract-acm t) + (:mode beamer-style?) + (:require (not llncs?)) + (with args (list-intersperse (map tmtex (cdr t)) '(!group (and))) + `(CRclass (!concat ,@args)))) + +(tm-define (tmtex-abstract-pacs t) + (:mode beamer-style?) + (:require (not llncs?)) + (with args (list-intersperse (map tmtex (cdr t)) '(!group (and))) + `(PACS (!concat ,@args)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Beamer specific frame markup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-beamer-slide s l) + (:mode beamer-style?) + `((!begin "frame") ,(tmtex (car l)))) + +(tm-define (tmtex-beamer-tit s l) + (:mode beamer-style?) + `(frametitle ,(tmtex (car l)))) diff --git a/progs/convert/latex/tmtex-elsevier.scm b/progs/convert/latex/tmtex-elsevier.scm new file mode 100644 index 0000000..07704e4 --- /dev/null +++ b/progs/convert/latex/tmtex-elsevier.scm @@ -0,0 +1,449 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : tmtex-elsevier.scm +;; DESCRIPTION : special conversions for elsevier styles +;; COPYRIGHT : (C) 2006 Joris van der Hoeven +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex tmtex-elsevier) + (:use (convert latex tmtex))) + +(tm-define (tmtex-transform-style x) + (:mode elsevier-style?) + (cond ((== x "elsart") "elsart") + ((== x "elsarticle") "elsarticle") + ((== x "ifac") "ifacconf") + ((== x "jsc") `("amsthm" "elsart")) + (else x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Initialization of elsevier style +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define note-counter 0) +(define author-counter 0) +(define clustered? #f) + +(define (init-elsevier body) + (set! clustered? #f) + (set! note-counter 0) + (set! author-counter 0)) + +(tm-define (tmtex-style-init body) + (:mode elsevier-style?) + (init-elsevier body)) + +(tm-define (tmtex-style-init body) + (:mode ifac-style?) + (init-elsevier body) + (set! tmtex-packages (cons "cite-author-year" tmtex-packages)) + (latex-set-packages '("natbib")) + ) + +(tm-define (tmtex-style-init body) + (:mode jsc-style?) + (init-elsevier body) + ;;(set! tmtex-packages (cons "cite-author-year" tmtex-packages)) + (latex-set-packages '("amsthm" "yjsco" ;;"natbib" + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Hack for ifac incompatibility with hyperref package +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (latex-as-use-package l) + (:require (latex-ifacconf-style?)) + (if (nin? "hyperref" l) + (former l) + (let* ((l* (list-remove l "hyperref")) + (s1 (if (null? l*) "" (former l*))) + (s2 (string-append + "\\makeatletter\n" + "\\let\\old@ssect\\@ssect\n" + "\\makeatother\n" + "\\usepackage{hyperref}\n" + "\\makeatletter\n" + "\\def\\@ssect#1#2#3#4#5#6{%\n" + " \\NR@gettitle{#6}%\n" + " \\old@ssect{#1}{#2}{#3}{#4}{#5}{#6}%\n" + "}\n" + "\\makeatother\n"))) + (string-append s1 s2)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Hack for incomplete ifac list environments +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (latex-extra-preamble) + (:require (latex-ifacconf-style?)) + (string-append "\\newcommand{\\labelitemiii}{\\labelitemi}\n" + "\\newcommand{\\labelitemiv}{\\labelitemii}\n")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Preprocessing data +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-style-preprocess doc) + (:mode elsevier-style?) + (elsevier-create-frontmatter doc)) + +(define (elsarticle-frontmatter? t) + (or (func? t 'abstract-data) (func? t 'doc-data) (func? t 'abstract))) + +(define (partition l pred?) + (if (npair? l) l + (letrec ((npred? (lambda (x) (not (pred? x))))) + (if (pred? (car l)) + (receive (h t) (list-break l npred?) + (cons h (partition t pred?))) + (receive (h t) (list-break l pred?) + (cons h (partition t pred?))))))) + +(define (elsevier-create-frontmatter t) + (if (or (npair? t) (npair? (cdr t))) t + (with l (map elsarticle-frontmatter? (cdr t)) + (if (in? #t l) + (with parts (partition (cdr t) elsarticle-frontmatter?) + `(,(car t) ,@(map (lambda (x) + (if (elsarticle-frontmatter? (car x)) + `(elsevier-frontmatter (,(car t) ,@x)) + `(,(car t) ,@x))) parts))) + `(,(car t) ,@(map elsevier-create-frontmatter (cdr t))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Elsevier specific customizations +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-elsevier-frontmatter s l) + (:mode elsevier-style?) + `((!begin "frontmatter") ,(tmtex (car l)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Elsarticle specific title macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-replace-documents t) + (:mode elsevier-style?) t) + +(tm-define (springer-note-ref l r) + (if (list? r) + (set! r (tex-concat* (list-intersperse r ","))) + (set! r (string-append l r))) + `(tnoteref ,r)) + +(tm-define (tmtex-doc-subtitle-ref s l) + (:mode elsevier-style?) + (springer-note-ref "sub-" (car l))) + +(tm-define (tmtex-doc-subtitle-label s l) + (:mode elsevier-style?) + (with label (string-append "sub-" (car l)) + `(tsubtitletext (!option ,label) ,(tmtex (cadr l))))) + +(tm-define (tmtex-doc-note-ref s l) + (:mode elsevier-style?) + (springer-note-ref "note-" (car l))) + +(tm-define (tmtex-doc-note-label s l) + (:mode elsevier-style?) + (with label (string-append "note-" (car l)) + `(tnotetext (!option ,label) ,(tmtex (cadr l))))) + +(tm-define (tmtex-doc-date-ref s l) + (:mode elsevier-style?) + (springer-note-ref "date-" (car l))) + +(tm-define (tmtex-doc-date-label s l) + (:mode elsevier-style?) + (with label (string-append "date-" (car l)) + `(tdatetext (!option ,label) ,(tmtex (cadr l))))) + +(tm-define (tmtex-doc-misc-ref s l) + (:mode elsevier-style?) + (springer-note-ref "misc-" (car l))) + +(tm-define (tmtex-doc-misc-label s l) + (:mode elsevier-style?) + (with label (string-append "misc-" (car l)) + `(tmisctext (!option ,label) ,(tmtex (cadr l))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Elsevier specific authors macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (springer-author-note-ref l r) + (if (list? r) + (set! r (tex-concat* (list-intersperse r ","))) + (set! r (string-append l r))) + `(fnref ,r)) + +(tm-define (tmtex-author-note-ref s l) + (:mode elsevier-style?) + (springer-author-note-ref "author-note-" (car l))) + +(tm-define (tmtex-author-note-label s l) + (:mode elsevier-style?) + (with label (string-append "author-note-" (car l)) + `(fntext (!option ,label) ,(tmtex (cadr l))))) + +(tm-define (tmtex-author-misc-ref s l) + (:mode elsevier-style?) + (springer-author-note-ref "author-misc-" (car l))) + +(tm-define (tmtex-author-misc-label s l) + (:mode elsevier-style?) + (with label (string-append "author-misc-" (car l)) + `(fmtext (!option ,label) ,(tmtex (cadr l))))) + +(tm-define (tmtex-author-affiliation t) + (:mode elsevier-style?) + `(address ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-affiliation-ref s l) + (:mode elsevier-style?) + (springer-author-note-ref "affiliation-" (car l))) + +(tm-define (tmtex-author-affiliation-label s l) + (:mode elsevier-style?) + (with label (string-append "affiliation-" (car l)) + `(address (!option ,label) ,(tmtex (cadr l))))) + +(tm-define (tmtex-author-email t) + (:mode elsevier-style?) + `(ead ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-email-ref s l) + (:mode elsevier-style?) + (springer-note-ref "author-email-" (car l))) + +(tm-define (tmtex-author-email-label s l) + (:mode elsevier-style?) + `(ead ,(tmtex (cadr l)))) + +(tm-define (tmtex-author-homepage t) + (:mode elsevier-style?) + `(ead (!option "url") ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-homepage-ref s l) + (:mode elsevier-style?) + (springer-note-ref "author-url-" (car l))) + +(tm-define (tmtex-author-homepage-label s l) + (:mode elsevier-style?) + `(ead (!option "url") ,(tmtex (cadr l)))) + +(tm-define (tmtex-author-name t) + (:mode elsevier-style?) + `(author ,(tmtex (cadr t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Elsart and IFAC specific title macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-replace-documents t) + (:mode elsevier-style?) + (:require (or (elsart-style?) (jsc-style?) (ifac-style?))) + (if (npair? t) t + (with (r s) (list (car t) (map tmtex-replace-documents (cdr t))) + (if (!= r 'document) `(,r ,@s) + `(concat ,@(list-intersperse s '(next-line))))))) + +(tm-define (springer-note-ref l r) + (:mode elsevier-style?) + (:require (or (elsart-style?) (jsc-style?) (ifac-style?))) + (if (list? r) + `(!concat ,@(map (lambda (x) `(thanksref ,x)) r)) + `(thanksref ,(string-append l r)))) + +(tm-define (tmtex-doc-subtitle-label s l) + (:mode elsevier-style?) + (:require (or (elsart-style?) (jsc-style?) (ifac-style?))) + (with label (string-append "sub-" (car l)) + `(thankssubtitle (!option ,label) ,(tmtex (cadr l))))) + +(tm-define (tmtex-doc-note-label s l) + (:mode elsevier-style?) + (:require (or (elsart-style?) (jsc-style?) (ifac-style?))) + (with label (string-append "note-" (car l)) + `(thanks (!option ,label) ,(tmtex (cadr l))))) + +(tm-define (tmtex-doc-date-label s l) + (:mode elsevier-style?) + (:require (or (elsart-style?) (jsc-style?) (ifac-style?))) + (with label (string-append "date-" (car l)) + `(thanksdate (!option ,label) ,(tmtex (cadr l))))) + +(tm-define (tmtex-doc-misc-label s l) + (:mode elsevier-style?) + (:require (or (elsart-style?) (jsc-style?) (ifac-style?))) + (with label (string-append "misc-" (car l)) + `(thanksmisc (!option ,label) ,(tmtex (cadr l))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Elsart specific authors macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (springer-author-note-ref l r) + (:mode elsevier-style?) + (:require (or (elsart-style?) (jsc-style?) (ifac-style?))) + (springer-note-ref l r)) + +(tm-define (tmtex-author-note-label s l) + (:mode elsevier-style?) + (:require (or (elsart-style?) (jsc-style?) (ifac-style?))) + (with label (string-append "author-note-" (car l)) + `(thanks (!option ,label) ,(tmtex (cadr l))))) + +(tm-define (tmtex-author-misc-label s l) + (:mode elsevier-style?) + (:require (or (elsart-style?) (jsc-style?) (ifac-style?))) + (with label (string-append "author-misc-" (car l)) + `(thanksamisc (!option ,label) ,(tmtex (cadr l))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; IFAC specific authors macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-author-email-label s l) + (:mode ifac-style?) + (with label (string-append "author-email-" (car l)) + `(thanksemail (!option ,label) ,(tmtex (cadr l))))) + +(tm-define (tmtex-author-homepage-label s l) + (:mode ifac-style?) + (with label (string-append "author-url-" (car l)) + `(thankshomepage (!option ,label) ,(tmtex (cadr l))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Elsevier title and author preprocessing +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-prepare-doc-data l) + (:mode elsevier-style?) + (set! clustered? + (or + (contains-stree? l '(doc-title-options "cluster-by-affiliation")) + (contains-stree? l '(doc-title-options "cluster-all")))) + (set! l (map tmtex-replace-documents l)) + (set! l (make-references l 'doc-subtitle #f #f)) + (set! l (make-references l 'doc-note #f #f)) + (set! l (make-references l 'doc-misc #f #f)) + (set! l (make-references l 'doc-date #f #f)) + (set! l (make-references l 'author-note #t #f)) + (set! l (make-references l 'author-misc #t #f)) + (if (ifac-style?) + (begin + (set! l (make-references l 'author-email #t #f)) + (set! l (make-references l 'author-homepage #t #f)))) + (if clustered? + (set! l (make-references l 'author-affiliation #t #f))) + l) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Elsevier title and author presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-make-doc-data titles subtitles authors dates miscs notes + subtitles-l dates-l miscs-l notes-l tr ar) + (:mode elsevier-style?) + (let* ((authors (filter nnull? authors)) + (authors (if (null? authors) '() + `((!paragraph ,@authors)))) + (titles (tmtex-concat-Sep (map cadr titles))) + (notes `(,@subtitles ,@dates ,@miscs ,@notes)) + (notes (if (null? notes) '() + `(,(springer-note-ref "" (map cadr notes))))) + (result `(,@titles ,@notes)) + (result (if (null? result) '() `((title (!concat ,@result))))) + (result `(,@result ,@subtitles-l ,@notes-l + ,@miscs-l ,@dates-l ,@authors))) + (if (null? result) "" `(!document ,@result)))) + +(tm-define (tmtex-make-author names affs emails urls miscs notes + affs* emails* urls* miscs* notes*) + (:mode elsevier-style?) + (let* ((names (tmtex-concat-Sep (map cadr names))) + (notes* (if (ifac-style?) + `(,@emails* ,@urls* ,@miscs* ,@notes*) + `(,@miscs* ,@notes*))) + (notes* (if (null? notes*) '() + `(,(springer-author-note-ref "" (map cadr notes*))))) + (affs* (if (null? affs*) '() + `((!option + (!concat ,@(list-intersperse (map cadr affs*) ",")))))) + (result `(,@names ,@notes*)) + (result (if (null? result) '() + `((author ,@affs* (!concat ,@result))))) + (result `(,@result ,@affs ,@emails ,@urls ,@miscs ,@notes))) + (if (null? result) '() `(!paragraph ,@result)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Elsevier abstract macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-abstract-keywords t) + (:mode elsevier-style?) + (with args (list-intersperse (map tmtex (cdr t)) '(!concat (sep) " ")) + `((!begin "keyword") (!concat ,@args)))) + +(tm-define (tmtex-abstract-msc t) + (:mode elsevier-style?) + (with args (list-intersperse (map tmtex (cdr t)) '(!concat (sep) " ")) + `(!concat (MSC) " " (!concat ,@args)))) + +(tm-define (tmtex-abstract-pacs t) + (:mode elsevier-style?) + (with args (list-intersperse (map tmtex (cdr t)) '(!concat (sep) " ")) + `(!concat (PACS) " " (!concat ,@args)))) + +(tm-define (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract) + (:mode elsevier-style?) + (if (or (nnull? msc) (nnull? pacs) (nnull? acm) (nnull? arxiv)) + (set! keywords + `(((!begin "keyword") (!document ,@(map cadr keywords) + ,@pacs ,@msc ,@acm ,@arxiv))))) + `(!document ,@abstract ,@keywords)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The Elsevier style is quite ugly. +;; Transform equations into eqnarray* for more uniform alignment. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-equation s l) + (:mode elsevier-style?) + (tmtex-env-set "mode" "math") + (let ((r (tmtex (car l)))) + (tmtex-env-reset "mode") + (if (== s "equation") + (list (list '!begin "eqnarray") r) ;; FIXME: why do elsequation + (list (list '!begin "eqnarray*") r) ;; and elsequation* not work? + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The elsarticle class does not insert a 'References' section title +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;(tm-define (tmtex-bib t) +;; (:mode elsevier-style?) +;; (:require (elsarticle-style?)) +;; (tmtex-biblio (car t) (cdr t) #t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Elsevier specific macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(smart-table latex-texmacs-macro + (:mode elsevier-style?) + (:require (elsarticle-style?)) + (comma #f)) + +(smart-table latex-texmacs-preamble + (:mode elsevier-style?) + (:require (elsarticle-style?)) + (qed (!append (renewcommand "\\qed" "") "\n"))) diff --git a/progs/convert/latex/tmtex-ieee.scm b/progs/convert/latex/tmtex-ieee.scm new file mode 100644 index 0000000..a129a41 --- /dev/null +++ b/progs/convert/latex/tmtex-ieee.scm @@ -0,0 +1,215 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : tmtex-ieee.scm +;; DESCRIPTION : special conversions for ieee styles +;; COPYRIGHT : (C) 2013 Joris van der Hoeven, François Poulain +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex tmtex-ieee) + (:use (convert latex tmtex))) + +(define conference? #f) +(define clustered? #f) + +(tm-define (tmtex-style-init doc) + (:mode ieee-tran-style?) + ;; ieeetran require to be in conference mode to print affiliations and emails + (set! conference? (contains-tags? doc '(author-email author-affiliation))) + (set! clustered? + (and + conference? + (or + (contains-stree? doc '(doc-title-options "cluster-all")) + (contains-stree? doc '(doc-title-options "cluster-by-affiliation")))))) + +(tm-define (tmtex-transform-style x) + (:mode ieee-style?) + (cond ((== x "ieeeconf") "IEEEconf") + ((and (or clustered? conference?) (== x "ieeetran")) + '("conference" "IEEEtran")) + ((== x "ieeetran") "IEEEtran") + (else x))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; IEEEconf metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-append-authors l) + (:mode ieee-conf-style?) + (set! l (filter nnull? l)) + (if (null? l) l + (with sep '(!concat (!linefeed) (and) (!linefeed)) + `((author (!indent (!concat ,@(list-intersperse (map cadr l) sep)))))))) + +(tm-define (tmtex-make-author names affiliations emails urls miscs notes + affs-l emails-l urls-l miscs-l notes-l) + (:mode ieee-conf-style?) + (let* ((names (tmtex-concat-Sep (map cadr names))) + (result `(,@names ,@urls ,@notes ,@miscs)) + (result (if (null? result) '() `((!concat ,@result)))) + (result `(,@result ,@affiliations ,@emails))) + (if (null? result) '() `(author (!paragraph ,@result))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; IEEEconf specific titlemarkup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-author-affiliation t) + (:mode ieee-conf-style?) + `((!begin "affiliation") ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-email t) + (:mode ieee-conf-style?) + (set! t (tmtex-remove-line-feeds t)) + `(email ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-homepage t) + (:mode ieee-conf-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmfnhomepage ,(tmtex-inline (cadr t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; IEEEtran metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-append-authors l) + (:mode ieee-tran-style?) + (set! l (filter nnull? l)) + (if (null? l) l + (with sep '(!concat (!linefeed) "and~") + `((author (!indent (!concat ,@(list-intersperse (map cadr l) sep)))))))) + +(tm-define (tmtex-append-authors l) + (:mode ieee-tran-style?) + (:require conference?) + (set! l (filter nnull? l)) + (if (null? l) l + (with sep '(!concat (!linefeed) (and) (!linefeed)) + `((author (!indent (!concat ,@(list-intersperse (map cadr l) sep)))))))) + +(tm-define (tmtex-make-author names affs emails urls miscs notes + affs* emails* urls* miscs* notes*) + (:mode ieee-tran-style?) + (:require conference?) + (let* ((names (tmtex-concat-Sep (map cadr names))) + (affs (if clustered? affs (map cadr affs))) + (authorblockN `(,@names ,@affs* ,@emails* ,@urls ,@notes ,@miscs)) + (authorblockN (if (null? authorblockN) '() + `((IEEEauthorblockN (!concat ,@authorblockN))))) + (authorblockA `(,@affs ,@emails)) + (authorblockA (if clustered? + (map (lambda (x) + `(IEEEauthorblockA ,x)) authorblockA) + (list-intersperse authorblockA '(!nextline)))) + (authorblockA (if (and (not clustered?) (nnull? authorblockA)) + `((IEEEauthorblockA (!concat ,@authorblockA))) + authorblockA))) + (if (and (null? authorblockN) (null? authorblockA)) '() + (if clustered? + `(,@authorblockN ,@authorblockA) + `(author (!paragraph ,@authorblockN ,@authorblockA)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; IEEEtran clustered metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-prepare-doc-data l) + (:mode ieee-tran-style?) + (:require clustered?) + (set! l (map tmtex-replace-documents l)) + (set! l (make-references l 'author-affiliation #t #t)) + (set! l (make-references l 'author-email #t #t)) + l) + +(tm-define (tmtex-append-authors l) + (:mode ieee-tran-style?) + (:require clustered?) + (set! l (filter nnull? l)) + (if (null? l) () + (let* ((sep '(!concat (!linefeed))) + (names (map (lambda (au) + (filter (lambda (x) + (== (car x) 'IEEEauthorblockN)) au)) l)) + (names (map car (filter nnull? names))) + (names (tmtex-concat-sep (map cadr names))) + (l* (map (lambda (au) + (filter (lambda (x) + (!= (car x) 'IEEEauthorblockN)) au)) l)) + (l* (filter nnull? l*)) + (l* (apply append l*)) + (names (if (null? names) '() `((IEEEauthorblockN ,@names)))) + (r `(,@names ,@l*))) + `((author (!indent (!concat ,@(list-intersperse r sep)))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; IEEEtran specific titlemarkup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-author-affiliation-ref s l) + (:mode ieee-tran-style?) + `(IEEEauthorrefmark ,(car l))) + +(tm-define (tmtex-author-affiliation-label s l) + (:mode ieee-tran-style?) + `(!concat (IEEEauthorrefmark ,(car l)) + ,(tmtex (cadr l)))) + +(tm-define (tmtex-author-email-ref s l) + (:mode ieee-tran-style?) + `(IEEEauthorrefmark ,(car l))) + +(tm-define (tmtex-author-email-label s l) + (:mode ieee-tran-style?) + `(!concat (IEEEauthorrefmark ,(car l)) + ,(tmtex-author-email l))) + +(tm-define (tmtex-author-affiliation t) + (:mode ieee-tran-style?) + (:require conference?) + `(IEEEauthorblockA ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-email t) + (:mode ieee-tran-style?) + (:require conference?) + (set! t (tmtex-remove-line-feeds t)) + `(tmieeeemail ,(tmtex (cadr t)))) + +(tm-define (tmtex-abstract-keywords t) + (:mode ieee-tran-style?) + (with args (list-intersperse (map tmtex (cdr t)) '(!concat (tmsep) " ")) + `((!begin "IEEEkeywords") (!concat ,@args)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Further tweaking for IEEE styles +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (ieee-replace t) + (cond ((nlist? t) t) + ((== t '(hbar)) '(ieeehbar)) + ((== t '(jmath)) '(ieeejmath)) + ((== t '(amalg)) '(ieeeamalg)) + ((== t '(coprod)) '(ieeecoprod)) + (else (map ieee-replace t)))) + +(tm-define (tmtex-postprocess-body x) + (:mode ieee-conf-style?) + (ieee-replace x)) + +(logic-group latex-texmacs-symbol% + ieeehbar ieeejmath ieeeamalg ieeecoprod) + +(smart-table latex-texmacs-macro + (ieeehbar (not "h")) + (ieeejmath "j") + (ieeecoprod + (!group (mathop (mbox (reflectbox (rotatebox + (!option "origin=c") "180" (!math (prod)))))))) + (ieeeamalg + (!group (mathop (mbox (reflectbox (rotatebox + (!option "origin=c") "180" (!math (Pi))))))))) diff --git a/progs/convert/latex/tmtex-revtex.scm b/progs/convert/latex/tmtex-revtex.scm new file mode 100644 index 0000000..2610c4a --- /dev/null +++ b/progs/convert/latex/tmtex-revtex.scm @@ -0,0 +1,226 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : tmtex-revtex.scm +;; DESCRIPTION : special conversions for RevTeX styles +;; COPYRIGHT : (C) 2012 Joris van der Hoeven, François Poulain +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex tmtex-revtex) + (:use (convert latex tmtex))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; RevTeX style options +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define revtex-style '("revtex4-1")) +(define revtex-clustered? #f) + +(tm-define (tmtex-style-init body) + (:mode revtex-style?) + (set! revtex-style '("revtex4-1")) + (set! revtex-clustered? #f)) + +(define (revtex-set-style-option s) + (set! revtex-style (append (list s) revtex-style))) + +(tm-define (tmtex-transform-style x) + (:mode revtex-style?) revtex-style) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; RevTeX data preprocessing +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (stree-contains? t u) + (cond ((== t u) #t) + ((nlist? t) #f) + ((null? t) #f) + (else (in? #t (map (lambda (x) (stree-contains? x u)) t))))) + +(define (insert-maketitle-after t u) + (cond ((nlist? t) t) + ((== (car t) u) `(!document ,t (maketitle))) + (else `(,(car t) ,@(map (lambda (x) (insert-maketitle-after x u)) + (cdr t)))))) +(define (revtex-style-preprocess doc) + (cond ((stree-contains? doc 'abstract-data) + (insert-maketitle-after doc 'abstract-data)) + ((stree-contains? doc 'doc-data) + (insert-maketitle-after doc 'doc-data)) + (else doc))) + +(tm-define (tmtex-style-preprocess doc) + (:mode aip-style?) + (revtex-set-style-option "aip") + (revtex-set-style-option "reprint") + (revtex-style-preprocess doc)) + +(tm-define (tmtex-style-preprocess doc) + (:mode aps-style?) + (if (stree-contains? doc 'abstract-keywords) + (revtex-set-style-option "showkeys")) + (if (stree-contains? doc 'abstract-msc) + (revtex-set-style-option "showpacs")) + (revtex-set-style-option "aps") + (revtex-set-style-option "reprint") + (revtex-style-preprocess doc)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; RevTeX metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-make-author names affiliations emails urls miscs notes + affs-l emails-l urls-l miscs-l notes-l) + (:mode revtex-style?) + (if (and (not revtex-clustered?) (null? affiliations)) + (set! affiliations `((noaffiliation)))) + (let* ((names (map (lambda (x) `(author ,x)) + (list-intersperse (map cadr names) '(tmSep)))) + (result `(,@names ,@emails ,@urls ,@notes ,@miscs ,@affiliations))) + (if (null? result) '() `(!paragraph ,@result)))) + +(tm-define (tmtex-make-doc-data titles subtitles authors dates miscs notes + subtits-l dates-l miscs-l notes-l tr ar) + (:mode revtex-style?) + (let* ((title-data `(,@titles ,@subtitles ,@notes ,@miscs)) + (title-data (if (null? title-data) '() `((!paragraph ,@title-data)))) + (authors* (filter pair? authors))) + (if (and (null? title-data) (null? authors*) (null? dates)) '() + `(!document ,@title-data ,@authors* ,@dates)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; RevTeX clustered authors presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (merge-with tags l) + (if (null? l) '() + (letrec ((remove-tag + (lambda (x) + (let* ((root (car x)) + (args (cdr x)) + (args* (filter (lambda (y) (nin? y tags)) args))) + `(,root ,@args*))))) + (let* ((last (cAr l)) + (others (cDr l)) + (others* (map remove-tag others))) + (if (null? tags) + (set! last `(,(car last) + ,@(cdr last) (author-affiliation (noaffiliation))))) + (map (lambda (x) `(doc-author ,x)) (append others* (list last))))))) + +(define (cluster-by tag l) + (if (or (null? l) (nlist? (car l))) '() + (letrec ((get-affiliations + (lambda (x) (tmtex-select-args-by-func tag x)))) + (let* ((author (car l)) + (aff (get-affiliations author)) + (same (filter (lambda (x) (== aff (get-affiliations x))) l)) + (others (filter (lambda (x) (!= aff (get-affiliations x))) l))) + (append (merge-with aff same) (cluster-by tag others)))))) + +(tm-define (tmtex-doc-data s l) + (:mode revtex-style?) + (:require (or revtex-clustered? + (stree-contains? l '(doc-title-options "cluster-all")) + (stree-contains? l '(doc-title-options + "cluster-by-affiliation")))) + (if (not revtex-clustered?) (set! revtex-clustered? #t)) + (set! l (map tmtex-replace-documents l)) + (let* ((subtitles (map tmtex-doc-subtitle + (tmtex-select-args-by-func 'doc-subtitle l))) + (notes (map tmtex-doc-note + (tmtex-select-args-by-func 'doc-note l))) + (miscs (map tmtex-doc-misc + (tmtex-select-args-by-func 'doc-misc l))) + (dates (map tmtex-doc-date + (tmtex-select-args-by-func 'doc-date l))) + (titles (map tmtex-doc-title + (tmtex-select-args-by-func 'doc-title l))) + (authors (map cadr + (tmtex-select-args-by-func 'doc-author l))) + (authors `((!document ,@(map tmtex-doc-author + (cluster-by + 'author-affiliation authors)))))) + (with r (tmtex-make-doc-data titles subtitles authors dates miscs notes + '() '() '() '() '() '()) + (set! revtex-clustered? #f) + r))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; RevTeX specific titlemarkup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-doc-subtitle t) + (:mode revtex-style?) + `(tmsubtitle ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-note t) + (:mode revtex-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmnote ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-misc t) + (:mode revtex-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmmisc ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-date t) + (:mode revtex-style?) + `(date ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-affiliation t) + (:mode revtex-style?) + (if (== t '(author-affiliation (noaffiliation))) + '(noaffiliation) + `(affiliation ,(tmtex (cadr t))))) + +(tm-define (tmtex-author-email t) + (:mode revtex-style?) + (set! t (tmtex-remove-line-feeds t)) + `(email (!option "Email: ") ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-homepage t) + (:mode revtex-style?) + (set! t (tmtex-remove-line-feeds t)) + `(homepage (!option "Web: ") ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-note t) + (:mode revtex-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmnote ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-misc t) + (:mode revtex-style?) + (set! t (tmtex-remove-line-feeds t)) + `(tmmisc ,(tmtex (cadr t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; RevTeX specific abstract markup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (move-in-abstract what in) + (if (null? in) + (if (null? what) '() `(((!begin "abstract") (document ,@what)))) + `(((!begin "abstract") (!document ,@(map cadr in) ,@what))))) + +(tm-define (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract) + (:mode revtex-style?) + (with class `(,@acm ,@arxiv ,@msc) + (set! abstract (move-in-abstract class abstract))) + (with result `(,@abstract ,@pacs ,@keywords) + (if (null? result) "" `(!document ,@result)))) + +(tm-define (tmtex-abstract-keywords t) + (:mode revtex-style?) + (with args (tmtex-concat-sep (map tmtex (cdr t))) + `(keywords ,@args))) + +(tm-define (tmtex-abstract-pacs t) + (:mode revtex-style?) + (with args (tmtex-concat-sep (map tmtex (cdr t))) + `(pacs ,@args))) diff --git a/progs/convert/latex/tmtex-springer.scm b/progs/convert/latex/tmtex-springer.scm new file mode 100644 index 0000000..d9e8507 --- /dev/null +++ b/progs/convert/latex/tmtex-springer.scm @@ -0,0 +1,409 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : tmtex-springer.scm +;; DESCRIPTION : special conversions for Springer styles +;; COPYRIGHT : (C) 2012 Joris van der Hoeven, François Poulain +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex tmtex-springer) + (:use (convert latex tmtex) + (convert latex latex-define))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Springer style options +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define llncs? #f) + +(tm-define (tmtex-style-init body) + (:mode springer-style?) + (set! llncs? #f)) + +(tm-define (tmtex-style-init body) + (:mode llncs-style?) + (set! llncs? #t)) + +(tm-define (tmtex-transform-style x) + (:mode springer-style?) + (if (== x "llncs") x "svjour3")) + +(tm-define (tmtex-transform-style x) + (:mode svmono-style?) + x) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Springer metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-make-author names affiliations emails urls miscs notes + affs-l emails-l urls-l miscs-l notes-l) + (:mode springer-style?) + (let* ((names (tmtex-concat-Sep (map cadr names))) + (result `(,@names ,@urls ,@notes ,@miscs))) + (if (null? result) '() `(author (!paragraph ,@result))))) + +(define (springer-append in l) + (set! l (filter nnull? l)) + (if (< (length l) 1) l + (with lf `(!concat (!linefeed) (and) (!linefeed)) + `((,in + (!indent (!concat ,@(list-intersperse (map cadr l) lf)))))))) + +(define (svjour-make-title titles notes miscs) + (let* ((titles (tmtex-concat-Sep (map cadr titles))) + (result `(,@titles ,@notes ,@miscs))) + (if (null? result) '() + `((title (!concat ,@result)))))) + +(define (svjour-make-doc-data + titles subtits authors affs dates miscs notes tr ar) + `(!document + ,@(svjour-make-title titles notes miscs) + ,@subtits + ,@tr + ,@ar + ,@(springer-append 'author authors) + ,@(springer-append 'institute affs) + ,@dates + (maketitle))) + +(tm-define (tmtex-doc-data s l) + (:mode springer-style?) + (set! l (map tmtex-replace-documents l)) + (let* ((subtitles (map tmtex-doc-subtitle + (tmtex-select-args-by-func 'doc-subtitle l))) + (notes (map tmtex-doc-note + (tmtex-select-args-by-func 'doc-note l))) + (miscs (map tmtex-doc-misc + (tmtex-select-args-by-func 'doc-misc l))) + (dates (map tmtex-doc-date + (tmtex-select-args-by-func 'doc-date l))) + (authors (map tmtex-doc-author + (tmtex-select-args-by-func 'doc-author l))) + (ar (map tmtex-doc-running-author + (tmtex-select-args-by-func 'doc-running-author l))) + (titles (map tmtex-doc-title + (tmtex-select-args-by-func 'doc-title l))) + (tr (map tmtex-doc-running-title + (tmtex-select-args-by-func 'doc-running-title l))) + (affs (map tmtex-affiliation-group + (cluster-by-affiliations + (tmtex-select-args-by-func 'doc-author l))))) + (svjour-make-doc-data titles subtitles authors affs dates miscs notes tr ar))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Springer affiliation clustering +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (springer-clear-aff aff a filter?) + (if (pair? (cadr a)) + (with datas (cdadr a) + (if (and filter? + (== `(,aff) + (filter (lambda (x) (func? x 'author-affiliation)) + datas))) + '() + `(doc-author + (author-data ,@(filter (lambda (x) (!= aff x)) datas))))) + '())) + +(define (next-affiliation l) + (cond ((or (null? l) (nlist? l)) #f) + ((in? (car l) '(doc-author author-data)) (next-affiliation (cdr l))) + ((== (car l) 'author-affiliation) l) + ((list? (car l)) + (with na (next-affiliation (car l)) + (if na na (next-affiliation (cdr l))))) + (else #f))) + +(define (cluster-by-affiliations l) + (if (nlist? l) l + (let* ((aff (next-affiliation l)) + (hasaff (filter (lambda (x) + (or (not aff) + (and (list? x) (list? (cdr x)) + (list? (cadr x)) + (in? aff (cdadr x))))) l)) + (hasaff* (map (lambda (x) (springer-clear-aff aff x #f)) hasaff)) + (l* (map (lambda (x) (springer-clear-aff aff x #t)) l)) + (l* (filter nnull? l*)) + (aff* `(affiliation-group + ,(if aff (cadr aff) '()) ,@hasaff*))) + (if aff (append `(,aff*) (cluster-by-affiliations l*)) `(,aff*))))) + +(tm-define (tmtex-affiliation-group t) + (with old-tmtex-make-author (eval tmtex-make-author) + (set! tmtex-make-author + (lambda (names affiliations emails urls miscs notes + affs-l emails-l urls-l miscs-l notes-l) + (with names (tmtex-concat-Sep (map cadr names)) + (cond ((and (null? names) (null? emails)) '()) + ((or (null? names) (null? emails)) + `(!concat ,@names ,@emails)) + (else `(!concat ,@names " " ,@emails)))))) + (let* ((affs (cadr t)) + (affs (if (null? affs) '() + `((!concat (!linefeed)(at)(!linefeed) ,(tmtex affs))))) + (auth-sep '(!concat " " (and) " ")) + (authors (map tmtex-doc-author (cddr t))) + (authors (list-intersperse authors auth-sep))) + (set! tmtex-make-author (eval old-tmtex-make-author)) + (if (and (null? authors) (null? affs)) '() + `(institute (!concat ,@authors ,@affs)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Springer specific titlemarkup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-doc-running-title t) + (:mode springer-style?) + `(titlerunning ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-subtitle t) + (:mode springer-style?) + `(subtitle ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-note t) + (:mode springer-style?) + `(tmnote ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-misc t) + (:mode springer-style?) + `(tmmisc ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-date t) + (:mode springer-style?) + `(date ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-running-author t) + (:mode springer-style?) + `(authorrunning ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-affiliation t) + (:mode springer-style?) + `(institute ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-email t) + (:mode springer-style?) + `(email ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-homepage t) + (:mode springer-style?) + `(tmfnhomepage ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-note t) + (:mode springer-style?) + `(tmnote ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-misc t) + (:mode springer-style?) + `(tmmisc ,(tmtex (cadr t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Springer specific abstract markup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract) + (:mode springer-style?) + (:require (not llncs?)) + (with result `(,@abstract ,@arxiv ,@acm ,@msc ,@pacs ,@keywords) + (if (null? result) "" `(!document ,@result)))) + +(tm-define (tmtex-abstract-keywords t) + (:mode springer-style?) + (:require (not llncs?)) + (with args (list-intersperse (map tmtex (cdr t)) '(!group (and))) + `(keywords (!concat ,@args)))) + +(tm-define (tmtex-abstract-msc t) + (:mode springer-style?) + (:require (not llncs?)) + (with args (list-intersperse (map tmtex (cdr t)) '(!group (and))) + `(subclass (!concat ,@args)))) + +(tm-define (tmtex-abstract-acm t) + (:mode springer-style?) + (:require (not llncs?)) + (with args (list-intersperse (map tmtex (cdr t)) '(!group (and))) + `(CRclass (!concat ,@args)))) + +(tm-define (tmtex-abstract-pacs t) + (:mode springer-style?) + (:require (not llncs?)) + (with args (list-intersperse (map tmtex (cdr t)) '(!group (and))) + `(PACS (!concat ,@args)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Springer SVMono style (basically like default LaTeX class with subtitle) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-transform-style x) + (:mode svmono-style?) x) + +(tm-define (tmtex-doc-subtitle t) + (:mode svmono-style?) + `(subtitle ,(tmtex (cadr t)))) + +(define (svmono-make-title titles notes miscs) + (let* ((titles (tmtex-concat-Sep (map cadr titles))) + (result `(,@titles ,@notes ,@miscs))) + (if (null? result) '() + `((title (!indent (!paragraph ,@result))))))) + +(tm-define (tmtex-make-doc-data titles subtitles authors dates miscs notes + subtits-l dates-l miscs-l notes-l tr ar) + (:mode svmono-style?) + `(!document + ,@(svmono-make-title titles notes miscs) + ,@subtitles + ,@(tmtex-append-authors authors) + ,@dates + (maketitle))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Springer LLNCS metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-doc-data s l) + (:mode llncs-style?) + (set! l (map tmtex-replace-documents l)) + (let* ((subtitles (map tmtex-doc-subtitle + (tmtex-select-args-by-func 'doc-subtitle l))) + (notes (map tmtex-doc-note + (tmtex-select-args-by-func 'doc-note l))) + (miscs (map tmtex-doc-misc + (tmtex-select-args-by-func 'doc-misc l))) + (dates (map tmtex-doc-date + (tmtex-select-args-by-func 'doc-date l))) + (ar (map tmtex-doc-running-author + (tmtex-select-args-by-func 'doc-running-author l))) + (titles (map tmtex-doc-title + (tmtex-select-args-by-func 'doc-title l))) + (tr (map tmtex-doc-running-title + (tmtex-select-args-by-func 'doc-running-title l))) + (authors (tmtex-select-args-by-func 'doc-author l)) + (affs (map tmtex-author-affiliation + (collect-affiliations authors))) + (authors (map tmtex-doc-author + (replace-affiliations authors 0)))) + (svjour-make-doc-data titles subtitles authors affs dates miscs notes tr ar))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Springer LLNCS affiliation clustering +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (collect-affiliations l) + (if (nlist? l) l + (let* ((aff (next-affiliation l)) + (l* (map (lambda (x) (springer-clear-aff aff x #t)) l)) + (l* (filter nnull? l*)) + (aff* (if aff `(affiliation-group ,(cadr aff))))) + (if aff (append `(,aff*) (collect-affiliations l*)) '())))) + +(define (springer-replace-aff aff a n) + (let* ((ref `(author-affiliation-ref ,(number->string n))) + (datas (cdadr a))) + `(doc-author (author-data ,@(map (lambda (x) + (if (!= aff x) x ref)) datas))))) + +(define (replace-affiliations l n) + (with aff (next-affiliation l) + (if (or (nlist? l) (not aff)) l + (let* ((n (1+ n)) + (l* (filter (lambda (x) (pair? (cadr x))) l)) + (l** (map (lambda (x) (springer-replace-aff aff x n)) l*))) + (replace-affiliations l** n))))) + +(define (tmtex-author-affiliation-ref t) + `(inst ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-author t) + (:mode llncs-style?) + (set! t (tmtex-replace-documents t)) + (if (or (npair? t) (npair? (cdr t)) (not (func? (cadr t) 'author-data))) '() + (let* ((datas (cdadr t)) + (miscs (map tmtex-author-misc + (tmtex-select-args-by-func 'author-misc datas))) + (notes (map tmtex-author-note + (tmtex-select-args-by-func 'author-note datas))) + (emails (map tmtex-author-email + (tmtex-select-args-by-func 'author-email datas))) + (urls (map tmtex-author-homepage + (tmtex-select-args-by-func 'author-homepage datas))) + (names (map tmtex-author-name + (tmtex-select-args-by-func 'author-name datas))) + (affs (map tmtex-author-affiliation-ref + (tmtex-select-args-by-func + 'author-affiliation-ref datas)))) + (tmtex-make-author names affs emails urls miscs notes + '() '() '() '() '())))) + +(tm-define (tmtex-make-author names affiliations emails urls miscs notes + affs-l emails-l urls-l miscs-l notes-l) + (:mode llncs-style?) + (let* ((names (tmtex-concat-Sep (map cadr names))) + (result `(,@names ,@affiliations)) + (result (if (null? result) '() `((!concat ,@result)))) + (result `(,@result ,@urls ,@notes ,@miscs))) + (if (null? result) '() `(author (!paragraph ,@result))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; LLNCS specific abstract markup +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-abstract-keywords t) + (:mode springer-style?) + (:require llncs?) + (with args (list-intersperse (map tmtex (cdr t)) '(!group (tmsep))) + `(keywords (!concat ,@args)))) + +(tm-define (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract) + (:mode springer-style?) + (:require llncs?) + (with class `(,@keywords ,@acm ,@arxiv ,@msc ,@pacs) + (if (nnull? class) + (set! abstract + `(((!begin "abstract") + (!document ,@(map cadr abstract) ,@class))))) + `(!document ,@abstract))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Springer specific macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(smart-table latex-texmacs-env-preamble + (:mode sv-style?) + ("theorem" #f) + ("proposition" #f) + ("lemma" #f) + ("corollary" #f) + ("definition" #f) + ("exercise" #f) + ("problem" #f) + ("solution" #f) + ("remark" #f) + ("note" #f) + ("case" #f) + ("conjecture" #f) + ("example" #f) + ("property" #f) + ("question" #f) + ("claim" #f)) + +(smart-table latex-texmacs-environment + (:mode sv-style?) + ("proof" #f)) + +(smart-table latex-texmacs-macro + (:mode sv-style?) + (qed #f)) + +(smart-table latex-texmacs-macro + (:mode svmono-style?) + (chapter #f)) diff --git a/progs/convert/latex/tmtex-widgets.scm b/progs/convert/latex/tmtex-widgets.scm new file mode 100644 index 0000000..b2a1c78 --- /dev/null +++ b/progs/convert/latex/tmtex-widgets.scm @@ -0,0 +1,174 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : tmtex-widgets.scm +;; DESCRIPTION : manual debugging of LaTeX errors +;; COPYRIGHT : (C) 2015 Joris van der Hoeven +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex tmtex-widgets) + (:use (convert latex tmtex) + (utils library cursor) + (check check-master))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The widget for examing LaTeX errors +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (latex-error-buffer) + (string->url "tmfs://aux/latex-error")) + +(define (latex-source-buffer) + (string->url "tmfs://aux/latex-source")) + +(define (latex-error-digest err) + (tree->string (tree-ref err 1))) + +(define (string->document s) + (with l (string-tokenize-by-char (string->tmstring s) #\newline) + `(document ,@l))) + +(define (latex-error-doc* err) + (if (<= (tree-arity err) 2) + (string->document (tree->string (tree-ref err 0))) + `(document + (padded + (with "color" "dark red" + ,(string->document (tree->string (tree-ref err 2)))) + "0fn" "0.5fn") + (padded + (with "color" "black" + ,(string->document (tree->string (tree-ref err 3)))) + "0fn" "0.5fn") + (padded + (with "color" "dark blue" + ,(string->document (tree->string (tree-ref err 4)))) + "0fn" "0.5fn") + (padded + (with "color" "black" + ,(string->document (tree->string (tree-ref err 5)))) + "0fn" "0.5fn")))) + +(define (latex-error-doc err) + `(document (code ,(latex-error-doc* err)))) + +(define (decode-path t) + (and (tree-func? t 'tuple) + (list-and (map tree-integer? (tree-children t))) + (map tree->number (tree-children t)))) + +(define (latex-error-track buf err) + (when (>= (tree-arity err) 8) + (let* ((p (decode-path (tree-ref err 7))) + (b (buffer-get-body buf)) + (src (apply tree-ref (cons b p)))) + (when src + (with-buffer buf + (tree-select src) + (tree-go-to src :start)))))) + +(define (latex-error-show doc err) + (when (>= (tree-arity err) 7) + (let* ((pos (tree->number (tree-ref err 6))) + (l (- (get-line-number doc pos) 1)) + (c (get-column-number doc pos)) + (src (buffer-get-body "tmfs://aux/latex-source"))) + (and-with line (tree-ref src l) + (when (and (tree-atomic? line) + (<= c (string-length (tree->string line)))) + (with-buffer "tmfs://aux/latex-source" + (let* ((p (tree->path line)) + (b (append p (list 0))) + (e (append p (list c)))) + (selection-set b e) + (tree-go-to line c)))))))) + +(tm-widget ((latex-errors-widget buf doc errs) quit) + (let* ((digest (map latex-error-digest errs)) + (errnr 0) + (err (list-ref errs errnr)) + (sel (lambda (msg) + (set! errnr (or (list-find-index digest (cut == <> msg)) 0)) + (set! err (list-ref errs errnr)) + (buffer-set-body "tmfs://aux/latex-error" + (latex-error-doc (list-ref errs errnr))) + (latex-error-track buf err) + (latex-error-show doc err)))) + (padded + (resize "800px" "200px" + (scrollable + (choice (sel answer) digest ""))) + ====== + (resize "800px" "150px" + (texmacs-input (latex-error-doc (list-ref errs errnr)) + `(style (tuple "generic")) + (latex-error-buffer))) + ====== + (resize "800px" "450px" + (texmacs-input (string->document doc) + `(style (tuple "verbatim-source")) + (latex-source-buffer)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Convert, run pdflatex, and examine errors +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (current-buffer-suffixed suf) + (and (url-exists? (current-buffer)) + (buffer-has-name? (current-buffer)) + (let* ((tm (current-buffer)) + (nr (string-length (url-suffix tm))) + (tex (url-glue (url-unglue tm nr) suf))) + (and (== (url-suffix tm) "tm") tex)))) + +(define (latex-export) + (with tex (current-buffer-suffixed "tex") + (if (not tex) + (set-message "TeXmacs buffer on disk expected" "latex-export") + (export-buffer tex)))) + +(define (latex-run) + (cond ((not (url-exists? (current-buffer))) + (set-message "buffer must be on disk" "latex-run")) + ((not (buffer-has-name? (current-buffer))) + (set-message "buffer must have a name" "latex-run")) + ((not (current-buffer-suffixed "tex")) + (set-message "TeXmacs buffer expected" "latex-run")) + (else + (let* ((opts (std-converter-options "texmacs-stree" "latex-document")) + (tm (current-buffer)) + (tex (current-buffer-suffixed "tex")) + (report (with-global current-save-target tex + (try-latex-export (buffer-get tm) opts tm tex)))) + (if (tree-atomic? report) + (set-message (tree->string report) "latex-run") + (let* ((buf (current-buffer)) + (doc (tree->string (tree-ref report 0))) + (errs (cdr (tree-children report)))) + (if (null? errs) + (set-message "Generated LaTeX document contains no errors" + "latex-run") + (dialogue-window (latex-errors-widget buf doc errs) + noop "LaTeX errors" + (latex-error-buffer) + (latex-source-buffer))))))))) + +(define (latex-preview) + (let* ((tex (current-buffer-suffixed "tex")) + (pdf (current-buffer-suffixed "pdf"))) + (if (not (and tex pdf)) + (set-message "TeXmacs buffer on disk expected" "latex-export") + (begin + (export-buffer tex) + (run-pdflatex tex) + (preview-file pdf))))) + +(menu-bind tmtex-menu + ("Export" (latex-export)) + ("Run" (latex-run)) + ("Preview" (latex-preview))) diff --git a/progs/convert/latex/tmtex.scm b/progs/convert/latex/tmtex.scm new file mode 100644 index 0000000..f1b7d3d --- /dev/null +++ b/progs/convert/latex/tmtex.scm @@ -0,0 +1,3556 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : tmtex.scm +;; DESCRIPTION : conversion of TeXmacs trees into TeX/LaTeX trees +;; COPYRIGHT : (C) 2002 Joris van der Hoeven +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (convert latex tmtex) + (:use (convert tools tmpre) + (convert tools old-tmtable) + (convert tools tmlength) + (convert rewrite tmtm-brackets) + (convert latex texout) + (doc tmdoc-markup) + (convert latex latex-tools))) + +;(use-modules (ice-9 format)) + +(tm-define tmtex-debug-mode? #f) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Global variables +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define tmtex-style "generic") +(tm-define tmtex-packages '()) +(tm-define tmtex-replace-style? #t) +(define tmtex-languages '()) +(define tmtex-colors '()) +(define tmtex-colormaps '()) +(define tmtex-env (make-ahash-table)) +(define tmtex-macros (make-ahash-table)) +(define tmtex-dynamic (make-ahash-table)) +(define tmtex-serial 0) +(define tmtex-ref-cnt 1) +(define tmtex-auto-produce 0) +(define tmtex-auto-consume 0) +(define tmtex-image-root-url (unix->url "image")) +(define tmtex-image-root-string "image") +(define tmtex-appendices? #f) +(define tmtex-indirect-bib? #f) +(define tmtex-mathjax? #f) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Style +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-modes + ;;; Elsevier styles + (elsevier-style% (in? tmtex-style '("elsart" "jsc" "elsarticle" + "ifac"))) + (jsc-style% (in? tmtex-style '("jsc")) elsevier-style%) + (elsarticle-style% (in? tmtex-style '("elsarticle")) elsevier-style%) + (elsart-style% (in? tmtex-style '("elsart")) elsevier-style%) + (ifac-style% (in? tmtex-style '("ifac")) elsevier-style%) + + ;;; ACM styles + (acm-style% (in? tmtex-style '("acmconf" "sig-alternate" + "acm_proc_article-sp" + "acmsmall" "acmlarge" "acmtog" + "sigconf" "sigchi" "sigplan" + "acmart"))) + (acm-art-style% (in? tmtex-style '("acmsmall" "acmlarge" "acmtog" + "sigconf" "sigchi" "sigplan" + "acmart")) acm-style%) + (sig-alternate-style% (in? tmtex-style '("sig-alternate")) acm-style%) + (acm-conf-style% (in? tmtex-style '("acmconf" "sig-alternate" + "acm_proc_article-sp")) acm-style%) + (acm-small-style% (in? tmtex-style '("acmsmall")) acm-art-style%) + (acm-large-style% (in? tmtex-style '("acmlarge")) acm-art-style%) + (acm-tog-style% (in? tmtex-style '("acmtog")) acm-art-style%) + (acm-sigconf-style% (in? tmtex-style '("sigconf")) acm-art-style%) + (acm-sigchi-style% (in? tmtex-style '("sigchi")) acm-art-style%) + (acm-sigplan-style% (in? tmtex-style '("sigplan")) acm-art-style%) + + ;; AMS styles + (ams-style% (in? tmtex-style '("amsart"))) + + ;; Revtex styles + (revtex-style% (in? tmtex-style '("aip" "aps"))) + (aip-style% (in? tmtex-style '("aip")) revtex-style%) + (aps-style% (in? tmtex-style '("aps")) revtex-style%) + (sv-style% (in? tmtex-style '("svjour" "svjour3" + "llncs" "svmono"))) + + ;; Springer styles + (springer-style% (in? tmtex-style '("svjour" "svjour3" + "llncs" sv-style%))) + (svjour-style% (in? tmtex-style '("svjour" + "svjour3")) springer-style%) + (llncs-style% (in? tmtex-style '("llncs")) springer-style%) + (svmono-style% (in? tmtex-style '("svmono")) sv-style%) + + ;; IEEE styles + (ieee-style% (in? tmtex-style '("ieeeconf" "ieeetran"))) + (ieee-conf-style% (in? tmtex-style '("ieeeconf")) ieee-style%) + (ieee-tran-style% (in? tmtex-style '("ieeetran")) ieee-style%) + + ;; Other styles + (beamer-style% (in? tmtex-style '("beamer" "old-beamer"))) + (natbib-package% (in? "cite-author-year" tmtex-packages))) + +(tm-define (tmtex-style-init body) + (noop)) + +(tm-define (tmtex-style-preprocess doc) doc) + +(define (import-tmtex-styles) + (cond ((elsevier-style?) (import-from (convert latex tmtex-elsevier))) + ((acm-style?) (import-from (convert latex tmtex-acm))) + ((ams-style?) (import-from (convert latex tmtex-ams))) + ((revtex-style?) (import-from (convert latex tmtex-revtex))) + ((ieee-style?) (import-from (convert latex tmtex-ieee))) + ((beamer-style?) (import-from (convert latex tmtex-beamer))) + ((or (springer-style?) (svmono-style?)) + (import-from (convert latex tmtex-springer))) + (else (noop)))) + +(tm-define (tmtex-provided-packages) '()) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Initialization from options +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-initialize opts) + (set! tmtex-ref-cnt 1) + (set! tmtex-env (make-ahash-table)) + (set! tmtex-macros (make-ahash-table)) + (set! tmtex-dynamic (make-ahash-table)) + (set! tmtex-serial 0) + (set! tmtex-auto-produce 0) + (set! tmtex-auto-consume 0) + (set! tmtex-mathjax? #f) + (if (== (url-suffix current-save-target) "tex") + (begin + (set! tmtex-image-root-url (url-unglue current-save-target 4)) + (with suf (url-suffix tmtex-image-root-url) + (when (!= suf "") + (set! tmtex-image-root-url + (url-unglue tmtex-image-root-url + (+ (string-length suf) 1))))) + (set! tmtex-image-root-string + (url->unix (url-tail tmtex-image-root-url)))) + (begin + (set! tmtex-image-root-url (unix->url "image")) + (set! tmtex-image-root-string "image"))) + (set! tmtex-appendices? #f) + (set! tmtex-replace-style? + (== (assoc-ref opts "texmacs->latex:replace-style") "on")) + (set! tmtex-indirect-bib? + (== (assoc-ref opts "texmacs->latex:indirect-bib") "on")) + (set! tmtex-use-macros? + (== (assoc-ref opts "texmacs->latex:use-macros") "on")) + (when (== (assoc-ref opts "texmacs->latex:mathjax") "on") + (tmtex-env-set "mode" "math") + (set! tmtex-mathjax? #t)) + (with charset (assoc-ref opts "texmacs->latex:encoding") + (if tmtex-cjk-document? (set! charset "utf-8")) + (cond ((== charset "utf-8") + (set! tmtex-use-catcodes? #f) + (set! tmtex-use-ascii? #f) + (set! tmtex-use-unicode? #t)) + ((== charset "cork") + (set! tmtex-use-catcodes? #t) + (set! tmtex-use-ascii? #f) + (set! tmtex-use-unicode? #f)) + ((== charset "ascii") + (set! tmtex-use-catcodes? #f) + (set! tmtex-use-ascii? #t) + (set! tmtex-use-unicode? #f))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Determination of the mode in which commands are used +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define command-text-uses (make-ahash-table)) +(define command-math-uses (make-ahash-table)) + +(define (compute-mode-stats t mode) + (when (tree-compound? t) + (let* ((h (if (== mode (tree "math")) + command-math-uses + command-text-uses)) + (n (or (ahash-ref h (tree-label t)) 0))) + (ahash-set! h (tree-label t) (+ n 1)) + (for-each (lambda (i) + (with nmode (tree-child-env t i "mode" mode) + (compute-mode-stats (tree-ref t i) nmode))) + (.. 0 (tree-arity t)))))) + +(define (init-mode-stats t) + (set! command-text-uses (make-ahash-table)) + (set! command-math-uses (make-ahash-table)) + (compute-mode-stats (tm->tree t) "text")) + +(define (mode-protect t) + (cond ((and (pair? t) (symbol? (car t)) + (string-starts? (symbol->string (car t)) "tmtext")) + `(text ,t)) + ((and (pair? t) (symbol? (car t)) + (or (string-starts? (symbol->string (car t)) "tmmath") + (string-starts? (symbol->string (car t)) "math"))) + `(ensuremath ,t)) + ((func? t '!concat) + `(!concat ,@(map mode-protect (cdr t)))) + (else t))) + +(define (tmtex-pre t) + (cond ((tm-func? t 'para) + (cons '!paragraph (map-in-order tmtex-pre (tm-children t)))) + ((tm-func? t 'concat) + (cons '!paragraph (map-in-order tmtex-pre (tm-children t)))) + ((tm-func? t 'mtm 2) + `(mtm ,(cadr t) ,(tmtex-pre (caddr t)))) + ((and (tm-func? t 'assign 2) (tm-atomic? (tm-ref t 0))) + (let* ((name (tm-ref t 0)) + (tag (string->symbol name)) + (tnr (or (ahash-ref command-text-uses tag) 0)) + (mnr (or (ahash-ref command-math-uses tag) 0))) + ;;(display* tag ", " tnr ", " mnr "\n") + (cond ((and (string-ends? name "*") + (or (string-starts? name "itemize") + (string-starts? name "enumerate") + (string-starts? name "description"))) + "") + ((>= tnr mnr) + (with r (tmtex t) + ;;(display* t " -> " r "\n") + (when (and (> mnr 0) (func? r 'newcommand 2)) + (with val (mode-protect (caddr r)) + (set! r (list (car r) (cadr r) val)))) + r)) + (else + (tmtex-env-set "mode" "math") + (with r (tmtex t) + (tmtex-env-reset "mode") + ;;(display* t " -> " r "\n") + (when (and (> tnr 0) (func? r 'newcommand 2)) + (with val (mode-protect (caddr r)) + (set! r (list (car r) (cadr r) val)))) + r))))) + (else (tmtex t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Data +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-table tmtex-table-props% + (block ("" "l" "" #t)) + (block* ("" "c" "" #t)) + (wide-block ("{\\noindent}" "@{}X@{}" "" #t)) + (tabular ("" "l" "" #f)) + (tabular* ("" "c" "" #f)) + (wide-tabular ("{\\noindent}" "@{}X@{}" "" #f)) + (matrix ((,(string->symbol "left(")) "c" (,(string->symbol "right)")) #f)) + (det ((left|) "c" (right|) #f)) + (bmatrix ((,(string->symbol "left[")) "c" (,(string->symbol "right]")) #f)) + (stack ("" "c" "" #f)) + (choice ((left\{) "l" (right.) #f)) + (tabbed ("" "l" "" #f)) + (tabbed* ("" "l" "" #f)) + (rcl-table ("{\\setlength\\arraylinesep{0.4em}\\everymath={\\displaystyle}" + "rcl" "}" #f))) + +(logic-table tex-with-cmd% + (("font-family" "rm") tmtextrm) + (("font-family" "ss") tmtextsf) + (("font-family" "tt") tmtexttt) + (("font-series" "medium") tmtextmd) + (("font-series" "bold") tmtextbf) + (("font-shape" "right") tmtextup) + (("font-shape" "slanted") tmtextsl) + (("font-shape" "italic") tmtextit) + (("font-shape" "small-caps") tmtextsc) + (("par-columns" "2") (!begin "multicols" "2")) + (("par-columns" "3") (!begin "multicols" "3")) + (("par-mode" "center") (!begin "center")) + (("par-mode" "left") (!begin "flushleft")) + (("par-mode" "right") (!begin "flushright"))) + +(logic-table tex-with-cmd-math% + (("font" "cal") mathcal) + (("font" "cal*") mathscr) + (("font" "cal**") EuScript) + (("font" "Euler") mathfrak) + (("font" "Bbb") mathbb) + (("font" "Bbb*") mathbbm) + (("font" "Bbb**") mathbbmss) + (("font" "Bbb***") mathbb) + (("font" "Bbb****") mathds) + (("font-family" "rm") mathrm) + (("font-family" "ss") mathsf) + (("font-family" "tt") mathtt) + (("font-series" "medium") tmmathmd) + (("font-series" "bold") tmmathbf) + (("font-shape" "right") mathrm) + (("font-shape" "slanted") mathit) + (("font-shape" "italic") mathit) + (("font-shape" "small-caps") mathrm) + (("math-font" "cal") mathcal) + (("math-font" "cal*") mathscr) + (("math-font" "cal**") EuScript) + (("math-font" "Euler") mathfrak) + (("math-font" "Bbb") mathbb) + (("math-font" "Bbb*") mathbbm) + (("math-font" "Bbb**") mathbbmss) + (("math-font" "Bbb***") mathbb) + (("math-font" "Bbb****") mathds) + (("math-font-family" "mr") mathrm) + (("math-font-family" "ms") mathsf) + (("math-font-family" "mt") mathtt) + (("math-font-family" "normal") mathnormal) + (("math-font-family" "rm") mathrm) + (("math-font-family" "ss") mathsf) + (("math-font-family" "tt") mathtt) + (("math-font-family" "bf") mathbf) + (("math-font-family" "it") mathit) + (("math-font-series" "bold") tmmathbf)) + +(logic-table tex-assign-cmd% + (("font-family" "rm") rmfamily) + (("font-family" "ss") ssfamily) + (("font-family" "tt") ttfamily) + (("font-series" "medium") mdseries) + (("font-series" "bold") bfseries) + (("font-shape" "right") upshape) + (("font-shape" "slanted") slshape) + (("font-shape" "italic") itshape) + (("font-shape" "small-caps") scshape)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Manipulation of the environment +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-env-list var) + (let ((r (ahash-ref tmtex-env var))) + (if r r '()))) + +(define (tmtex-env-get var) + (let ((val (tmtex-env-list var))) + (and (pair? val) (car val)))) + +(define (tmtex-env-get-previous var) + (let ((val (tmtex-env-list var))) + (if (or (null? val) (null? (cdr val))) #f + (cadr val)))) + +(define (tmtex-math-mode?) + (== (tmtex-env-get "mode") "math")) + +(tm-define (tmtex-env-set var val) + (ahash-set! tmtex-env var (cons val (tmtex-env-list var)))) + +(tm-define (tmtex-env-reset var) + (let ((val (tmtex-env-list var))) + (if (nnull? val) + (ahash-set! tmtex-env var (cdr val))))) + +(tm-define (tmtex-env-assign var val) + (tmtex-env-reset var) + (tmtex-env-set var val)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Frequently used TeX construction subroutines +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-concat-sep l) + (set! l (list-intersperse l '(!concat (tmsep) " "))) + (if (null? l) '() `((!concat ,@l)))) + +(tm-define (tmtex-concat-Sep l) + (set! l (list-intersperse l '(!concat (tmSep) " "))) + (if (null? l) '() `((!concat ,@l)))) + +(define (tex-concat-similar l) + (cond ((or (null? l) (null? (cdr l))) l) + ((> (length l) 1000) + (let* ((s (quotient (length l) 2)) + (h (list-head l s)) + (t (list-tail l s))) + (tex-concat-similar `((!concat ,@h) (!concat ,@t))))) + (else + (let ((r (tex-concat-similar (cdr l)))) + (cond ((and (func? (car l) '!sub) (func? (car r) '!sub)) + (cons (list '!sub (tex-concat (list (cadar l) (cadar r)))) + (cdr r))) + ((and (func? (car l) '!sup) (func? (car r) '!sup)) + (cons (list '!sup (tex-concat (list (cadar l) (cadar r)))) + (cdr r))) + (else (cons (car l) r))))))) + +(define (tex-concat-list l) + (cond ((null? l) l) + ((== (car l) "") (tex-concat-list (cdr l))) + ((func? (car l) '!concat) (append (cdar l) (tex-concat-list (cdr l)))) + (else (cons (car l) (tex-concat-list (cdr l)))))) + +(tm-define (tex-concat l) + (:synopsis "Horizontal concatenation of list of LaTeX expressions") + (let ((r (tex-concat-similar (tex-concat-list l)))) + (if (null? r) "" + (if (null? (cdr r)) (car r) + (cons '!concat r))))) + +(define (tex-concat-strings l) + (cond ((< (length l) 2) l) + ((and (string? (car l)) (string? (cadr l))) + (tex-concat-strings (cons (string-append (car l) (cadr l)) (cddr l)))) + (else (cons (car l) (tex-concat-strings (cdr l)))))) + +(tm-define (tex-concat* l) + (:synopsis "Variant of tex-concat which concatenates adjacent strings") + (tex-concat (tex-concat-strings l))) + +(tm-define (tex-apply . l) + (if (or (tmtex-math-mode?) (logic-in? (car l) tmpre-sectional%)) l + (list '!group l))) + +(tm-define (tex-math-apply . l) + (if (tmtex-math-mode?) l + (list 'ensuremath l))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Strings +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (string-starts? s r) + (and (>= (string-length s) (string-length r)) + (== (substring s 0 (string-length r)) r))) + +(define (tmtex-modified-token op s i) + (tex-math-apply op + (if (= (string-length s) (+ i 1)) + (substring s i (string-length s)) + (tex-apply (string->symbol (substring s i (string-length s))))))) + +(logic-table latex-special-symbols% + ("less" #\<) + ("gtr" #\>) + ("box" (Box)) + ("over" #\:) + ("||" (|)) ;; | + ("precdot" (tmprecdot))) + +(logic-table latex-text-symbols% + ("#20AC" euro) + ("cent" textcent) + ("circledR" textregistered) + ("copyright" textcopyright) + ("currency" textcurrency) + ("degree" textdegree) + ("mu" textmu) + ("onehalf" textonehalf) + ("onequarter" textonequarter) + ("onesuperior" textonesuperior) + ("paragraph" P) + ("threequarters" textthreequarters) + ("threesuperior" textthreesuperior) + ("trademark" texttrademark) + ("twosuperior" texttwosuperior) + ("yen" textyen)) + +(tm-define (tmtex-token-sub s group?) + (cond ((logic-ref latex-special-symbols% s) + (logic-ref latex-special-symbols% s)) + ((string-starts? s "up-") (tmtex-modified-token 'mathrm s 3)) + ;;((string-starts? s "bbb-") (tmtex-modified-token 'mathbbm s 4)) + ((and (string-starts? s "bbb-") + (>= (string-length s) 5) + (string-number? (substring s 4 5))) + (tmtex-modified-token 'mathbbm s 4)) + ((string-starts? s "bbb-") (tmtex-modified-token 'mathbb s 4)) + ((string-starts? s "cal-") (tmtex-modified-token 'mathcal s 4)) + ((string-starts? s "frak-") (tmtex-modified-token 'mathfrak s 5)) + ((string-starts? s "b-cal-") + (tex-math-apply 'tmmathbf (tmtex-modified-token 'mathcal s 6))) + ((string-starts? s "b-up-") (tmtex-modified-token 'mathbf s 5)) + ((string-starts? s "b-") (tmtex-modified-token 'tmmathbf s 2)) + ((and (not (tmtex-math-mode?)) (logic-ref latex-text-symbols% s)) + (list '!group (list (logic-ref latex-text-symbols% s)))) + ((and (string-starts? s "#") (not tmtex-use-catcodes?)) + (let* ((qs (string-append "<" s ">")) + (cv (string-convert qs "Cork" "UTF-8"))) + (list '!widechar (string->symbol cv)))) + ((and (string-starts? s "#") tmtex-use-catcodes?) + (let* ((qs (string-append "<" s ">")) + (us (string-convert qs "Cork" "UTF-8")) + (cv (string-convert us "UTF-8" "LaTeX"))) + (list '!widechar (string->symbol cv)))) + (else (let* ((s2 (string-replace s "-" "")) + (ss (list (string->symbol s2)))) + (cond ((logic-in? (car ss) tmtex-protected-symbol%) + (with sy (string->symbol (string-append "tmx" s2)) + (list '!symbol (list sy)))) + ((not (logic-in? (car ss) latex-symbol%)) + (display* "TeXmacs] non converted symbol: " s "\n") + (list '!symbol (list 'nonconverted s2))) + (group? (list '!group ss)) + (else (list '!symbol ss))))))) + +(define (tmtex-token l routine group?) + (receive (p1 p2) (list-break (cdr l) (lambda (x) (== x #\>))) + (let* ((s (list->string p1)) + (q (if (null? p2) '() (cdr p2))) + (r (routine q))) + (cons (tmtex-token-sub s group?) r)))) + +(define (tmtex-text-sub head l) + (if (string? head) + (append (string->list head) (tmtex-text-list (cdr l))) + (append (list head) (tmtex-text-list (cdr l))))) + +(define (tmtex-special-char? c) + (string-index "#$%&_{}" c)) + +(define (tmtex-break-char? c) + (string-index "+ -:=,?;()[]{}<>/" c)) + +(define (tmtex-text-list-space l) + (cond ((null? l) l) + ((== (car l) #\space) + (cons (list (string->symbol " ")) (tmtex-text-list-space (cdr l)))) + (else (tmtex-text-list l)))) + +(define (tmtex-text-list l) + (if (null? l) l + (let ((c (car l))) + (cond ((== c #\<) (tmtex-token l tmtex-text-list #t)) + ((== c #\space) (cons c (tmtex-text-list-space (cdr l)))) + ((tmtex-special-char? c) + (cons (list (string->symbol (char->string c))) + (tmtex-text-list (cdr l)))) + ((== c #\~) (tmtex-text-sub "\\~{}" l)) + ((== c #\^) (tmtex-text-sub "\\^{}" l)) + ((== c #\\) (tmtex-text-sub '(textbackslash) l)) + ((== c #\`) (tmtex-text-sub "`" l)) + ((== c #\x00) (tmtex-text-sub "\\`{}" l)) + ((== c #\x01) (tmtex-text-sub "\\'{}" l)) + ((== c #\x04) (tmtex-text-sub "\\\"{}" l)) + ((== c #\x05) (tmtex-text-sub "\\H{}" l)) + ((== c #\x06) (tmtex-text-sub "\\r{}" l)) + ((== c #\x07) (tmtex-text-sub "\\v{}" l)) + ((== c #\x08) (tmtex-text-sub "\\u{}" l)) + ((== c #\x09) (tmtex-text-sub "\\={}" l)) + ((== c #\x0A) (tmtex-text-sub "\\.{}" l)) + ((== c #\x0E) (tmtex-text-sub "\\k{}" l)) + ((== c #\x10) (tmtex-text-sub "``" l)) + ((== c #\x11) (tmtex-text-sub "''" l)) + ((== c #\x12) (tmtex-text-sub ",," l)) + ((== c #\x15) (tmtex-text-sub "--" l)) + ((== c #\x16) (tmtex-text-sub "---" l)) + ((== c #\x17) (tmtex-text-sub "{}" l)) + ((== c #\x1B) (tmtex-text-sub "ff" l)) + ((== c #\x1C) (tmtex-text-sub '(textbackslash) l)) + ((== c #\x1D) (tmtex-text-sub "fl" l)) + ((== c #\x1E) (tmtex-text-sub "ffi" l)) + ((== c #\x1F) (tmtex-text-sub "ffl" l)) + ((== c #\|) (tmtex-text-sub '(textbar) l)) + (else + (append + (if (or tmtex-use-unicode? tmtex-use-ascii?) + (string->list (string-convert (char->string c) + "Cork" "UTF-8")) + (list c)) + (tmtex-text-list (cdr l)))))))) + +(define (tmtex-math-operator l) + (receive (p q) (list-break l (lambda (c) (not (char-alphabetic? c)))) + (let* ((op (tmtex-textual (list->string p))) + (tail (tmtex-math-list q))) + (if (logic-in? (string->symbol op) latex-operator%) + (cons (list '!symbol (tex-apply (string->symbol op))) tail) + (cons (post-process-math-text (tex-apply 'tmop op)) tail))))) + +(define (tmtex-math-list l) + (if (null? l) l + (let ((c (car l))) + (cond ((== c #\<) (tmtex-token l tmtex-math-list #f)) + ((tmtex-special-char? c) + (cons (list (string->symbol (char->string c))) + (tmtex-math-list (cdr l)))) + ((== c #\~) (tmtex-math-list (cdr l))) + ((== c #\^) (tmtex-math-list (cdr l))) + ((== c #\\) + (cons (list 'backslash) (tmtex-math-list (cdr l)))) +;; ((== c #\*) (cons '(*) (tmtex-math-list (cdr l)))) + ((== c #\*) (tmtex-math-list (cdr l))) + ((== c #\') (append (list '(prime)) (tmtex-math-list (cdr l)))) + ((== c #\`) (append (list '(backprime)) (tmtex-math-list (cdr l)))) +;; ((== c #\space) (tmtex-math-list (cdr l))) + ((and (char-alphabetic? c) + (nnull? (cdr l)) + (char-alphabetic? (cadr l))) + (tmtex-math-operator l)) + (else + (with c + (if (or tmtex-use-unicode? tmtex-use-ascii?) + (string->list (string-convert (char->string c) + "Cork" "UTF-8")) + (list c)) + (append c (tmtex-math-list (cdr l))))))))) + +(define (tmtex-verb-list l) + (if (null? l) l + (let ((c (car l))) + (if (== c #\<) + (let ((r (tmtex-token l tmtex-verb-list #t))) + (if (char? (car r)) r (cdr r))) + (cons c (tmtex-verb-list (cdr l))))))) + +(define (tmtex-string-break? x start) + (or (not (char? x)) + (and (tmtex-math-mode?) + (or (tmtex-break-char? x) + (and (char-alphabetic? x) (char-numeric? start)) + (and (char-alphabetic? start) (char-numeric? x)))))) + +(define (tmtex-string-produce l) + (if (null? l) l + (if (not (tmtex-string-break? (car l) (car l))) + (receive (p q) + (list-break l (lambda (x) (tmtex-string-break? x (car l)))) + (cons (list->string p) (tmtex-string-produce q))) + (if (equal? (car l) #\space) + (tmtex-string-produce (cdr l)) + (cons (if (char? (car l)) (char->string (car l)) (car l)) + (tmtex-string-produce (cdr l))))))) + +(define (tmtex-string s) + (if (> (string-length s) 1000) + `(!concat ,@(map tmtex (tmstring-split s))) + (let* ((l (string->list s)) + (t (if (tmtex-math-mode?) + (tmtex-math-list l) + (tmtex-text-list l))) + (r (tmtex-string-produce t))) + (tex-concat r)))) + +(define (string-convert* what from to) + (with c (string->list what) + (apply string-append + (map (lambda (x) (string-convert (char->string x) from to)) c)))) + +(define (tmtex-verb-string s) + (when (nstring? s) + (set! s (texmacs->verbatim (tm->tree s)))) + (let* ((l (string->list s)) + (t (tmtex-verb-list l)) + (r (tmtex-string-produce t))) + (if (or tmtex-use-unicode? tmtex-use-ascii?) + (set! r (map (lambda (x) (string-convert* x "Cork" "UTF-8")) r)) + (set! r (map unescape-angles r))) + (tex-concat r))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Entire files +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-transform-style x) + (cond ((in? x '("generic" "exam" + "old-generic" "old-article" + "tmarticle" "tmdoc" "mmxdoc")) "article") + ((in? x '("book" "old-book" "tmbook" "tmmanual")) "book") + ((in? x '("letter" "old-letter")) "letter") + ((in? x '("beamer" "old-beamer")) "beamer") + ((in? x '("seminar" "old-seminar")) "slides") + ((not tmtex-replace-style?) x) + (else #f))) + +(define (tmtex-filter-styles l) + (if (null? l) l + (let* ((next (tmtex-transform-style (car l))) + (tail (tmtex-filter-styles (cdr l)))) + (if next (cons next tail) tail)))) + +(define (macro-definition? x) + (and (func? x 'assign 2) + (string? (cadr x)) + (func? (caddr x) 'macro))) + +(define (tmtex-filter-style-macro t) + (letrec ((ndef-style? (lambda (x env) (or (not (macro-definition? x)) + (nin? (cadr x) env)))) + (filter-style-macro + (lambda (t env) + (cond ((nlist? t) t) + (else (map (cut filter-style-macro <> env) + (filter (cut ndef-style? <> env) t))))))) + (with env (append (logic-first-list 'tmtex-methods%) + (logic-first-list 'tmtex-tmstyle%)) + (filter-style-macro t env)))) + +(define (comment-preamble t) + (cond ((string? t) `(!comment ,t)) + ((or (func? t 'para) + (func? t 'concat) + (func? t 'document)) (map comment-preamble t)) + (else t))) + +(define (tmtex-filter-preamble l) + (cond ((or (nlist? l) (null? l)) '()) + ((macro-definition? l) (list l)) + ((and (func? l 'hide-preamble 1) + (list>0? (cadr l))) (map comment-preamble (cdadr l))) + (else (append-map tmtex-filter-preamble (cdr l))))) + +(define (tmtex-non-preamble-statement? l) + (cond ((or (nlist? l) (null? l)) #t) + ((== (car l) 'assign) #f) + ((== (car l) 'hide-preamble) #f) + ((func? l 'mtm 2) (tmtex-non-preamble-statement? (caddr l))) + (else #t))) + +(define (tmtex-filter-body l) + (cond ((or (nlist? l) (null? l)) l) + ((== (car l) 'assign) "") + ((== (car l) 'hide-preamble) "") + ((in? (car l) '(concat document)) + (with a (list-filter (cdr l) tmtex-non-preamble-statement?) + (if (null? a) + (if (== (car l) 'concat) "" '(document "")) + (cons (car l) (map tmtex-filter-body a))))) + (else (cons (car l) (map tmtex-filter-body (cdr l)))))) + +(define (tmtex-filter-duplicates* l t) + (cond ((null? l) l) + ((func? (car l) 'assign 2) + (let* ((var (cadr (car l))) + (r (tmtex-filter-duplicates* (cdr l) t)) + (dup? (ahash-ref t var))) + (ahash-set! t var #t) + (if dup? r (cons (car l) r)))) + ((or (func? (car l) 'concat) + (func? (car l) 'para) + (func? (car l) 'document)) + (with r (tmtex-filter-duplicates* (cdr l) t) + (cons (cons (caar l) (tmtex-filter-duplicates* (cdar l) t)) r))) + (else (cons (car l) (tmtex-filter-duplicates* (cdr l) t))))) + +(define (tmtex-filter-duplicates l) + (with t (make-ahash-table) + (tmtex-filter-duplicates* l t))) + +(define (tmtex-apply-init body init) + ;;(display* "init= " init "\n") + (cond ((== (assoc-ref init "language") "verbatim") + (with init* (assoc-remove! init "language") + (tmtex-apply-init `(verbatim ,body) init*))) + (else body))) + +(define (tmtex-clean-body b) + (when (and (func? b '!document) + (> (length b) 1) + (== (cadr b) `(!document ""))) + (set! b (cons (car b) (cddr b)))) + b) + +(define (tmtex-file l) + (let* ((doc (car l)) + (styles (cadr l)) + (init* (cadddr l)) + (init (or (and (!= init* "#f") init*) '(collection))) + (init-bis (if (list>1? init) + (map (lambda (x) (cons (cadr x) (caddr x))) (cdr init)) + '())) + (att (or (cadddr (cdr l)) '())) + (doc-pre (tmtex-filter-preamble (tmtex-filter-style-macro doc))) + (doc-preamble (tmtex-filter-duplicates doc-pre)) + (doc-body-pre (tmtex-filter-body doc)) + (doc-body (tmtex-apply-init doc-body-pre init-bis))) + (init-mode-stats doc-body-pre) + (latex-set-texmacs-style (if (pair? styles) (car styles) "none")) + (latex-set-texmacs-packages (if (pair? styles) (cdr styles) (list))) + (if (== (get-preference "texmacs->latex:expand-user-macros") "on") + (set! doc-preamble '())) + (if (null? styles) (tmtex doc) + (let* ((styles* (tmtex-filter-styles styles)) + (styles** (if (and (== styles* (list "article")) + (in? `(associate "par-columns" "2") init)) + (list `("twocolumn" "article")) + styles*)) + (preamble* (ahash-with tmtex-env :preamble #t + (map-in-order tmtex-pre doc-preamble))) + (body* (tmtex-postprocess-body (tmtex doc-body))) + (body** (tmtex-clean-body body*)) + (needs (list tmtex-languages tmtex-colors tmtex-colormaps))) + (list '!file body** styles** needs init preamble*))))) + +(define (convert-charset t) + (cond ((string? t) (unescape-angles (utf8->cork t))) + ((list>0? t) `(,(car t) ,@(map convert-charset (cdr t)))))) + +(define (tmtex-ilx l) + `(!invariant ,(car l))) + +(define (tmtex-mtm l) + (cond ((null? l) "") + ((null? (cdr l)) (tmtex (car l))) + (else + (with lab (car l) + (when (func? lab 'mtm 1) (set! lab (cadr lab))) + `(!concat (!marker btm ,lab) + ,(tmtex (cadr l)) + (!marker etm ,lab)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Simple text +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-noop . l) "") +(define (tmtex-default s l) (cons (string->symbol s) (tmtex-list l))) +(define (tmtex-id l) (tmtex (car l))) +(define (tmtex-first l) (tmtex (car l))) +(define (tmtex-style-first s l) (tmtex (car l))) +(define (tmtex-second l) (tmtex (cadr l))) +(define (tmtex-style-second s l) (tmtex (cadr l))) +(define (tmtex-hide-part s l) "") +(define (tmtex-show-part s l) (tmtex (cadr l))) + +(define (tmtex-error l) + (display* "TeXmacs] error in conversion: " l "\n") + (if tmtex-debug-mode? "(error)" "")) + +(define (tmtex-line-note l) + `(tmlinenote ,(tmtex (car l)) + ,(tmtex-decode-length (cadr l)) + ,(tmtex-decode-length (caddr l)))) + +(define (tmtex-marginal-left-note l) + `(marginpar (!option ,(tmtex (cAr l))) ,(tmtex '()))) + +(define (tmtex-marginal-right-note l) + `(marginpar (!option "") ,(tmtex (cAr l)))) + +(define (tmtex-marginal-note l) + (cond ((== (car l) "left") (tmtex-marginal-left-note (cdr l))) + ((== (car l) "right") (tmtex-marginal-right-note (cdr l))) + (else `(marginpar ,(tmtex (cAr l)))))) + +(define (tmtex-document l) + (cons '!document (tmtex-list l))) + +(define (tmtex-date l) + (tmtex-default "tmdate" l)) + +(define (tmtex-para l) + (cons '!paragraph (tmtex-list l))) + +(define (tmtex-surround-sub l z) + (if (null? (cdr l)) + (list (tex-concat (list (car l) z))) + (cons (car l) (tmtex-surround-sub (cdr l) z)))) + +(define (tmtex-surround l) + (let* ((ll (tmtex-list l)) + (x (car ll)) + (y (caddr ll)) + (z (cadr ll))) + (if (func? y '!document) + (let* ((a (cadr y)) + (b (cddr y))) + (cons '!document + (tmtex-surround-sub + (cons (tex-concat (list x a)) b) z))) + (tex-concat (list x y z))))) + +(define (tmtex-no-space-before? x) + (or (func? x '!sub) + (func? x '!sup) + (and (string? x) (!= x "") + (in? (string-ref x 0) '(#\' #\, #\) #\]))) + (and (func? x '!concat) (tmtex-no-space-before? (cadr x))))) + +(define (tmtex-no-space-after? x) + (or (and (string? x) (!= x "") + (in? (string-ref x 0) '(#\( #\[))) + (and (func? x '!concat) (tmtex-no-space-after? (cAr x))))) + +(define (tmtex-math-concat-spaces l) + (if (or (null? l) (null? (cdr l))) l + (let* ((head (car l)) + (tail (tmtex-math-concat-spaces (cdr l)))) + (if (or (tmtex-no-space-after? head) + (tmtex-no-space-before? (car tail))) + (cons head tail) + (cons* head " " tail))))) + +(define (tmtex-rewrite-no-break l) + (cond ((null? l) l) + ((and (string? (car l)) (string-ends? (car l) " ") + (nnull? (cdr l)) (== (cadr l) '(no-break))) + (let* ((s (substring (car l) 0 (- (string-length (car l)) 1))) + (r (tmtex-rewrite-no-break (cddr l)))) + (if (== s "") (cons '(!nbsp) r) (cons* s '(!nbsp) r)))) + (else (cons (car l) (tmtex-rewrite-no-break (cdr l)))))) + +(define (check-double-script? l sub? sup?) + (cond ((or (null? l) (npair? (car l))) #f) + ((== (caar l) 'rsub) + (or sub? (check-double-script? (cdr l) #t sup?))) + ((in? (caar l) '(rsup rprime)) + (or sup? (check-double-script? (cdr l) sub? #t))) + (else #f))) + +(define (pre-scripts l) + (cond ((or (null? l) (null? (cdr l))) l) + ((check-double-script? (cdr l) #f #f) + (if (== (== (caadr l) 'rsub) (== (caaddr l) 'rsub)) + (pre-scripts (cons `(!group (concat ,(car l) ,(cadr l))) + (cddr l))) + (pre-scripts (cons `(!group (concat ,(car l) ,(cadr l) ,(caddr l))) + (cdddr l))))) + (else + (cons (car l) (pre-scripts (cdr l)))))) + +(define (tmtex-concat l) + ;;(display* "l= " l "\n") + (if (> (length l) 50) + (with s (quotient (length l) 2) + (let ((h (list-head l s)) + (t (list-tail l s))) + (tmtex-concat `((concat ,@h) (concat ,@t))))) + (if (tmtex-math-mode?) + (with l* (pre-scripts l) + ;;(when (!= l* l) (display* l " -> " l* "\n")) + ;;(display* "l1= " l* "\n") + ;;(display* "l2= " (pre-brackets-recurse l*) "\n") + ;;(display* "l3= " (tmtex-list (pre-brackets-recurse l*)) "\n") + (tex-concat (tmtex-math-concat-spaces + (tmtex-list (pre-brackets-recurse l*))))) + (tex-concat (tmtex-list (tmtex-rewrite-no-break l)))))) + +(define (tmtex-rigid l) + (tmtex-function '!group l)) + +(define (tmtex-no-first-indentation l) (tex-apply 'noindent)) +(define (tmtex-line-break l) (tex-apply 'linebreak)) +(define (tmtex-page-break l) (tex-apply 'pagebreak)) +(define (tmtex-new-page l) (tex-apply 'newpage)) +(define (tmtex-no-page-break l) (tex-apply 'nopagebreak)) +(define (tmtex-next-line l) (list '!nextline)) +(define (tmtex-no-break l) '(!group (nobreak))) +(define (tmtex-emdash l) "---") + +(define (tmtex-new-line l) + (if (tmtex-math-mode?) (tmtex-next-line l) (tex-apply '!newline))) + +(tm-define (tmtex-decode-length len) + ;; FIXME: should be completed + (with s (force-string len) + (cond ((string-ends? s "fn") (string-replace s "fn" "em")) + ((string-ends? s "tab") (string-replace s "tab" "em")) + ((string-ends? s "spc") (string-replace s "spc" "em")) + ((string-ends? s "sep") (string-replace s "sep" "ex")) + ((string-ends? s "par") (string-replace s "par" "\\columnwidth")) + ((string-ends? s "pag") (string-replace s "pag" "\\textheight")) + (else s)))) + +(define (tmtex-hrule s l) (list 'hrulefill)) + +(define (tmtex-hspace l) + (let ((s (if (= (length l) 1) (car l) (cadr l)))) + (cond ((== s "0.5fn") (list 'enspace)) + ((== s "1fn") (list 'quad)) + ((== s "2fn") (list 'qquad)) + ((== s "0.5em") (list 'enspace)) + ((== s "1em") (list 'quad)) + ((== s "2em") (list 'qquad)) + ((== s "0.2spc") (list (string->symbol ","))) + ((not (tmtex-math-mode?)) + (cond ((== s "0.4spc") (list (string->symbol ","))) + ((== s "0.6spc") (list (string->symbol ","))) + ((== s "0.16667em") (list (string->symbol ","))) + (else (tex-apply 'hspace (tmtex-decode-length s))))) + ((== s "0.4spc") (list (string->symbol ":"))) + ((== s "0.6spc") (list (string->symbol ";"))) + ((== s "-0.6spc") '(!concat (!) (!) (!))) + ((== s "-0.4spc") '(!concat (!) (!))) + ((== s "-0.2spc") '(!concat (!))) + (else (tex-apply 'hspace (tmtex-decode-length s)))))) + +(define (tmtex-hspace* s l) + (tmtex-hspace l)) + +(define (tmtex-vspace l) + (let ((s (if (= (length l) 1) (car l) (cadr l)))) + (cond ((== s "0.5fn") (tex-apply 'smallskip)) + ((== s "1fn") (tex-apply 'medskip)) + ((== s "2fn") (tex-apply 'bigskip)) + (else (tex-apply 'vspace (tmtex-decode-length s)))))) + +(define (tmtex-space l) + (tmtex-hspace (list (car l)))) + +(define (into-single-paragraph t) + (set! t (tm-replace t (lambda (x) (tm-in? x '(equation equation*))) + (lambda (x) + (if (and (== (length x) 2) + (tm-func? (cadr x) 'document 1)) + `(math ,(cadr (cadr x))) + `(math ,@(cdr x)))))) + (set! t (tm-replace t (lambda (x) (tm-func? x 'document)) + (lambda (x) `(para ,@(cdr x))))) + t) + +(define (tmtex-float-make wide? size type position x capt) + (let* ((pos (string-replace position "f" "")) + (type* (if wide? (string-append type "*") type)) + (body (tmtex x)) + (caption (tmtex (into-single-paragraph capt))) + (body* `(!paragraph ,body (caption ,caption)))) + (cond ((and (== size "big") (== type "figure")) + (if (== pos "") + `((!begin ,type) ,body*) + `((!begin ,type* (!option ,pos)) ,body*))) + ((and (== size "big") (== type "table")) + (if (== pos "") + `((!begin ,type) ,body*) + `((!begin ,type* (!option ,pos)) ,body*))) + (else (list 'tmfloat pos size type* body caption))))) + +(define (tmtex-float-table? x) + (or (func? x 'small-table 2) (func? x 'big-table 2))) + +(define (tmtex-float-figure? x) + (or (func? x 'small-figure 2) (func? x 'big-figure 2))) + +(define (tmtex-float-size l) + (if (list? l) + (if (or (func? l 'small-table) (func? l 'small-figure)) "small" "big") + "big")) + +(define (tmtex-float-sub wide? position l) + (with pos (string-replace position "f" "") + (cond ((func? l 'document 1) + (tmtex-float-sub wide? pos (cadr l))) + ((tmtex-float-figure? l) + (tmtex-float-make wide? (tmtex-float-size l) "figure" + pos (cadr l) (caddr l))) + ((tmtex-float-table? l) + (tmtex-float-make wide? (tmtex-float-size l) "table" + pos (cadr l) (caddr l))) + (else + (tmtex-float-make wide? "big" "figure" + pos l ""))))) + +(define (tmtex-float l) + (tmtex-float-sub #f (force-string (cadr l)) (caddr l))) + +(define (tmtex-wide-float l) + (tmtex-float-sub #t (force-string (cadr l)) (caddr l))) + +(define (tmtex-htab l) + (tex-apply 'hspace* (list 'fill))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Make brackets small when necessary +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (disable-large? x level) + (cond ((string? x) #t) + ((func? x 'concat) + (list-and (map (cut disable-large? <> level) (cdr x)))) + ((tm-in? x '(left mid right)) #t) + ((tm-in? x '(lsub lsup rsub rsup)) + (and (> level 0) (disable-large? (cadr x) (- level 1)))) + ((tm-in? x '(lprime rprime)) #t) + ((tm-in? x '(wide wide*)) + (disable-large? (cadr x) (- level 1))) + ((tm-in? x '(with rigid locus)) + (disable-large? (cAr x) level)) + ((tm-in? x '(math-up math-ss math-tt math-bf math-it math-sl)) + (and (== (tm-arity x) 1) (disable-large? (cadr x) level))) + (else #f))) + +(define (make-small s) + (cond ((nstring? s) "") + ((== s ".") "") + ((<= (string-length s) 1) s) + ((and (string-starts? s "<") (string-ends? s ">")) s) + (else (string-append "<" s ">")))) + +(define (make-small-bracket x) + (if (tm-in? x '(left mid right)) (make-small (cadr x)) x)) + +(define (find-right l) + (cond ((null? l) #f) + ((func? (car l) 'left) #f) + ((func? (car l) 'right) 2) + (else (with i (find-right (cdr l)) (and i (+ i 1)))))) + +(define (pre-brackets l) + (cond ((null? l) l) + ((func? (car l) 'left) + (with n (find-right (cdr l)) + (if (not n) (cons (car l) (pre-brackets (cdr l))) + (let* ((r (pre-brackets (sublist l n (length l)))) + (m (sublist l 0 n))) + (if (disable-large? `(concat ,@m) 2) + (begin + ;;(display* "< " m "\n") + ;;(display* "> " (map make-small-bracket m) "\n") + (append (map make-small-bracket m) r)) + (append m r)))))) + (else (cons (car l) (pre-brackets (cdr l)))))) + +(define (pre-brackets-recurse l) + (with r (pre-brackets l) + (if (== r l) r + (pre-brackets-recurse r)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Mathematics +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (convert-around x) + (with d (downgrade-brackets x) + (tmtex-concat (if (pair? d) (cdr d) (list d))))) + +(define (tmtex-around l) + (convert-around (cons 'around l))) + +(define (tmtex-around* l) + (convert-around (cons 'around* l))) + +(define (tmtex-big-around l) + (convert-around (cons 'big-around l))) + +(define (tmtex-large-decode s) + (cond ((nstring? s) ".") + ((in? s '("(" ")" "[" "]" "|" "/" ".")) s) + ((in? s '("||" "<||>")) "\\|") + ((== s "\\") "\\backslash") + ((and (string-starts? s "<") (string-ends? s ">")) + (string-append "\\" (substring s 1 (- (string-length s) 1)))) + (else (string-append "\\" s)))) + +(define (tmtex-large-decode-text s) + (cond ((nstring? s) "") + ((== s ".") "") + ((in? s '("(" ")" "[" "]" "|" "/")) s) + ((in? s '("{" "}")) (string-append "\\" s)) + (else + (display* "TeXmacs] non converted bracket: " s "\n") + ""))) + +(define (tmtex-left l) + (if (tmtex-math-mode?) + (let* ((s (tmtex-large-decode (car l))) + (n (if (= (length l) 2) (string->number (cadr l)) 0)) + (b (cond ((not n) "left") + ((= n 1) "bigl") + ((= n 2) "Bigl") + ((= n 3) "biggl") + ((= n 4) "Biggl") + (else "left")))) + (list (string->symbol (string-append b s)))) + (tmtex-large-decode-text (car l)))) + +(define (tmtex-mid l) + (display* "TeXmacs] downgraded large middle delimiter: " (car l) "\n") + (if (tmtex-math-mode?) + (with s (tmtex-large-decode (car l)) + (if (== s ".") "" s)) + (tmtex-large-decode-text (car l)))) + +(define (tmtex-right l) + (if (tmtex-math-mode?) + (let* ((s (tmtex-large-decode (car l))) + (n (if (= (length l) 2) (string->number (cadr l)) 0)) + (b (cond ((not n) "right") + ((= n 1) "bigr") + ((= n 2) "Bigr") + ((= n 3) "biggr") + ((= n 4) "Biggr") + (else "right")))) + (list (string->symbol (string-append b s)))) + (tmtex-large-decode-text (car l)))) + +(define (tmtex-big-decode s) + (cond ((nstring? s) "bignone") + ((in? s '("sum" "prod" "int" "oint" "coprod")) s) + ((in? s '("iint" "iiint" "iiiint" "idotsint")) s) + ((in? s '("oiint" "oiiint")) s) + ((== s "amalg") "coprod") + ((== s "pluscup") "uplus") + ((== s ".") "bignone") + (else (string-append "big" s)))) + +(define (tmtex-big l) + (list (string->symbol (tmtex-big-decode (car l))))) + +(define (tmtex-decode-long-arrow s) + (cond ((nstring? s) #f) + ((and (string-starts? s "")) + (tmtex-decode-long-arrow (substring s 8 (- (string-length s) 1)))) + ((in? s '("minus" "leftarrow" "rightarrow" "leftrightarrow" + "equal" "Leftarrow" "Rightarrow" "Leftrightarrow" + "mapsto" "mapsfrom")) + (string->symbol (string-append "x" s))) + ((in? s '("leftrightarrows" "leftleftarrows" + "threeleftarrows" "fourleftarrows" + "rightleftarrows" "rightrightarrows" + "threerightarrows" "fourrightarrows")) + (string-append "")) + ((== s "Lleftarrow") "") + ((== s "Rrightarrow") "") + ((== s "LRleftrightarrow") "") + (else (string-append "<" s ">")))) + +(define (tmtex-long-arrow l) + (with cmd (tmtex-decode-long-arrow (car l)) + (cond ((and (symbol? cmd) (== (length l) 2)) + (list cmd (tmtex (cadr l)))) + ((symbol? cmd) + (list cmd (list '!option (tmtex (caddr l))) (tmtex (cadr l)))) + ((== (length l) 2) + (list 'overset (tmtex (cadr l)) (tmtex cmd))) + ((== (cadr l) "") + (list 'underset (tmtex (caddr l)) (tmtex cmd))) + (else + (list 'underset (tmtex (caddr l)) + (list 'overset (tmtex (cadr l)) (tmtex cmd))))))) + +(define (tmtex-below l) + (list 'underset (tmtex (cadr l)) (tmtex (car l)))) + +(define (tmtex-above l) + (list 'overset (tmtex (cadr l)) (tmtex (car l)))) + +(define (tmtex-lsub l) + (cond ((== (car l) "") "") + ((tmtex-math-mode?) (tmtex `(concat (!group) (rsub ,(car l))))) + (else (tmtex `(rsub ,(car l)))))) + +(define (tmtex-lsup l) + (cond ((== (car l) "") "") + ((tmtex-math-mode?) (tmtex `(concat (!group) (rsup ,(car l))))) + (else (tmtex `(rsup ,(car l)))))) + +(define (tmtex-contains-table? x) + (cond ((nlist? x) #f) + ((and (>= (length x) 2) (== (car x) '!table)) #t) + (else (list-or (map-in-order tmtex-contains-table? (cdr x)))))) + +(define (tmtex-script which script) + (with r (tmtex script) + (if (tmtex-contains-table? r) + (list which (list 'tmscript r)) + (list which r)))) + +(define (tmtex-rsub l) + (cond ((== (car l) "") "") + ((tmtex-math-mode?) (tmtex-script '!sub (car l))) + (else (list 'tmrsub (tmtex (car l)))))) + +(define (tmtex-rsup l) + (cond ((== (car l) "") "") + ((tmtex-math-mode?) (tmtex-script '!sup (car l))) + (else (list 'tmrsup (tmtex (car l)))))) + +(define (tmtex-modulo l) + (tmtex-script 'mod (car l))) + +(define (tmtex-frac l) + (tmtex-function 'frac l)) + +(define (tmtex-sqrt l) + (if (= (length l) 1) + (tmtex-function 'sqrt l) + (list 'sqrt + (list '!option (tmtex (cadr l))) + (tmtex (car l))))) + +(define (tmtex-token? s) + (or (= (string-length s) 1) + (and (!= s "") + (== (string-ref s 0) #\<) + (== (string-index s #\>) (- (string-length s) 1))))) + +(define (tmtex-wide-star? x) + (cond ((func? x 'wide* 1) (tmtex-wide-star? (cadr x))) + ((nstring? x) #t) + (else (not (tmtex-token? x))))) + +(define (tmtex-wide-star l) + (let ((wide? (tmtex-wide-star? (car l))) + (arg (tmtex (car l))) + (acc (cadr l)) + (text? (not (tmtex-math-mode?)))) + (if (and (string? acc) (string-starts? acc "" "^")) (list (if wide? 'uwidehat 'uhat) arg)) + ((in? acc '("" "~")) (list (if wide? 'uwidetilde 'utilde) arg)) + ((== acc "") (list 'underline arg)) + ((== acc "") (list (if wide? 'underrightarrow 'uvec) arg)) + ((== acc "") (list 'ubreve arg)) + ((== acc "") (list 'uinvbreve arg)) + ((== acc "") (list 'ucheck arg)) + ((== acc "") (list 'uring arg)) + ((== acc "") (list 'uacute arg)) + ((== acc "") (list 'ugrave arg)) + ((== acc "") (list 'underdot arg)) + ((== acc "") (list 'uddot arg)) + ((== acc "") (list 'udddot arg)) + ((== acc "") (list 'uddddot arg)) + ((== acc "") (list 'underrightarrow arg)) + ((== acc "") (list 'underleftarrow arg)) + ((== acc "") (list 'underleftrightarrow arg)) + ((== acc "") (list 'underrightarrow arg)) + ((== acc "") (list 'underleftarrow arg)) + ((== acc "") (list 'underleftrightarrow arg)) + ((in? acc '("" "")) + (list 'underbrace arg)) + ((in? acc '("" "")) + (tmtex-below `(,(car l) (text (downbracefill))))) + ((in? acc '("" "")) + (list 'underbrace arg)) + ((in? acc '("" "")) + (tmtex-below `(,(car l) (text (downbracefill))))) + ;; imperfect translations + ((in? acc '("" "")) + (list 'underbrace arg)) + ((in? acc '("" "")) + (tmtex-below `(,(car l) (text (downbracefill))))) + (else + (display* "TeXmacs] non converted accent below: " acc "\n") + arg)))) + +(define (tmtex-wide? x) + (cond ((func? x 'wide 1) (tmtex-wide? (cadr x))) + ((nstring? x) #t) + (else (not (tmtex-token? x))))) + +(define (tmtex-wide l) + (let ((wide? (tmtex-wide? (car l))) + (arg (tmtex (car l))) + (acc (cadr l)) + (text? (not (tmtex-math-mode?)))) + (if (and (string? acc) (string-starts? acc "" "^")) + (list (if text? '^ (if wide? 'widehat 'hat)) arg)) + ((in? acc '("" "~")) + (list (if text? '~ (if wide? 'widetilde 'tilde)) arg)) + ((== (cadr l) "") + (list (if text? '= 'overline) arg)) + ((== acc "") + (list (if text? '= (if wide? 'overline 'bar)) arg)) + ((== acc "") (list (if wide? 'overrightarrow 'vec) arg)) + ((== acc "") (list (if text? 'u 'breve) arg)) + ((== acc "") (list 'invbreve arg)) + ((== acc "") (list (if text? 'v 'check) arg)) + ((== acc "") (list (if text? 'r 'ring) arg)) + ((== acc "") + (list (if text? (string->symbol "'") 'acute) arg)) + ((== acc "") + (list (if text? (string->symbol "`") 'grave) arg)) + ((== acc "") + (list (if text? (string->symbol ".") 'dot) arg)) + ((== acc "") + (list (if text? (string->symbol "\"") 'ddot) arg)) + ((== acc "") (list 'dddot arg)) + ((== acc "") (list 'ddddot arg)) + ((== acc "") (list 'overrightarrow arg)) + ((== acc "") (list 'overleftarrow arg)) + ((== acc "") (list 'overleftrightarrow arg)) + ((== acc "") (list 'overrightarrow arg)) + ((== acc "") (list 'overleftarrow arg)) + ((== acc "") (list 'overleftrightarrow arg)) + ((in? acc '("" "")) + (list 'overbrace arg)) + ((in? acc '("" "")) + (tmtex-above `(,(car l) (text (upbracefill))))) + ((in? acc '("" "")) + (list 'overbrace arg)) + ((in? acc '("" "")) + (tmtex-above `(,(car l) (text (upbracefill))))) + ;; FIXME: imperfect translations + ((in? acc '("" "")) + (list 'overbrace arg)) + ((in? acc '("" "")) + (tmtex-above `(,(car l) (text (upbracefill))))) + (else + (display* "TeXmacs] non converted accent: " acc "\n") + arg)))) + +(define (tmtex-neg l) + (tmtex-function 'not l)) + +(define (tmtex-tree l) + (let* ((root (list '!begin "bundle" (tmtex (car l)))) + (children (map (lambda (x) (list 'chunk (tmtex x))) (cdr l)))) + (list root (tex-concat children)))) + +(define (tmtex-tree-eps l) + (tmtex-eps (cons 'tree l))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Hacks for tables with multi-paragraph cells +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (map-or l1 l2) + (if (or (null? l1) (null? l2)) (list) + (cons (or (car l1) (car l2)) (map-or (cdr l1) (cdr l2))))) + +(define (tmtex-block-columns t) + (cond ((tm-func? t 'tformat) (tmtex-block-columns (cAr t))) + ((tm-func? t 'table 1) (tmtex-block-columns (cAr t))) + ((tm-func? t 'table) + (let* ((b1 (tmtex-block-columns `(table ,(cadr t)))) + (b2 (tmtex-block-columns `(table ,@(cddr t))))) + (map-or b1 b2))) + ((tm-func? t 'row) (map tmtex-block-columns (cdr t))) + ((tm-func? t 'cell) (tmtex-block-columns (cAr t))) + (else (tm-func? t 'document)))) + +(define (column-numbers l i) + (cond ((null? l) (list)) + ((car l) (cons i (column-numbers (cdr l) (+ i 1)))) + (else (column-numbers (cdr l) (+ i 1))))) + +(define (block-align nr out-of) + (let* ((c (number->string nr)) + (p (string-append "p{" (number->string (/ 12.0 out-of)) "cm}"))) + `(cwith "1" "-1" ,c ,c "cell-halign" ,p))) + +(define (tmtex-block-adjust t) + (cond ((tm-func? t 'tformat) + (append (cDr t) (list (tmtex-block-adjust (cAr t))))) + ((tm-func? t 'table) + (let* ((b (tmtex-block-columns t)) + (n (column-numbers b 1))) + (if (null? n) t + `(tformat ,@(map (cut block-align <> (length n)) n) ,t)))) + (else t))) + +(define (tm-big-figure? t) + (tm-in? t '(big-figure big-table))) + +(define (tm-replace-figure t) + (cond ((tm-func? t 'big-figure) + (list 'tmfloat "h" "big" "figure" (cadr t) (caddr t))) + ((tm-func? t 'big-table) + (list 'tmfloat "h" "big" "table" (cadr t) (caddr t))) + (else t))) + +(define (tmtex-figure-adjust t) + (tm-replace t tm-big-figure? tm-replace-figure)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tables +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-table-rows-assemble tb bb rows) + (cond ((null? rows) + (if (null? bb) '() (if (car bb) (list (list 'hline)) '()))) + (else (append (if (or (car tb) (car bb)) (list (list 'hline)) '()) + (cons (cons '!row (map tmtex (car rows))) + (tmtex-table-rows-assemble + (cdr tb) (cdr bb) (cdr rows))))))) + +(define (tmtex-table-make p) + (let ((tb (p 'rows 'tborder)) + (bb (p 'rows 'bborder)) + (l (p 'rows 'content))) + (cons '!table (tmtex-table-rows-assemble tb (cons (car tb) bb) l)))) + +(define (tmtex-table-args-assemble lb rb ha) + (cond + ((null? ha) (if (null? rb) '() (list (if (car rb) "|" "")))) + (else (cons (if (or (car lb) (car rb)) "|" "") + (cons (car ha) (tmtex-table-args-assemble + (cdr lb) (cdr rb) (cdr ha))))))) + +(define (tmtex-table-args p) + (let ((lb (p 'cols 'lborder)) + (rb (p 'cols 'rborder)) + (l (p 'cols 'halign))) + (apply string-append + (tmtex-table-args-assemble lb (cons (car lb) rb) l)))) + +(define (tmtex-table-apply key args x) + (let* ((props (logic-ref tmtex-table-props% key)) + (wide? (and props (string-contains? (cadr props) "X")))) + (when (== key 'rcl-table) + (latex-add-extra "tabls")) + (when (and (not (tmtex-math-mode?)) (not wide?)) + (set! x (tmtex-block-adjust x)) + (set! x (tmtex-figure-adjust x))) + (if props + (let* ((env (if (tmtex-math-mode?) "array" "tabular")) + (env* (if wide? (list "tabularx" "1.0\\textwidth") (list env))) + (before (car props)) + (after (caddr props)) + (defaults (append (tmtable-cell-halign (cadr props)) + (tmtable-block-borders (cadddr props)))) + (p (tmtable-parser `(tformat ,@defaults ,x))) + (e `(!begin ,@env* ,(tmtex-table-args p))) + (r (tmtex-table-make p))) + (tex-concat (list before (list e r) after))) + (begin + (list `(!begin ,(symbol->string key) ,@args) + (tmtex-table-make (tmtable-parser x))))))) + +(define (tmtex-tformat l) + (tmtex-table-apply 'tabular '() (cons 'tformat l))) + +(define (tmtex-table l) + (tmtex-table-apply 'tabular '() (cons 'table l))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Local and global environment changes +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-get-with-cmd var val) + (if (tmtex-math-mode?) + (or (logic-ref tex-with-cmd-math% (list var val)) + (logic-ref tex-with-cmd% (list var val))) + (logic-ref tex-with-cmd% (list var val)))) + +(define (tmtex-get-assign-cmd var val) + (if (== var "font-size") + (let ((x (* (string->number val) 10))) + (cond ((< x 1) #f) + ((< x 5.5) 'tiny) + ((< x 6.5) 'scriptsize) + ((< x 7.5) 'footnotesize) + ((< x 9.5) 'small) + ((< x 11.5) 'normalsize) + ((< x 13.5) 'large) + ((< x 15.5) 'Large) + ((< x 18.5) 'LARGE) + ((< x 22.5) 'huge) + ((< x 50) 'Huge) + (else #f))) + (logic-ref tex-assign-cmd% (list var val)))) + +(define (tmlength->texlength len) + ;; TODO: rewrite (quote x) -> x and (tmlen ...) -> ...pt + (with tmlen (string->tmlength (force-string len)) + (if (tmlength-null? tmlen) "0pt" + (let* ((val (tmlength-value tmlen)) + (unit (symbol->string (tmlength-unit tmlen))) + (val-string (number->string val))) + (cond ((== unit "fn") (string-append val-string "em")) + (else len)))))) + +(define (tmtex-make-parmod x y z arg flag?) + (set! x (tmlength->texlength x)) + (set! y (tmlength->texlength y)) + (set! z (tmlength->texlength z)) + (if (and (tmlength-zero? (string->tmlength x)) + (tmlength-zero? (string->tmlength y)) + (tmlength-zero? (string->tmlength z)) + flag?) + arg + (list (list '!begin "tmparmod" x y z) arg))) + +(define (tmtex-make-parsep x arg) + (set! x (tmlength->texlength x)) + (list (list '!begin "tmparsep" x) arg)) + +(define (tmtex-make-lang val arg) + (if (== val "verbatim") + `(tt ,arg) + (begin + (if (nin? val tmtex-languages) + (set! tmtex-languages (append (list val) tmtex-languages))) + (if (texout-multiline? arg) + `((!begin "otherlanguage" ,val) ,arg) + `(foreignlanguage ,val ,arg))))) + +(define (tmtex-decode-color s . force-html) + (with cm (if (string-starts? s "#") "HTML" (named-color->xcolormap s)) + (cond ((and (== cm "none") (nnull? force-html)) + (tmtex-decode-color (get-hex-color s) force-html)) + ((and (== cm "HTML") (nnull? force-html)) + `((!option "HTML") ,(html-color->latex-xcolor s))) + ((== cm "texmacs") + (when (nin? s tmtex-colors) + (set! tmtex-colors (append (list s) tmtex-colors))) + (string-replace s " " "")) + ((in? cm (list "x11names")) + (tmtex-decode-color (get-hex-color s) #t)) + (else + (when (and (nin? cm tmtex-colormaps) + (!= cm "xcolor") (!= cm "none")) + (set! tmtex-colormaps (append (list cm) tmtex-colormaps))) + (string-replace s " " ""))))) + +(define (tmtex-make-color val arg) + (with ltxcolor (tmtex-decode-color val #t) + (if (list? ltxcolor) + `(!group (!append (color ,@ltxcolor) ,arg)) + `(tmcolor ,ltxcolor ,arg)))) + +(define (post-process-math-text t) + (cond ((or (nlist? t) (!= (length t) 2)) t) + ((nin? (car t) '(mathrm mathbf mathsf mathit mathsl mathtt tmop)) t) + ((and (string? (cadr t)) (string-alpha? (cadr t))) t) + ((func? t 'mathrm 1) `(textrm ,(cadr t))) + ((func? t 'mathbf 1) `(textbf ,(cadr t))) + ((func? t 'mathsf 1) `(textsf ,(cadr t))) + ((func? t 'mathit 1) `(textit ,(cadr t))) + ((func? t 'mathsl 1) `(textsl ,(cadr t))) + ((func? t 'mathtt 1) `(texttt ,(cadr t))) + ((func? t 'tmop 1) `(textrm ,(cadr t))) + (else t))) + +(define (tmtex-with-one var val arg) + (if (== var "mode") + (let ((old (tmtex-env-get-previous "mode"))) + (cond ((and (== val "text") (!= old "text")) + (list 'text arg)) + ((and (== val "math") (!= old "math") + (ahash-ref tmtex-env :preamble)) + (list 'ensuremath arg)) + ((and (== val "math") (!= old "math")) + (list '!math arg)) + ((and (== val "prog") (== old "text")) + `(tt ,arg)) + ((and (== val "prog") (== old "math")) + `(text (tt ,arg))) + (else arg))) + (let ((w (tmtex-get-with-cmd var val)) + (a (tmtex-get-assign-cmd var val))) + (cond ((and w (tm-func? arg w 1)) arg) + ((in? w '(mathrm mathbf mathsf mathit mathtt mathsl)) + (post-process-math-text (list w arg))) + (w (list w arg)) + (a (list '!group (tex-concat (list (list a) " " arg)))) + ((== "par-left" var) (tmtex-make-parmod val "0pt" "0pt" arg #t)) + ((== "par-right" var) (tmtex-make-parmod "0pt" val "0pt" arg #t)) + ((== "par-first" var) (tmtex-make-parmod "0pt" "0pt" val arg #f)) + ((== "par-par-sep" var) (tmtex-make-parsep val arg)) + ((== var "language") (tmtex-make-lang val arg)) + ((== var "color") (tmtex-make-color val arg)) + (else arg))))) + +(define (tmtex-with l) + (cond ((null? l) "") + ((null? (cdr l)) (tmtex (car l))) + ((func? (cAr l) 'graphics) (tmtex-eps (cons 'with l))) + (else (let ((var (force-string (car l))) + (val (force-string (cadr l))) + (next (cddr l))) + (tmtex-env-set var val) + (let ((r (tmtex-with-one var val (tmtex-with next)))) + (tmtex-env-reset var) + r))))) + +(define (tmtex-with-wrapped l) + (if (and (== (length l) 3) + (== (car l) "par-columns") + (== (cadr l) "1") + (tm-in? (caddr l) '(small-figure big-figure + small-table big-table))) + (tmtex-float-sub #t "h" (caddr l)) + (tmtex-with l))) + +(define (tmtex-var-name-sub l) + (if (null? l) l + (let ((c (car l)) (r (tmtex-var-name-sub (cdr l)))) + (cond ((char-alphabetic? c) (cons c r)) + ((char-numeric? c) + (cond ((char=? c #\0) (cons* #\z #\e #\r #\o r)) + ((char=? c #\1) (cons* #\o #\n #\e r)) + ((char=? c #\2) (cons* #\t #\w #\o r)) + ((char=? c #\3) (cons* #\t #\h #\r #\e #\e r)) + ((char=? c #\4) (cons* #\f #\o #\u #\r r)) + ((char=? c #\5) (cons* #\f #\i #\v #\e r)) + ((char=? c #\6) (cons* #\s #\i #\x r)) + ((char=? c #\7) (cons* #\s #\e #\v #\e #\n r)) + ((char=? c #\8) (cons* #\e #\i #\g #\h #\t r)) + ((char=? c #\9) (cons* #\n #\i #\n #\e r)) + (else r))) + ((and (char=? c #\*) (null? (cdr l))) (list c)) + (else r))))) + +(define (tmtex-var-name var) + (cond ((nstring? var) "") + ((logic-in? (string->symbol var) tmtex-protected%) + (string-append "tm" var)) + ((<= (string-length var) 1) var) + (else + (with r (list->string (tmtex-var-name-sub (string->list var))) + (if (and (string-occurs? "*" r) + (== (latex-type r) "undefined")) + (string-replace r "*" "star") + r))))) + +(define (tmtex-tex-arg l) + (cons '!arg l)) + +(define (tmtex-args-search x args) + (cond ((null? args) #f) + ((== x (car args)) 1) + (else + (let ((n (tmtex-args-search x (cdr args)))) + (if n (+ 1 n) #f))))) + +(define (tmtex-args-sub l args) + (if (null? l) l + (cons (tmtex-args (car l) args) + (tmtex-args-sub (cdr l) args)))) + +(define (tmtex-args x args) + (cond ((nlist? x) x) + ((or (func? x 'arg) (func? x 'value)) + (let ((n (tmtex-args-search (cadr x) args))) + (if n (list '!arg (number->string n)) (tmtex-args-sub x args)))) + (else (tmtex-args-sub x args)))) + +(define (tmtex-assign l) + (let* ((var (tmtex-var-name (car l))) + (bsvar (string-append "\\" var)) + (type (latex-type var)) + (def (if (== type "undefined") 'newcommand 'providecommand)) + (val (cadr l))) + (while (func? val 'quote 1) (set! val (cadr val))) + (if (!= var "") + (begin + (tmtex-env-assign var val) + (cond ((string? val) + (let ((a (tmtex-get-assign-cmd var val))) + (if a (list a) (list def bsvar (tmtex val))))) + ((or (func? val 'macro) (func? val 'func)) + (if (null? (cddr val)) + (list def bsvar (tmtex (cAr val))) + (list def bsvar + (list '!option (number->string (- (length val) 2))) + (tmtex (tmtex-args (cAr val) (cDdr val)))))) + (else (list def bsvar (tmtex val))))) + ""))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Other primitives +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-quote l) + (tmtex (car l))) + +(define (tmtex-hidden-binding l) + (if (and (== (length l) 2) (string->number (force-string (cAr l)))) + (list 'custombinding (force-string (cAr l))) + "")) + +(define (tmtex-label l) + (list 'label (force-string (car l)))) + +(define (tmtex-reference l) + (list 'ref (force-string (car l)))) + +(define (tmtex-pageref l) + (list 'pageref (force-string (car l)))) + +(define (tmtex-eqref s l) + (list 'eqref (force-string (car l)))) + +(define (tmtex-smart-ref s l) + (let* ((ss (map force-string l)) + (key (string-recompose ss ","))) + (list 'Cref key))) + +(define (tmtex-specific l) + (cond ((== (car l) "latex") (tmtex-tt (cadr l))) + ((== (car l) "image") (tmtex-eps (cadr l))) + ((== (car l) "printer") (tmtex (cadr l))) + ((== (car l) "odd") `(ifthispageodd ,(tmtex (cadr l)) "")) + ((== (car l) "even") `(ifthispageodd "" ,(tmtex (cadr l)))) + (else ""))) + +(define (tmtex-eps-names) + (set! tmtex-serial (+ tmtex-serial 1)) + (let* ((suffix ".pdf") + (postfix (string-append "-" (number->string tmtex-serial) suffix)) + (name-url (url-glue tmtex-image-root-url postfix)) + (name-string (string-append tmtex-image-root-string postfix))) + (values name-url name-string))) + +(define (tmtex-eps x) + (if (tmtex-math-mode?) (set! x `(with "mode" "math" ,x))) + (receive (name-url name-string) (tmtex-eps-names) + (let* ((extents (print-snippet name-url x #t)) + (unit (* (/ 1.0 60984.0) (/ 600.0 (tenth extents)))) + (x3 (* unit (first extents))) + (y3 (* unit (second extents))) + (x4 (* unit (third extents))) + (y4 (* unit (fourth extents))) + (x1 (* unit (fifth extents))) + (y1 (* unit (sixth extents))) + (x2 (* unit (seventh extents))) + (y2 (* unit (eighth extents))) + (lm (string-append (number->string (- x3 x1)) "cm")) + (rm (string-append (number->string (- x2 x4)) "cm")) + (ww (string-append (number->string (- x4 x3)) "cm")) + (hh (string-append (number->string (- y4 y3)) "cm")) + (opt `(!option ,(string-append "width=" ww ",height=" hh))) + (rat (/ y3 (- y4 y3))) + (dy `(!concat ,(number->string rat) (height))) + (rb `(raisebox ,dy (includegraphics ,opt ,name-string)))) + ;; TODO: top and bottom margins + ;;(display* name-url ": " x1 ", " y1 "; " x2 ", " y2 "\n") + ;;(display* name-url ": " x3 ", " y3 "; " x4 ", " y4 "\n") + (if (and (< (abs (- x3 x1)) 0.01) (< (abs (- x2 x4)) 0.01)) rb + `(!concat (hspace ,lm) ,rb (hspace ,rm)))))) + +(define (tmtex-make-eps s l) + (tmtex-eps (cons (string->symbol s) l))) + +(define (tmtex-graphics l) + (tmtex-eps (cons 'graphics l))) + +(define (tmtex-as-eps name) + (let* ((u (url-relative current-save-target (unix->url name))) + (suffix (url-suffix u)) + (fm (string-append (format-from-suffix suffix) "-file"))) + (if (and (url-exists? u) (in? suffix (list "eps" "pdf" "png" "jpg"))) + (with p (url->string "$TEXMACS_PATH") + (set! name (string-replace name "$TEXMACS_PATH" p)) + (set! name (string-replace name "file://" "")) + (list 'includegraphics name)) + (receive (name-url name-string) (tmtex-eps-names) + (when (string-starts? name "..") + (set! u (url-relative current-save-source (unix->url name)))) + (with nfm (if (== (url-suffix name-url) "pdf") "pdf-file" + "postscript-file") + (convert-to-file u fm nfm name-url)) + (list 'includegraphics name-string))))) + +(define (tmtex-image-length len) + (let* ((s (force-string len)) + (unit (and (tm-length? s) (tm-length-unit len)))) + (cond ((== s "") "!") + ((string-ends? s "%") "!") + ((in? unit '("w" "h")) "!") + (else (tmtex-decode-length len))))) + +(define (tmtex-image-mag len) + (let* ((s (force-string len)) + (val (and (tm-length? s) (tm-length-value len))) + (unit (and (tm-length? s) (tm-length-unit len)))) + (cond ((== s "") 0.0) + ((string-ends? s "%") + (with x (string->number (string-drop-right s 1)) + (if x (/ x 100.0) 0))) + ((in? unit '("w" "h")) (or val 0)) + (else #f)))) + +(define (tmtex-image l) + (if (nstring? (car l)) + (tmtex-eps (cons 'image l)) + (let* ((fig (tmtex-as-eps (force-string (car l)))) + (hor (tmtex-image-length (cadr l))) + (ver (tmtex-image-length (caddr l))) + (mhor (tmtex-image-mag (cadr l))) + (mver (tmtex-image-mag (caddr l)))) + (cond ((or (not mhor) (not mver)) (list 'resizebox hor ver fig)) + ((and (== mhor 0.0) (== mver 0.0)) fig) + ((or (== mhor 1.0) (== mver 1.0)) fig) + ((== mhor 0.0) (list 'scalebox (number->string mver) fig)) + (else (list 'scalebox (number->string mhor) fig)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Metadata for documents +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-make-inline t) + (tm-replace t '(new-line) '(next-line))) + +(tm-define (tmtex-inline t) + (tmtex (tmtex-make-inline t))) + +(tm-define (tmtex-doc-title t) + `(title ,(tmtex-inline (cadr t)))) + +(tm-define (tmtex-doc-running-title t) + `(tmrunningtitle ,(tmtex-inline (cadr t)))) + +(tm-define (tmtex-doc-subtitle t) + (set! t (tmtex-remove-line-feeds t)) + `(tmsubtitle ,(tmtex-inline (cadr t)))) + +(tm-define (tmtex-doc-note t) + (set! t (tmtex-remove-line-feeds t)) + `(tmnote ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-misc t) + (set! t (tmtex-remove-line-feeds t)) + `(tmmisc ,(tmtex (cadr t)))) + +(tm-define (tmtex-doc-date t) + `(date ,(tmtex-inline (cadr t)))) + +(tm-define (tmtex-doc-running-author t) + `(tmrunningauthor ,(tmtex-inline (cadr t)))) + +(tm-define (tmtex-author-name t) + `(author ,(tmtex-inline (cadr t)))) + +(tm-define (tmtex-author-affiliation t) + ;;(set! t (tmtex-remove-line-feeds t)) + `(tmaffiliation ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-email t) + (set! t (tmtex-remove-line-feeds t)) + `(tmemail ,(tmtex-inline (cadr t)))) + +(tm-define (tmtex-author-homepage t) + (set! t (tmtex-remove-line-feeds t)) + `(tmhomepage ,(tmtex-inline (cadr t)))) + +(tm-define (tmtex-author-note t) + (set! t (tmtex-remove-line-feeds t)) + `(tmnote ,(tmtex (cadr t)))) + +(tm-define (tmtex-author-misc t) + (set! t (tmtex-remove-line-feeds t)) + `(tmmisc ,(tmtex (cadr t)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Useful macros for metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-select-args-by-func n l) + (filter (lambda (x) (func? x n)) l)) + +(define (tmtex-get-transform l tag) + (let ((transform (symbol-append 'tmtex- tag)) + (l* (tmtex-select-args-by-func tag l))) + (map tmtex l*))) + +(tm-define (tmtex-remove-line-feeds t) + (if (npair? t) t + (with (r s) (list (car t) (map tmtex-remove-line-feeds (cdr t))) + (if (== r 'next-line) '(!concat (tmSep) (!linefeed)) `(,r ,@s))))) + +(tm-define (tmtex-replace-documents t) + (if (npair? t) t + (with (r s) (list (car t) (map tmtex-replace-documents (cdr t))) + (if (!= r 'document) `(,r ,@s) + `(concat ,@(list-intersperse s '(next-line))))))) + +(tm-define (contains-tags? t l) + (cond ((or (nlist? t) (null? t)) #f) + ((in? (car t) l) #t) + (else + (with found? #f + (for-each (lambda (x) + (set! found? (or found? (contains-tags? x l)))) + t) + found?)))) + +(tm-define (contains-stree? t u) + (cond ((== t u) #t) + ((or (null? t) (nlist? t)) #f) + (else + (with found? #f + (for-each (lambda (x) + (set! found? (or found? (contains-stree? x u)))) + t) + found?)))) + +;; Metadata clustering + +(define (stree-replace l what by) + (cond ((or (null? l) (nlist? l)) l) + ((== l what) by) + (else + (map (lambda (x) (stree-replace x what by)) l)))) + +(define (next-stree-occurence l tag) + (cond ((or (null? l) (nlist? l)) #f) + ((== (car l) tag) l) + (else + (with found? #f + (map-in-order + (lambda (x) + (if (not found?) + (set! found? (next-stree-occurence x tag)))) l) + found?)))) + +(define (add-refs l n tag tr tl global-counter?) + (with streetag (next-stree-occurence (car l) tag) + (if (not streetag) + (begin + (if global-counter? (set! tmtex-ref-cnt n)) + l) + (let* ((n* (number->string n)) + (tagref (list tr n*)) + (authors (stree-replace (car l) streetag tagref)) + (taglist (if (null? (cdr l)) '() (cadr l))) + (taglist `(,@taglist (,tl ,n* ,(cadr streetag)))) + (l* (list authors taglist))) + (add-refs l* (1+ n) tag tr tl global-counter?))))) + +(tm-define (make-references l tag author? global-counter?) + (let* ((tag-ref (symbol-append tag '- 'ref)) + (tag-label (symbol-append tag '- 'label)) + (cnt (if global-counter? tmtex-ref-cnt 1)) + (tmp (add-refs `(,l) cnt tag tag-ref tag-label + global-counter?)) + (data-refs (car tmp)) + (data-labels (if (null? (cdr tmp)) '() (cadr tmp)))) + (if author? + (set! data-labels `((doc-author (author-data ,@data-labels))))) + `(,@data-refs ,@data-labels))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Author metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-prepare-author-data l) l) + +(tm-define (tmtex-make-author names affiliations emails urls miscs notes + affs* emails* urls* miscs* notes*) + (let* ((names (tmtex-concat-Sep (map cadr names))) + (result `(,@names ,@notes ,@miscs ,@affiliations ,@emails ,@urls))) + (if (null? result) '() + `(author (!paragraph ,@result))))) + +(tm-define (tmtex-doc-author t) + (if (or (npair? t) (npair? (cdr t)) (not (func? (cadr t) 'author-data))) '() + (let* ((l (tmtex-prepare-author-data (cdadr t))) + (names (tmtex-get-transform l 'author-name)) + (emails (tmtex-get-transform l 'author-email)) + (urls (tmtex-get-transform l 'author-homepage)) + (affs (tmtex-get-transform l 'author-affiliation)) + (miscs (tmtex-get-transform l 'author-misc)) + (notes (tmtex-get-transform l 'author-note)) + (emails* (tmtex-get-transform l 'author-email-ref)) + (urls* (tmtex-get-transform l 'author-homepage-ref)) + (affs* (tmtex-get-transform l 'author-affiliation-ref)) + (miscs* (tmtex-get-transform l 'author-misc-ref)) + (notes* (tmtex-get-transform l 'author-note-ref)) + (affs (append affs (tmtex-get-transform + l 'author-affiliation-label))) + (urls (append urls (tmtex-get-transform + l 'author-homepage-label))) + (miscs (append miscs (tmtex-get-transform + l 'author-misc-label))) + (notes (append notes (tmtex-get-transform + l 'author-note-label))) + (emails (append emails (tmtex-get-transform + l 'author-email-label)))) + (tmtex-make-author names affs emails urls miscs notes + affs* emails* urls* miscs* notes*)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Document metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-prepare-doc-data l) + (set! l (map tmtex-replace-documents l)) + l) + +(define (tmtex-make-title titles subtitles notes miscs tr) + (let* ((titles (tmtex-concat-Sep (map cadr titles))) + (content `(,@titles ,@subtitles ,@notes ,@miscs))) + (if (null? content) '() + `((title (!indent (!paragraph ,@content))))))) + +(tm-define (tmtex-append-authors l) + (set! l (filter nnull? l)) + (cond ((null? l) '()) + ((== (length l) 1) `((author (!indent (!concat ,@(cdar l)))))) + (else + (with lf '(!concat (!linefeed) (and) (!linefeed)) + `((author + (!indent (!concat ,@(list-intersperse (map cadr l) lf))))))))) + +(tm-define (tmtex-make-doc-data titles subtitles authors dates miscs notes + subtits-l dates-l miscs-l notes-l tr ar) + `(!document + ,@(tmtex-make-title titles subtitles notes miscs tr) + ,@(tmtex-append-authors authors) + ,@dates + (maketitle))) + +(tm-define (tmtex-get-title-option l) + (apply append (map cdr (tmtex-select-args-by-func 'doc-title-options l)))) + +(tm-define (tmtex-doc-data s l) + (set! l (tmtex-prepare-doc-data l)) + (let* ((titles (tmtex-get-transform l 'doc-title)) + (tr (tmtex-get-transform l 'doc-running-title)) + (subtits (tmtex-get-transform l 'doc-subtitle)) + (authors (tmtex-get-transform l 'doc-author)) + (ar (tmtex-get-transform l 'doc-running-author)) + (dates (tmtex-get-transform l 'doc-date)) + (miscs (tmtex-get-transform l 'doc-misc)) + (notes (tmtex-get-transform l 'doc-note)) + (subtits-l (tmtex-get-transform l 'doc-subtitle-label)) + (dates-l (tmtex-get-transform l 'doc-date-label)) + (miscs-l (tmtex-get-transform l 'doc-misc-label)) + (notes-l (tmtex-get-transform l 'doc-note-label)) + (subtits (append subtits (tmtex-get-transform l 'doc-subtitle-ref))) + (dates (append dates (tmtex-get-transform l 'doc-date-ref))) + (miscs (append miscs (tmtex-get-transform l 'doc-misc-ref))) + (notes (append notes (tmtex-get-transform l 'doc-note-ref)))) + (tmtex-make-doc-data titles subtits authors dates miscs notes + subtits-l dates-l miscs-l notes-l tr ar))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Abstract metadata presentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (tmtex-abstract t) + (tmtex-std-env "abstract" (cdr t))) + +(tm-define (tmtex-abstract-keywords t) + (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmkeywords) ,@(map (lambda (x) `(!group ,x)) args)))) + +(tm-define (tmtex-abstract-acm t) + (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmacm) ,@(map (lambda (x) `(!group ,x)) args)))) + +(tm-define (tmtex-abstract-arxiv t) + (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmarxiv) ,@(map (lambda (x) `(!group ,x)) args)))) + +(tm-define (tmtex-abstract-msc t) + (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmmsc) ,@(map (lambda (x) `(!group ,x)) args)))) + +(tm-define (tmtex-abstract-pacs t) + (with args (list-intersperse (map tmtex (cdr t)) '(tmsep)) + `(!concat (tmpacs) ,@(map (lambda (x) `(!group ,x)) args)))) + +(tm-define (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract) + (with result `(,@abstract ,@acm ,@arxiv ,@msc ,@pacs ,@keywords) + (if (null? result) "" `(!document ,@result)))) + +(tm-define (tmtex-abstract-data s l) + (let* ((acm (map tmtex-abstract-acm + (tmtex-select-args-by-func 'abstract-acm l))) + (arxiv (map tmtex-abstract-arxiv + (tmtex-select-args-by-func 'abstract-arxiv l))) + (msc (map tmtex-abstract-msc + (tmtex-select-args-by-func 'abstract-msc l))) + (pacs (map tmtex-abstract-pacs + (tmtex-select-args-by-func 'abstract-pacs l))) + (keywords (map tmtex-abstract-keywords + (tmtex-select-args-by-func 'abstract-keywords l))) + (abstract (map tmtex-abstract + (tmtex-select-args-by-func 'abstract l)))) + (tmtex-make-abstract-data keywords acm arxiv msc pacs abstract))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; TeXmacs style primitives +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-std-env s l) + (if (== s "quote-env") (set! s "quote")) + (list (list '!begin s) (tmtex (car l)))) + +(define (tmtex-footnote s l) + `(footnote ,(tmtex (car l)))) + +(define (tmtex-footnotemark s l) + `(footnotemark (!option ,(tmtex (car l))))) + +(define (filter-enunciation-due-to l) + (cond ((func? l 'dueto) (list l)) + ((nlist>0? l) '()) + (else (append-map filter-enunciation-due-to l)))) + +(define (filter-enunciation-body l) + (cond ((func? l 'dueto) '()) + ((nlist>0? l) l) + (else (filter nnull? (map filter-enunciation-body l))))) + +(define (tmtex-enunciation s l) + (let* ((t (car l)) + (option (filter-enunciation-due-to t)) + (option* (map (lambda (x) `(!option ,(tmtex (cadr x)))) option)) + (body (filter-enunciation-body t))) + `((!begin ,s ,@option*) ,(tmtex body)))) + +(define (find-label x) + (cond ((npair? x) #f) + ((func? x 'label) x) + (else (or (find-label (car x)) (find-label (cdr x)))))) + +(define (remove-labels x) + (cond ((npair? x) x) + ((func? x 'label) "") + (else (cons (remove-labels (car x)) (remove-labels (cdr x)))))) + +(define (tmtex-sectional s l) + (let* ((lab (find-label (car l))) + (tit (if lab (remove-labels (car l)) (car l))) + (sec (list (string->symbol s) (tmtex tit)))) + (if lab (list '!concat sec lab) sec))) + +(define (tmtex-appendix s l) + (with app (list (if (latex-book-style?) 'chapter 'section) (tmtex (car l))) + (if tmtex-appendices? app + (begin + (set! tmtex-appendices? #t) + (list '!concat '(appendix) app))))) + +(define (tmtex-appendix* s l) + (with app (list (if (latex-book-style?) 'chapter* 'section*) (tmtex (car l))) + (if tmtex-appendices? app + (begin + (set! tmtex-appendices? #t) + (list '!concat '(appendix) app))))) + +(define (tmtex-tt-document l) + (cond ((null? l) "") + ((null? (cdr l)) (tmtex-tt (car l))) + (else (string-append (tmtex-tt (car l)) "\n" + (tmtex-tt-document (cdr l)))))) + +(define (tmtex-tt x) + (cond ((string? x) (tmtex-verb-string x)) + ((== x '(next-line)) "\n") + ((func? x 'document) (tmtex-tt-document (cdr x))) + ((func? x 'para) (tmtex-tt-document (cdr x))) + ((func? x 'concat) + (apply string-append (map-in-order tmtex-tt (cdr x)))) + ((func? x 'mtm 2) (tmtex-tt (cAr x))) + ((func? x 'surround 3) + (string-append (tmtex-tt (cadr x)) + (tmtex-tt (cadddr x)) + (tmtex-tt (caddr x)))) + ((or (func? x 'hgroup 1) (func? x 'vgroup 1)) + (tmtex-tt (cadr x))) + ((func? x 'with) + (begin + (display* "TeXmacs] lost in verbatim content: " (cDr x) "\n") + (tmtex-tt (cAr x)))) + ((func? x 'math) + (begin + (display* "TeXmacs] lost in verbatim content: " (cDr x) "\n") + (tmtex-tt (cAr x)))) + (else + (begin + (display* "TeXmacs] non converted verbatim content: " x "\n") + "")))) + +(define (unescape-angles l) + (cond ((string? l) + (string-replace (string-replace l "" "<") "" ">")) + ((symbol? l) l) + (else (map unescape-angles l)))) + +(define (escape-braces l) + (cond ((string? l) (string-replace (string-replace l "{" "\\{") "}" "\\}")) + ((symbol? l) l) + (else (map escape-braces l)))) + +(define (escape-backslashes l) + (cond ((string? l) (string-replace l "\\" "\\textbackslash ")) + ((symbol? l) l) + (else (map escape-backslashes l)))) + +(define (tmtex-new-theorem s l) + (with var (tmtex-var-name (car l)) + (ahash-set! tmtex-dynamic (string->symbol (car l)) 'environment) + (ahash-set! tmtex-dynamic (string->symbol var) 'environment) + (if (and (logic-in? var latex-texmacs-theorem-environment%)) "" + `(newtheorem ,var (,@(cdr l)))))) + +(define (tmtex-verbatim s l) + (if (func? (car l) 'document) + (list '!verbatim (tmtex-tt (escape-braces (escape-backslashes (car l))))) + (list 'tmverbatim (tmtex (car l))))) + +(define (sharp-fix t) + (cond ((and (func? t '!document) (nnull? (cdr t))) + `(!document ,(sharp-fix (cadr t)) ,@(cddr t))) + ((and (func? t '!concat) (nnull? (cdr t))) + `(!concat ,(sharp-fix (cadr t)) ,@(cddr t))) + ((and (string? t) (string-starts? t "#")) + (string-append "\\" t)) + (else t))) + +(define (tmtex-verbatim* s l) + (if (func? (car l) 'document) + (list '!verbatim* (sharp-fix (tmtex-tt (car l)))) + (list 'tmverbatim (tmtex (car l))))) + +(define (tmtex-code-inline s l) + (with lang `((!option ,s)) + `(tmcodeinline ,@lang ,(tmtex (car l))))) + +(define (tmtex-code-block s l) + (set! l (escape-backslashes l)) + (set! l (escape-braces l)) + (set! s (car (string-decompose s "-"))) + (with lang (if (or (== s "verbatim") (== s "code")) '() `((!option ,s))) + `((!begin* "tmcode" ,@lang) ,(tmtex-verbatim* "" l)))) + +(define (tmtex-add-preview-packages x) + (cond ((list? x) (for-each tmtex-add-preview-packages x)) + ((nstring? x) (noop)) + ((string-occurs? "tikzpicture" x) (latex-add-extra "tikz")))) + +(define (tmtex-mixed s l) + (if (func? (cadr l) 'text) (set! l `("" ,(cadadr l)))) + ;; (set! l (unescape-angles l)) + ;; NOTE: instead, we now unescape in tmtex-verb-string + (tmtex-env-set "mode" "text") + (with src (list '!verbatim* (tmtex-tt (cadr l))) + (tmtex-add-preview-packages src) + (tmtex-env-reset "mode") + (list '!unindent src))) + +(define (tmtex-listing s l) + (list (list '!begin "tmlisting") (tmtex (car l)))) + ;;(list (list '!begin "linenumbers") (tmtex (car l)))) + +(define (tmtex-minipage s l) + (let* + ((pos (car l)) + (opt (if (== pos "f") '() `((!option ,pos)))) + (size (cadr l)) + (body (caddr l))) + `((!begin "minipage" ,@opt ,(tmtex-decode-length size)) ,(tmtex body)))) + +(define (tmtex-number-renderer l) + (let ((r (cond ((string? l) l) + ((list? l) (tmtex-number-renderer (car l))) + (else "")))) + (cond + ((== r "alpha") "alph") + ((== r "Alpha") "Alph") + (else r)))) + +(define (tmtex-number-counter l) + (cond ((func? l 'value) (tmtex-number-counter (cdr l))) + ((and (list? l) (== 1 (length l))) (tmtex-number-counter (car l))) + ((symbol? l) (tmtex-number-counter (symbol->string l))) + ((string? l) (if (string-ends? l "-nr") (string-drop-right l 3) l)) + (else ""))) + +(define (tmtex-number l) + (tmtex-default + (tmtex-number-renderer (cdr l)) + (list (tmtex-number-counter (car l))))) + +(define (tmtex-change-case l) + (cond + ((== (cadr l) "UPCASE") (tex-apply 'MakeUppercase (tmtex (car l)))) + ((== (cadr l) "locase") (tex-apply 'MakeLowercase (tmtex (car l)))) + (else (tmtex (car l))))) + +(define (tmtex-frame s l) + `(fbox ,(car l))) + +(define (tmtex-colored-frame s l) + `(colorbox ,(tmtex-decode-color (car l)) ,(tmtex (cadr l)))) + +(define (tmtex-fcolorbox s l) + `(fcolorbox ,@(map tmtex-decode-color (cDr l)) ,(tmtex (cAr l)))) + +(define (tmtex-rotate s l) + (let* ((body (tmtex (cadr l))) + (body* (if (tmtex-math-mode?) `(ensuremath ,body) body))) + `(rotatebox (!option "origin=c") ,(tmtex (car l)) ,body*))) + +(define (tmtex-translate s l) + (let ((from (cadr l)) + (to (caddr l)) + (body (car l))) + (tmtex (translate-from-to body from to)))) + +(define (tmtex-localize s l) + (with lan (if (list>0? tmtex-languages) (cAr tmtex-languages) "english") + (tmtex `(translate ,(car l) "english" ,lan)))) + +(define (tmtex-render-key s l) + (with body (tmtex (car l)) + (if (func? body '!concat) + (set! body `(!append ,@(cdr body)))) + `(key ,body))) + +(define (tmtex-key s l) + (tmtex (tm->stree (tmdoc-key (car l))))) + +(define (tmtex-key* s l) + (tmtex (tm->stree (tmdoc-key* (car l))))) + +(define (tmtex-padded-center s l) + (list (list '!begin "center") (tmtex (car l)))) + +(define (tmtex-padded-left-aligned s l) + (list (list '!begin "flushleft") (tmtex (car l)))) + +(define (tmtex-padded-right-aligned s l) + (list (list '!begin "flushright") (tmtex (car l)))) + +(define (tmtex-compact s l) + (list (list '!begin "tmcompact") (tmtex (car l)))) + +(define (tmtex-compressed s l) + (list (list '!begin "tmcompressed") (tmtex (car l)))) + +(define (tmtex-amplified s l) + (list (list '!begin "tmamplified") (tmtex (car l)))) + +(define (tmtex-indent s l) + (list (list '!begin "tmindent") (tmtex (car l)))) + +(define (tmtex-jump-in s l) + (list (list '!begin "tmjumpin") (tmtex (car l)))) + +(define (tmtex-script-inout s l) + (let ((name (string->symbol (string-append "tm" (string-replace s "-" "")))) + (lang (car l)) + (lang* (session-name (car l))) + (in (tmtex (caddr l))) + (out (tmtex (cadddr l)))) + `(,name ,lang ,lang* ,in ,out))) + +(define (tmtex-converter s l) + (let ((name (string->symbol (string-append "tm" (string-replace s "-" "")))) + (lang (car l)) + (lang* (format-get-name (car l))) + (in (tmtex (cadr l))) + (out (tmtex (caddr l)))) + `(,name ,lang ,lang* ,in ,out))) + +(define (tmtex-list-env s l) + (let* ((r (string-replace s "-" "")) + (t (cond ((== r "enumerateRoman") "enumerateromancap") + ((== r "enumerateAlpha") "enumeratealphacap") + (else r)))) + (list (list '!begin t) (tmtex (car l))))) + +(define (tmtex-tiny s l) + (tex-apply 'tiny (tmtex (car l)))) + +(define (tmtex-scriptsize s l) + (tex-apply 'scriptsize (tmtex (car l)))) + +(define (tmtex-footnotesize s l) + (tex-apply 'footnotesize (tmtex (car l)))) + +(define (tmtex-small s l) + (tex-apply 'small (tmtex (car l)))) + +(define (tmtex-normalsize s l) + (tex-apply 'normalsize (tmtex (car l)))) + +(define (tmtex-large s l) + (tex-apply 'large (tmtex (car l)))) + +(define (tmtex-Large s l) + (tex-apply 'Large (tmtex (car l)))) + +(define (tmtex-LARGE s l) + (tex-apply 'LARGE (tmtex (car l)))) + +(define (tmtex-Huge s l) + (list 'Huge (tmtex (car l)))) + +(define (tmtex-specific-language s l) + (tmtex `(with "language" ,s ,(car l)))) + +(tm-define (tmtex-equation s l) + (tmtex-env-set "mode" "math") + (let ((r (tmtex (car l)))) + (tmtex-env-reset "mode") + (if (== s "equation") + (list (list '!begin s) r) + (list '!eqn r)))) + +(define (tmtex-eqnarray s l) + (tmtex-env-set "mode" "math") + (let ((r (tmtex-table-apply (string->symbol s) '() (car l)))) + (tmtex-env-reset "mode") + r)) + +(define (tmtex-math s l) + (cond ((tm-in? (car l) '(equation equation* eqnarray eqnarray*)) + (tmtex (car l))) + ((not (tm-func? (car l) 'document)) + (tmtex `(with "mode" "math" ,(car l)))) + ((tm-func? (car l) 'document 1) + (tmtex `(math ,(cadr (car l))))) + (else + (with ps (map (lambda (x) `(math ,x)) (cdar l)) + (tmtex `(document ,@ps)))))) + +(define (tmtex-textual x) + (tmtex-env-set "mode" "text") + (with r (tmtex x) + (tmtex-env-reset "mode") + r)) + +(define (tmtex-text s l) + (list 'text (tmtex-textual (car l)))) + +(define (tmtex-math-up s l) + (post-process-math-text (list 'mathrm (tmtex-textual (car l))))) + +(define (tmtex-math-ss s l) + (post-process-math-text (list 'mathsf (tmtex-textual (car l))))) + +(define (tmtex-math-tt s l) + (post-process-math-text (list 'mathtt (tmtex-textual (car l))))) + +(define (tmtex-math-bf s l) + (post-process-math-text (list 'mathbf (tmtex-textual (car l))))) + +(define (tmtex-math-sl s l) + (post-process-math-text (list 'mathsl (tmtex-textual (car l))))) + +(define (tmtex-math-it s l) + (post-process-math-text (list 'mathit (tmtex-textual (car l))))) + +(define (tmtex-mathord s l) + (list 'mathord (tmtex (car l)))) + +(define (tmtex-mathbin s l) + (list 'mathbin (tmtex (car l)))) + +(define (tmtex-mathrel s l) + (list 'mathrel (tmtex (car l)))) + +(define (tmtex-mathopen s l) + (list 'mathopen (tmtex (car l)))) + +(define (tmtex-mathclose s l) + (list 'mathclose (tmtex (car l)))) + +(define (tmtex-mathpunct s l) + (list 'mathpunct (tmtex (car l)))) + +(define (tmtex-mathop s l) + (list 'mathop (tmtex (car l)))) + +(define (tmtex-syntax l) + (tmtex (car l))) + +(define (tmtex-theindex s l) + (list 'printindex)) + +(define (tmtex-toc s l) + (tex-apply 'tableofcontents)) + +(define (tmtex-bib-sub doc) + (cond ((nlist? doc) doc) + ((match? doc '(concat (bibitem* :%1) (label :string?) :*)) + (let* ((l (cadr (caddr doc))) + (s (if (string-starts? l "bib-") (string-drop l 4) l))) + (cons* 'concat (list 'bibitem* (cadadr doc) s) (cdddr doc)))) + ((func? doc 'bib-list 2) (tmtex-bib-sub (cAr doc))) + (else (map tmtex-bib-sub doc)))) + +(define (tmtex-bib-max l) + (cond ((npair? l) "") + ((match? l '(bibitem* :string? :%1)) (cadr l)) + (else (let* ((s1 (tmtex-bib-max (car l))) + (s2 (tmtex-bib-max (cdr l)))) + (if (< (string-length s1) (string-length s2)) s2 s1))))) + +(tm-define (tmtex-biblio s l titled?) + (if tmtex-indirect-bib? + (tex-concat (list (list 'bibliographystyle (force-string (cadr l))) + (list 'bibliography (force-string (caddr l))))) + (let* ((doc (tmtex-bib-sub (cadddr l))) + (max (tmtex-textual (tmtex-bib-max doc))) + (tls tmtex-languages) + (lan (or (and (pair? tls) (car tls)) "english")) + (txt (translate-from-to "References" "english" lan)) + (bib (tmtex (list 'thebibliography max doc)))) + (if titled? + `(!document (section* ,(tmtex txt)) ,bib) + bib)))) + +(tm-define (tmtex-bib t) + (tmtex-biblio (car t) (cdr t) #f)) + +(define (tmtex-thebibliography s l) + (list (list '!begin s (car l)) (tmtex (cadr l)))) + +(define (tmtex-bibitem*-std s l) + (cond ((= (length l) 1) + `(bibitem ,(car l))) + ((= (length l) 2) + `(bibitem (!option ,(tmtex (car l))) ,(cadr l))) + (else + (begin + (display* "TeXmacs] non converted bibitem content: " + (list s l) "\n") + "")))) + +(tm-define (tmtex-bibitem* s l) + (tmtex-bibitem*-std s l)) + +(define (split-year s pos) + (if (and (> pos 0) + (string>=? (substring s (- pos 1) pos) "0") + (string<=? (substring s (- pos 1) pos) "9")) + (split-year s (- pos 1)) + pos)) + +(define (natbibify s) + (let* ((pos (split-year s (string-length s))) + (auth (substring s 0 pos)) + (year (substring s pos (string-length s)))) + (when (== (string-length year) 2) + (set! year (string-append (if (string>=? year "30") "19" "20") year))) + (string-append auth "(" year ")"))) + +(tm-define (tmtex-bibitem* s l) + (:mode natbib-package?) + (if (and (== (length l) 2) + (string? (cadr l)) + (not (string-occurs? "(" (cadr l)))) + (tmtex-bibitem*-std s (list (natbibify (cadr l)) (cadr l))) + (tmtex-bibitem*-std s l))) + +(define (tmtex-figure s l) + (tmtex-float-sub #f "h" (cons (string->symbol s) l))) + +(define (tmtex-item s l) + (tex-concat (list (list 'item) " "))) + +(define (tmtex-item-arg s l) + (tex-concat (list (list 'item (list '!option (tmtex (car l)))) " "))) + +(define (tmtex-render-proof s l) + (list (list '!begin "proof*" (tmtex (car l))) (tmtex (cadr l)))) + +(define (tmtex-nbsp s l) + '(!nbsp)) + +(define (tmtex-nbhyph s l) + '(!nbhyph)) + +(define (tmtex-frac* s l) + (tex-concat (list (tmtex (car l)) "/" (tmtex (cadr l))))) + +(define (tmtex-ornament-shape s) + (if (== s "rounded") "1.7ex" "0pt")) + +(define (assign-ornament-env l) + (let* ((keys* (car l)) + (val (cadr l)) + (keys (cDr keys*)) + (fun (cAr keys*))) + (apply string-append + (list-intersperse + (map (lambda (key) + (with arg (fun val) + (if (nstring? arg) "" + (string-append key "=" arg)))) keys) ",")))) + +(define (get-ornament-env) + (let* ((l1 (ahash-set->list tmtex-env)) + (l21 (map (cut logic-ref tex-ornament-opts% <>) l1)) + (l22 (map (cut tmtex-env-get <>) l1)) + (l3 (map (lambda (x y) (if (and x y) (list x y) '())) l21 l22)) + (l4 (filter nnull? l3)) + (l5 (map assign-ornament-env l4))) + (apply string-append (list-intersperse l5 ",")))) + +(define (tmtex-ornamented s l) + (let* ((env (string-append "tm" s)) + (option (get-ornament-env)) + (option* (if (!= option "") `((!option ,option)) '()))) + `((!begin ,env ,@option*) ,(tmtex (car l))))) + +(logic-table tex-ornament-opts% + ("padding-above" ("skipabove" ,tmtex-decode-length)) + ("padding-below" ("skipbelow" ,tmtex-decode-length)) + ("overlined-sep" ("innertopmargin" ,tmtex-decode-length)) + ("underlined-sep" ("innerbottommargin" ,tmtex-decode-length)) + ("framed-hsep" ("innerleftmargin" "innerrightmargin" + ,tmtex-decode-length)) + ("framed-vsep" ("innertopmargin" "innerbottommargin" + ,tmtex-decode-length)) + ("ornament-vpadding" ("innertopmargin" "innerbottommargin" + ,tmtex-decode-length)) + ("ornament-hpadding" ("innerleftmargin" "innerrightmargin" + ,tmtex-decode-length)) + ("ornament-color" ("backgroundcolor" ,tmtex-decode-color)) + ("ornament-shape" ("roundcorner" ,tmtex-ornament-shape))) + +(define (tmtex-tm s l) + (with tag (string->symbol (string-append "tm" (string-replace s "-" ""))) + `(,tag ,@(map tmtex l)))) + +(define (tmtex-input-math s l) + (let ((tag (string->symbol (string-append "tm" (string-replace s "-" "")))) + (a1 (tmtex (car l))) + (a2 (with r (begin + (tmtex-env-set "mode" "math") + (tmtex (cadr l))) + (tmtex-env-reset "mode") r))) + (list tag a1 a2))) + +(define (tmtex-fold-io-math s l) + (let ((tag (string->symbol (string-append "tm" (string-replace s "-" "")))) + (a1 (tmtex (car l))) + (a2 (with r (begin + (tmtex-env-set "mode" "math") + (tmtex (cadr l))) + (tmtex-env-reset "mode") r)) + (a3 (tmtex (caddr l)))) + (list tag a1 a2 a3))) + +(define (tmtex-session s l) + (let* ((tag (string->symbol (string-append "tm" (string-replace s "-" "")))) + (arg (tmtex (car l))) + (lan (tmtex (cadr l))) + (lst (tmtex (caddr l)))) + (if (func? lst '!document) + (set! lst `(!indent (!paragraph ,@(cdr lst))))) + `(!document (,tag ,arg ,lan ,lst)))) + +(define (escape-hyperref-url l) + (cond ((string? l) + (let* ((r1 (string-replace l "\\" "\\\\")) + (r2 (string-replace r1 "#" "\\#")) + (r3 (string-replace r2 "_" "\\_"))) + r3)) + ((symbol? l) l) + (else (map escape-hyperref-url l)))) + +(define (tmtex-hyperref u) + (tmtex-tt (escape-hyperref-url u))) + +(define (tmtex-hlink s l) + (let* ((h (cadr l)) + (d (tmtex (car l)))) + (if (and (string? h) (string-starts? h "#")) + (list 'hyperref `(!option ,(string-drop h 1)) d) + (list 'href (tmtex-hyperref h) d)))) + +(define (tmtex-href s l) + (list 'url (tmtex-verb-string (car l)))) + +(define (tmtex-action s l) + (list 'tmaction (tmtex (car l)) (tmtex (cadr l)))) + +(define (tmtex-choose s l) + (list 'binom (tmtex (car l)) (tmtex (cadr l)))) + +(define (tmtex-text-tt s l) + (if (tmtex-math-mode?) + (tmtex-math-tt s l) + (tmtex-modifier s l))) + +(define (tmtex-modifier s l) + (tex-apply (string->symbol (string-append "tm" s)) (tmtex (car l)))) + +(define (tmtex-render-line-number s l) + (list 'tmlinenumber (tmtex (car l)) (tmtex-decode-length (tmtex (cadr l))))) + +(define (tmtex-menu-one x) + (tmtex (list 'samp x))) + +(define (tmtex-menu-list l) + (if (null? l) l + (cons* (list '!math (list 'rightarrow)) + (tmtex-menu-one (car l)) + (tmtex-menu-list (cdr l))))) + +(define (tmtex-menu s l) + (tex-concat (cons (tmtex-menu-one (car l)) (tmtex-menu-list (cdr l))))) + +(define ((tmtex-rename into) s l) + (tmtex-apply into (tmtex-list l))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Citations +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-cite-list l) + (cond ((null? l) "") + ((nstring? (car l)) + (display* "TeXmacs] non converted citation: " (car l) "\n") + (tmtex-cite-list (cdr l))) + ((null? (cdr l)) (car l)) + (else (string-append (car l) "," (tmtex-cite-list (cdr l)))))) + +(tm-define (tmtex-cite s l) + (tex-apply 'cite (tmtex-cite-list l))) + +(tm-define (tmtex-cite s l) + (:mode natbib-package?) + (tex-apply 'citep (tmtex-cite-list l))) + +(define (tmtex-nocite s l) + (tex-apply 'nocite (tmtex-cite-list l))) + +(define (tmtex-cite-TeXmacs s l) + (tex-apply 'citetexmacs (tmtex-cite-list l))) + +(tm-define (tmtex-cite-detail s l) + (with c (tmtex-cite-list (list (car l))) + (tex-apply 'cite `(!option ,(tmtex (cadr l))) c))) + +(tm-define (tmtex-cite-detail s l) + (:mode natbib-package?) + (with c (tmtex-cite-list (list (car l))) + (tex-apply 'citetext `(!concat (citealp ,c) ", " ,(tmtex (cadr l)))))) + +(tm-define (tmtex-cite-detail-poor s l) + (with c (tmtex-cite-list (list (car l))) + `(!concat ,(tex-apply 'cite c) " (" ,(tmtex (cadr l)) ")"))) + +(define (tmtex-cite-detail-hook s l) + (tmtex-cite-detail s l)) + +(define (tmtex-cite-raw s l) + (tex-apply 'citealp (tmtex-cite-list l))) + +(define (tmtex-cite-raw* s l) + (tex-apply 'citealp* (tmtex-cite-list l))) + +(define (tmtex-cite-textual s l) + (tex-apply 'citet (tmtex-cite-list l))) + +(define (tmtex-cite-textual* s l) + (tex-apply 'citet* (tmtex-cite-list l))) + +(define (tmtex-cite-parenthesized s l) + (tex-apply 'citep (tmtex-cite-list l))) + +(define (tmtex-cite-parenthesized* s l) + (tex-apply 'citep* (tmtex-cite-list l))) + +(define (tmtex-render-cite s l) + (tex-apply 'citetext (tmtex (car l)))) + +(define (tmtex-cite-author s l) + (tex-apply 'citeauthor (tmtex (car l)))) + +(define (tmtex-cite-author* s l) + (tex-apply 'citeauthor* (tmtex (car l)))) + +(define (tmtex-cite-year s l) + (tex-apply 'citeyear (tmtex (car l)))) + +(define (tmtex-natbib-triple s l) + `(protect (citeauthoryear ,@(map tmtex l)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Glossaries +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-glossary s l) + (with nr (+ tmtex-auto-produce 1) + (set! tmtex-auto-produce nr) + `(label ,(string-append "autolab" (number->string nr))))) + +(define (tmtex-glossary-entry s l) + (with nr (+ tmtex-auto-consume 1) + (with lab (string-append "autolab" (number->string nr)) + (set! tmtex-auto-consume nr) + `(glossaryentry ,(tmtex (car l)) ,(tmtex (cadr l)) (pageref ,lab))))) + +(define (tmtex-glossary-line t) + (with r (tmtex t) + (if (func? r 'glossaryentry) r + `(listpart ,r)))) + +(define (tmtex-glossary-body b) + (if (not (tm-func? b 'document)) + (tmtex b) + (cons '!document (map-in-order tmtex-glossary-line (cdr b))))) + +(define (tmtex-the-glossary s l) + `(!document + (,(if (latex-book-style?) 'chapter* 'section*) "Glossary") + ((!begin "theglossary" ,(car l)) ,(tmtex-glossary-body (cadr l))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The main conversion routines +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-apply key args) + (let ((n (length args)) + (r (or (ahash-ref tmtex-dynamic key) (logic-ref tmtex-methods% key)))) + (if (in? key '(quote quasiquote unquote)) (set! r tmtex-noop)) + (cond ((== r 'environment) + (tmtex-std-env (symbol->string key) args)) + (r (r args)) + (else + (let ((p (logic-ref tmtex-tmstyle% key))) + (cond ((and p (or (= (cadr p) -1) (= (cadr p) n))) + ((car p) (symbol->string key) args)) + ((and p (= (cadr p) -2)) ((car p) `(,key ,@args))) + ((and (= n 1) + (or (func? (car args) 'tformat) + (func? (car args) 'table))) + (tmtex-table-apply key '() (car args))) + ((and (= n 2) + (or (func? (cAr args) 'tformat) + (func? (cAr args) 'table))) + (tmtex-table-apply key (cDr args) (cAr args))) + (else (tmtex-function key args)))))))) + +(define (tmtex-function f l) + (if (== (string-ref (symbol->string f) 0) #\!) + (cons f (map-in-order tmtex l)) + (let ((v (tmtex-var-name (symbol->string f)))) + (if (== v "") "" + (apply tex-apply + (cons (string->symbol v) + (map-in-order tmtex l))))))) + +(define (tmtex-compound l) + (if (string? (car l)) + (tmtex-apply (string->symbol (car l)) (cdr l)) + "")) + +(define (tmtex-list l) + (map-in-order tmtex l)) + +(tm-define (tmtex x) + (cond ((string? x) (tmtex-string x)) + ((list>0? x) (tmtex-apply (car x) (cdr x))) + (else ""))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dispatching +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-dispatcher tmtex-primitives% + ((:or unknown uninit error raw-data) tmtex-error) + (document tmtex-document) + (para tmtex-para) + (surround tmtex-surround) + (concat tmtex-concat) + (rigid tmtex-rigid) + (hgroup tmtex-rigid) + (vgroup tmtex-id) + (hidden tmtex-noop) + (hspace tmtex-hspace) + (vspace* tmtex-noop) + (vspace tmtex-vspace) + (space tmtex-space) + (htab tmtex-htab) + (move tmtex-first) + (shift tmtex-first) + (resize tmtex-first) + (clipped tmtex-first) + (repeat tmtex-noop) + (float tmtex-float) + (datoms tmtex-second) + ((:or dlines dpages dbox) tmtex-noop) + (line-note tmtex-line-note) + + (with-limits tmtex-noop) + (line-break tmtex-line-break) + (new-line tmtex-new-line) + (next-line tmtex-next-line) + (emdash tmtex-emdash) + (no-break tmtex-no-break) + (no-indent tmtex-no-first-indentation) + (yes-indent tmtex-noop) + (no-indent* tmtex-noop) + (yes-indent* tmtex-noop) + (page-break* tmtex-noop) + (page-break tmtex-page-break) + (no-page-break* tmtex-noop) + (no-page-break tmtex-no-page-break) + (no-break-here* tmtex-noop) + (no-break-here tmtex-no-page-break) + (no-break-start tmtex-no-page-break) + (no-break-end tmtex-noop) + (new-page* tmtex-noop) + (new-page tmtex-new-page) + (new-dpage* tmtex-noop) + (new-dpage tmtex-noop) + + (around tmtex-around) + (around* tmtex-around*) + (big-around tmtex-big-around) + (left tmtex-left) + (mid tmtex-mid) + (right tmtex-right) + (big tmtex-big) + (long-arrow tmtex-long-arrow) + (lprime tmtex-lsup) + (rprime tmtex-rsup) + (below tmtex-below) + (above tmtex-above) + (lsub tmtex-lsub) + (lsup tmtex-lsup) + (rsub tmtex-rsub) + (rsup tmtex-rsup) + (modulo tmtex-modulo) + (frac tmtex-frac) + (sqrt tmtex-sqrt) + (wide tmtex-wide) + (neg tmtex-neg) + (wide* tmtex-wide-star) + ;;(tree tmtex-tree) + (tree tmtex-tree-eps) + + (tformat tmtex-tformat) + ((:or twith cwith tmarker) tmtex-noop) + (table tmtex-table) + ((:or row cell subtable) tmtex-noop) + + (assign tmtex-assign) + (with tmtex-with-wrapped) + (provides tmtex-noop) + (value tmtex-compound) + (quote-value tmtex-noop) + ((:or quote-value drd-props arg quote-arg) tmtex-noop) + (compound tmtex-compound) + ((:or xmacro get-label get-arity map-args eval-args mark eval) tmtex-noop) + ;; quote missing + (quasi tmtex-noop) + ;; quasiquote missing + ;; unquote missing + ((:or unquote* copy + if if* case while for-each + extern include use-package) tmtex-noop) + (syntax tmtex-syntax) + + ((:or or xor and not plus minus times over div mod + merge length range find-file + is-tuple look-up + equal unequal less lesseq greater greatereq) tmtex-noop) + + (number tmtex-number) + (change-case tmtex-change-case) + (date tmtex-date) + + ((:or cm-length mm-length in-length pt-length + bp-length dd-length pc-length cc-length + fs-length fbs-length em-length + ln-length sep-length yfrac-length ex-length + fn-length fns-length bls-length + spc-length xspc-length par-length pag-length + gm-length gh-length) tmtex-noop) + + ((:or style-with style-with* style-only style-only* + active active* inactive inactive* + rewrite-inactive inline-tag open-tag middle-tag close-tag + symbol latex hybrid) tmtex-noop) + + ((:or tuple attr tmlen collection associate backup) tmtex-noop) + (set-binding tmtex-noop) + (get-binding tmtex-noop) + (hidden-binding tmtex-hidden-binding) + (label tmtex-label) + (reference tmtex-reference) + (pageref tmtex-pageref) + (write tmtex-noop) + (specific tmtex-specific) + ((:or tag meaning flag) tmtex-noop) + + ((:or anim-compose anim-repeat anim-constant + anim-translate anim-progressive video sound) tmtex-noop) + + (graphics tmtex-graphics) + (superpose tmtex-noop) + ((:or gr-group gr-transform + text-at cline arc carc spline spine* cspline fill) tmtex-noop) + (image tmtex-image) + ((:or box-info frame-direct frame-inverse) tmtex-noop) + + ((:or format line-sep split delay hold release + old-matrix old-table old-mosaic old-mosaic-item + set reset expand expand* hide-expand display-baloon + apply begin end func env) tmtex-noop) + + (shown tmtex-id) + (mtm tmtex-mtm) + (!file tmtex-file) + (!arg tmtex-tex-arg)) + +(logic-dispatcher tmtex-extra-methods% + (wide-float tmtex-wide-float) + (phantom-float tmtex-noop) + ((:or marginal-note marginal-normal-note) tmtex-marginal-note) + ((:or marginal-left-note marginal-even-left-note) tmtex-marginal-left-note) + ((:or marginal-right-note marginal-even-right-note)tmtex-marginal-right-note) + (!ilx tmtex-ilx)) + +(logic-rules + ((tmtex-methods% 'x 'y) (tmtex-primitives% 'x 'y)) + ((tmtex-methods% 'x 'y) (tmtex-extra-methods% 'x 'y))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Expansion of all macros which are not recognized by LaTeX +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-table tmtex-tmstyle% + ((:or section subsection subsubsection paragraph subparagraph part chapter) + (,tmtex-sectional 1)) + ((:or hide-preamble show-preamble) (,tmtex-default -1)) + (hide-part (,tmtex-hide-part -1)) + (show-part (,tmtex-show-part -1)) + ((:or doc-title-options author-data) (,tmtex-default -1)) + (appendix (,tmtex-appendix 1)) + (appendix* (,tmtex-appendix* 1)) + ((:or theorem proposition lemma corollary proof axiom definition + notation conjecture remark note example convention warning + acknowledgments + exercise problem question solution answer + quote-env quotation verse + theorem* proposition* lemma* corollary* axiom* definition* + notation* conjecture* remark* note* example* convention* warning* + acknowledgments* + exercise* problem* question* solution* answer*) + (,tmtex-enunciation 1)) + (new-theorem (,tmtex-new-theorem 2)) + (new-remark (,tmtex-new-theorem 2)) + (new-exercise (,tmtex-new-theorem 2)) + (verbatim (,tmtex-verbatim 1)) + (padded-center (,tmtex-padded-center 1)) + (padded-left-aligned (,tmtex-padded-left-aligned 1)) + (padded-right-aligned (,tmtex-padded-right-aligned 1)) + (compact (,tmtex-compact 1)) + (compressed (,tmtex-compressed 1)) + (amplified (,tmtex-amplified 1)) + (indent (,tmtex-indent 1)) + (jump-in (,tmtex-jump-in 1)) + (algorithm-indent (,tmtex-indent 1)) + ((:or footnote wide-footnote) (,tmtex-footnote 1)) + (footnotemark (,tmtex-default 0)) + (footnotemark* (,tmtex-footnotemark 1)) + ((:or description description-compact description-aligned + description-dash description-long description-paragraphs + itemize itemize-minus itemize-dot itemize-arrow + enumerate enumerate-numeric enumerate-roman enumerate-Roman + enumerate-alpha enumerate-Alpha) + (,tmtex-list-env 1)) + ((:or folded unfolded folded-plain unfolded-plain folded-std unfolded-std + folded-explain unfolded-explain folded-env unfolded-env + folded-documentation unfolded-documentation folded-grouped + unfolded-grouped summarized detailed summarized-plain summarized-std + summarized-env summarized-documentation summarized-grouped + summarized-raw summarized-tiny detailed-plain detailed-std detailed-env + detailed-documentation detailed-grouped detailed-raw detailed-tiny + unfolded-subsession folded-subsession folded-io unfolded-io + input output errput timing) + (,tmtex-tm -1)) + ((:or padded underlined overlined bothlined framed ornamented) + (,tmtex-ornamented 1)) + ((:or folded-io-math unfolded-io-math) (,tmtex-fold-io-math 3)) + (input-math (,tmtex-input-math 2)) + (session (,tmtex-session 3)) + ((:or converter-input converter-output) (,tmtex-converter 3)) + ((:or script-input script-output) (,tmtex-script-inout 4)) + (really-tiny (,tmtex-tiny 1)) + (very-tiny (,tmtex-tiny 1)) + (tiny (,tmtex-tiny 1)) + (really-small (,tmtex-scriptsize 1)) + (very-small (,tmtex-scriptsize 1)) + (smaller (,tmtex-footnotesize 1)) + (small (,tmtex-small 1)) + (flat-size (,tmtex-small 1)) + (normal-size (,tmtex-normalsize 1)) + (sharp-size (,tmtex-large 1)) + (large (,tmtex-large 1)) + (larger (,tmtex-Large 1)) + (very-large (,tmtex-LARGE 1)) + (really-large (,tmtex-LARGE 1)) + (really-huge (,tmtex-Huge 1)) + ((:or british bulgarian chinese croatian czech danish dutch english + esperanto finnish french german greek hungarian italian japanese + korean polish portuguese romanian russian slovak slovene spanish + swedish chineset ukrainian) + (,tmtex-specific-language 1)) + + (math (,tmtex-math 1)) + (text (,tmtex-text 1)) + (math-up (,tmtex-math-up 1)) + (math-ss (,tmtex-math-ss 1)) + (math-tt (,tmtex-math-tt 1)) + (math-bf (,tmtex-math-bf 1)) + (math-sl (,tmtex-math-sl 1)) + (math-it (,tmtex-math-it 1)) + (math-separator (,tmtex-mathpunct 1)) + (math-quantifier (,tmtex-mathord 1)) + (math-imply (,tmtex-mathbin 1)) + (math-or (,tmtex-mathbin 1)) + (math-and (,tmtex-mathbin 1)) + (math-not (,tmtex-mathord 1)) + (math-relation (,tmtex-mathrel 1)) + (math-union (,tmtex-mathbin 1)) + (math-intersection (,tmtex-mathbin 1)) + (math-exclude (,tmtex-mathbin 1)) + (math-plus (,tmtex-mathbin 1)) + (math-minus (,tmtex-mathbin 1)) + (math-times (,tmtex-mathbin 1)) + (math-over (,tmtex-mathbin 1)) + (math-big (,tmtex-mathop 1)) + (math-prefix (,tmtex-mathord 1)) + (math-postfix (,tmtex-mathord 1)) + (math-open (,tmtex-mathopen 1)) + (math-close (,tmtex-mathclose 1)) + (math-ordinary (,tmtex-mathord 1)) + (math-ignore (,tmtex-mathord 1)) + ((:or eqnarray eqnarray* leqnarray* + gather multline gather* multline* align + flalign alignat align* flalign* alignat*) (,tmtex-eqnarray 1)) + + (eq-number (,tmtex-default -1)) + (separating-space (,tmtex-hspace* 1)) + (application-space (,tmtex-hspace* 1)) + + ((:or code cpp-code mmx-code scm-code shell-code scilab-code verbatim-code) + (,tmtex-code-block 1)) + ((:or mmx cpp scm shell scilab) (,tmtex-code-inline 1)) + + (frame (,tmtex-frame 1)) + (colored-frame (,tmtex-colored-frame 2)) + (fcolorbox (,tmtex-fcolorbox 3)) + (rotate (,tmtex-rotate 2)) + (condensed (,tmtex-style-first 1)) + (translate (,tmtex-translate 3)) + (localize (,tmtex-localize 1)) + (render-key (,tmtex-render-key 1)) + (key (,tmtex-key 1)) + (key* (,tmtex-key* 1)) + (minipage (,tmtex-minipage 3)) + (latex_preview (,tmtex-mixed 2)) + (picture-mixed (,tmtex-mixed 2)) + (source-mixed (,tmtex-mixed 2)) + (listing (,tmtex-listing 1)) + (draw-over (,tmtex-make-eps 3)) + (draw-under (,tmtex-make-eps 3)) + (version-old (,tmtex-style-first 2)) + (version-both (,tmtex-style-second 2)) + (version-new (,tmtex-style-second 2)) + (the-index (,tmtex-theindex -1)) + (glossary (,tmtex-glossary 1)) + (glossary-explain (,tmtex-glossary 2)) + (glossary-2 (,tmtex-glossary-entry 3)) + (the-glossary (,tmtex-the-glossary 2)) + ((:or table-of-contents) (,tmtex-toc 2)) + (thebibliography (,tmtex-thebibliography 2)) + (bib-list (,tmtex-style-second 2)) + (bibitem* (,tmtex-bibitem* -1)) + ((:or small-figure big-figure small-table big-table) (,tmtex-figure 2)) + (item (,tmtex-item 0)) + (item* (,tmtex-item-arg 1)) + (render-proof (,tmtex-render-proof 2)) + (nbsp (,tmtex-nbsp 0)) + (nbhyph (,tmtex-nbhyph 0)) + (hrule (,tmtex-hrule 0)) + (frac* (,tmtex-frac* 2)) + (hlink (,tmtex-hlink 2)) + (action (,tmtex-action -1)) + (href (,tmtex-href 1)) + (slink (,tmtex-href 1)) + (eqref (,tmtex-eqref 1)) + (smart-ref (,tmtex-smart-ref -1)) + (choose (,tmtex-choose 2)) + (tt (,tmtex-text-tt 1)) + ((:or strong em name samp abbr dfn kbd var acronym person) + (,tmtex-modifier 1)) + (render-line-number (,tmtex-render-line-number 2)) + (menu (,tmtex-menu -1)) + (with-TeXmacs-text (,(tmtex-rename 'withTeXmacstext) 0)) + (made-by-TeXmacs (,(tmtex-rename 'madebyTeXmacs) 0)) + (cite-website (,(tmtex-rename 'citewebsite) 0)) + (tm-made (,(tmtex-rename 'tmmade) 0)) + (cite (,tmtex-cite -1)) + (nocite (,tmtex-nocite -1)) + (cite-TeXmacs (,tmtex-cite-TeXmacs -1)) + (cite-detail (,tmtex-cite-detail-hook 2)) + (cite-raw (,tmtex-cite-raw -1)) + (cite-raw* (,tmtex-cite-raw* -1)) + (cite-textual (,tmtex-cite-textual -1)) + (cite-textual* (,tmtex-cite-textual* -1)) + (cite-parenthesized (,tmtex-cite-parenthesized -1)) + (cite-parenthesized* (,tmtex-cite-parenthesized* -1)) + (citet (,tmtex-cite-textual -1)) + (citet* (,tmtex-cite-textual* -1)) + (citep (,tmtex-cite-parenthesized -1)) + (citep* (,tmtex-cite-parenthesized* -1)) + (render-cite (,tmtex-render-cite 1)) + ((:or cite-author cite-author-link) (,tmtex-cite-author 1)) + ((:or cite-author* cite-author*-link) (,tmtex-cite-author* 1)) + ((:or cite-year cite-year-link) (,tmtex-cite-year 1)) + (natbib-triple (,tmtex-natbib-triple 3)) + (natexlab (,tmtex-noop -1)) + + ;; FIXME: we should do something more useful with this information + (set-header (,tmtex-noop -1)) + (set-footer (,tmtex-noop -1)) + (set-this-page-header (,tmtex-noop -1)) + (set-this-page-footer (,tmtex-noop -1))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tags which are customized in particular style files +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (style-dependent-declare x) + (with (tag fun narg) x + (with fun+bis (symbol-append fun '+bis) + (if (== narg 2) + `(begin + (when (not (defined? ',fun)) + (tm-define (,fun s l) (tmtex-function (string->symbol s) l))) + (when (not (defined? ',fun+bis)) + (tm-define (,fun+bis s l) (,fun s l)))) + `(begin + (when (not (defined? ',fun)) + (tm-define (,fun t) + (tmtex-function (string->symbol (car t)) (cdr t)))) + (when (not (defined? ',fun+bis)) + (tm-define (,fun+bis s l) + (,fun (append (list (string->symbol s)) l))))))))) + +(tm-define (style-dependent-transform x) + (with (tag fun narg) x + (with fun+bis (symbol-append fun '+bis) + `(,tag (,(list 'unquote fun+bis) -1))))) + +(define-macro (tmtex-style-dependent . l) + `(begin + ,@(map style-dependent-declare l) + (logic-table tmtex-tmstyle% ,@(map style-dependent-transform l)))) + +(tmtex-style-dependent + ;; to be removed + (doc-data tmtex-doc-data 2) + (abstract-data tmtex-abstract-data 2) + ;; abstract markup + (abstract tmtex-abstract 1) + (abstract-acm tmtex-abstract-acm 1) + (abstract-arxiv tmtex-abstract-arxiv 1) + (abstract-msc tmtex-abstract-msc 1) + (abstract-pacs tmtex-abstract-pacs 1) + (abstract-keywords tmtex-abstract-keywords 1) + ;; metadata markup + (doc-title tmtex-doc-title 1) + (doc-running-title tmtex-doc-running-title 1) + (doc-subtitle tmtex-doc-subtitle 1) + (doc-note tmtex-doc-note 1) + (doc-misc tmtex-doc-misc 1) + (doc-date tmtex-doc-date 1) + (doc-running-author tmtex-doc-running-author 1) + (doc-author tmtex-doc-author 1) + (author-name tmtex-author-name 1) + (author-affiliation tmtex-author-affiliation 1) + (author-misc tmtex-author-misc 1) + (author-note tmtex-author-note 1) + (author-email tmtex-author-email 1) + (author-homepage tmtex-author-homepage 1) + ;; references + (doc-subtitle-ref tmtex-doc-subtitle-ref 2) + (doc-date-ref tmtex-doc-date-ref 2) + (doc-note-ref tmtex-doc-note-ref 2) + (doc-misc-ref tmtex-doc-misc-ref 2) + (author-affiliation-ref tmtex-author-affiliation-ref 2) + (author-email-ref tmtex-author-email-ref 2) + (author-homepage-ref tmtex-author-homepage-ref 2) + (author-note-ref tmtex-author-note-ref 2) + (author-misc-ref tmtex-author-misc-ref 2) + ;; labels + (doc-subtitle-label tmtex-doc-subtitle-label 2) + (doc-date-label tmtex-doc-date-label 2) + (doc-note-label tmtex-doc-note-label 2) + (doc-misc-label tmtex-doc-misc-label 2) + (author-affiliation-label tmtex-author-affiliation-label 2) + (author-email-label tmtex-author-email-label 2) + (author-homepage-label tmtex-author-homepage-label 2) + (author-note-label tmtex-author-note-label 2) + (author-misc-label tmtex-author-misc-label 2) + ;; misc + ((:or equation equation*) tmtex-equation 2) + (bibliography tmtex-bib 4) + (elsevier-frontmatter tmtex-elsevier-frontmatter 2) + (conferenceinfo tmtex-acm-conferenceinfo 2) + (CopyrightYear tmtex-acm-copyright-year 2) + (slide tmtex-beamer-slide 2) + (tit tmtex-beamer-tit 2) + (crdata tmtex-acm-crdata 2)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Protected tags +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(logic-group tmtex-protected% + a b c d i j k l o r t u v H L O P S + aa ae bf cr dh dj dp em fi ge gg ht if in it le lg ll lu lq mp mu + ne ng ni nu oe or pi pm rm rq sb sc sf sl sp ss th to tt wd wp wr xi + AA AE DH DJ Im NG OE Pi Pr Re SS TH Xi) + +(logic-group tmtex-protected-symbol% + space) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Expansion of all macros which are not recognized by LaTeX +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define tmtex-user-defs-table (make-ahash-table)) + +(define (user-definition? x) + (or (and (func? x 'new-theorem 2) (string? (cadr x))) + (and (func? x 'assign 2) (string? (cadr x))))) + +(define (collect-user-defs-sub t) + (cond ((npair? t) (noop)) + ((user-definition? t) + (ahash-set! tmtex-user-defs-table (string->symbol (cadr t)) #t)) + (else (for-each collect-user-defs-sub (cdr t))))) + +(define (collect-user-defs t) + (set! tmtex-user-defs-table (make-ahash-table)) + (collect-user-defs-sub (cons 'document (tmtex-filter-preamble t))) + (ahash-set->list tmtex-user-defs-table)) + +(define (as-string sym) + (with s (symbol->string sym) + (if (string-starts? s "begin-") + (substring s 6 (string-length s)) + s))) + +(define (logic-first-list name) + (let* ((l1 (query (cons name '('first 'second)))) + (l2 (map (cut assoc-ref <> 'first) l1))) + (map as-string l2))) + +(define (collect-user-macros-in t h) + (when (tm-compound? t) + (when (tree-label-extension? (tm-label t)) + (ahash-set! h (symbol->string (tm-label t)) #t)) + (for-each (cut collect-user-macros-in <> h) (tm-children t)))) + +(define (collect-user-macros t) + (with h (make-ahash-table) + (collect-user-macros-in t h) + (ahash-set->list h))) + +(define (tmtex-env-macro name) + `(associate ,name (xmacro "x" (eval-args "x")))) + +(define tmtex-always-expand + ;; FIXME: find a cleaner way to handle these environments + (list "render-theorem" "render-remark" "render-exercise" "render-proof" + "algorithm" "algorithm*" "named-algorithm" "named-algorithm-old" + "specified-algorithm" "specified-algorithm*" + "named-specified-algorithm" "algorithm-body" "numbered" + + "short-item" "short-question" + "question-arabic" "question-alpha" "question-Alpha" + "question-roman" "question-Roman" "question-item" + "answer-arabic" "answer-alpha" "answer-Alpha" + "answer-roman" "answer-Roman" "answer-item" + + "gap" "gap-dots" "gap-underlined" "gap-box" + "gap-wide" "gap-dots-wide" "gap-underlined-wide" "gap-box-wide" + "gap-long" "gap-dots-long" "gap-underlined-long" "gap-box-long" + + "with-button-box" "with-button-box*" + "with-button-circle" "with-button-circle*" + "with-button-arabic" "with-button-alpha" "with-button-Alpha" + "with-button-roman" "with-button-Roman" + "mc-field" "mc-wide-field" "show-reply" "hide-reply" + "mc" "mc-monospaced" "mc-horizontal" "mc-vertical" + + "textual-table" "numeric-dot-table" + "calc-table" "calc-inert" "calc-input" "calc-output" "calc-ref" + "cell-inert" "cell-input" "cell-output" "cell-ref" + "cell-range" "cell-sum" "cell-plusses" "cell-commas" + + "tmdoc-title" "icon" "shortcut" "key" "prefix" + "menu" "render-menu" "submenu" "subsubmenu" "subsubsubmenu" + "markup" "tmstyle" "tmpackage" "tmdtd" "def-index" + "src-arg" "src-var" "scm-arg" "scm-args" + "descriptive-table" "tm-fragment" "framed-fragment" + "explain" "explain-synopsis" "explain-macro" + "small-envbox" "big-envbox" "small-focus" "big-focus" + "cursor" "math-cursor" "TeXmacs-version" "c++" "BibTeX")) + +(tm-define (tmtex-env-patch t l0) + (let* ((st (tree->stree t)) + (l0 (logic-first-list 'tmtex-primitives%)) + (l1 (logic-first-list 'tmtex-extra-methods%)) + (l2 (logic-first-list 'tmtex-tmstyle%)) + (l3 (map as-string (logic-apply-list '(latex-tag%)))) + (l4 (map as-string (logic-apply-list '(latex-symbol%)))) + (l5 (list-difference l3 (list-union l4 tmtex-always-expand))) + (l6 (map as-string (collect-user-defs st))) + (l7 (if (preference-on? "texmacs->latex:expand-user-macros") '() l6)) + (l8 (list-difference (collect-user-macros st) + (list-union l0 l6 tmtex-always-expand))) + (l9 (list-difference (list-union l1 l2 l5 l7 l8) l0)) + (l10 (list-filter l0 (lambda (s) (and (string? s) + (<= (string-length s) 2))))) + (l11 (list-difference l10 (list "tt" "em" "op"))) + (l12 (list-difference l9 l11))) + `(collection ,@(map tmtex-env-macro l12)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Interface +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (tmtex-get-style sty) + (cond ((not sty) (set! sty (list "article"))) + ((string? sty) (set! sty (list sty))) + ((func? sty 'tuple) (set! sty (cdr sty))) + ((null? sty) (set! sty '("article")))) + sty) + +(tm-define (tmtex-postprocess x) x) +(tm-define (tmtex-postprocess-body x) x) + +(tm-define (texmacs->latex x opts) + ;;(display* "texmacs->latex [" opts "], " x "\n") + (if (tmfile? x) + (let* ((body (tmfile-extract x 'body)) + (style (tmtex-get-style (tmfile-extract x 'style))) + (main-style (or (tmtex-transform-style (car style)) "article")) + (lan (tmfile-language x)) + (init (tmfile-extract x 'initial)) + (att (tmfile-extract x 'attachments)) + (doc (list '!file body style lan init att + (url->string (get-texmacs-path))))) + (set! tmtex-cjk-document? + (in? lan '("chinese" "chineset" "japanese" "korean"))) + (latex-set-style main-style) + (latex-set-packages '()) + (latex-set-extra '()) + (set! tmtex-style (car style)) + (set! tmtex-packages (cdr style)) + (set! tmtex-languages (list lan)) + (set! tmtex-colors '()) + (set! tmtex-colormaps '()) + (import-tmtex-styles) + (tmtex-style-init body) + (set! doc (tmtex-style-preprocess doc)) + (with result (tmtex-postprocess (texmacs->latex doc opts)) + (set! tmtex-style "generic") + (set! tmtex-packages '()) + result)) + (let* ((x2 (tree->stree (tmtm-eqnumber->nonumber (stree->tree x)))) + (x3 (tmtm-match-brackets x2))) + (tmtex-initialize opts) + (with r (tmtex (tmpre-produce x3)) + (if tmtex-mathjax? + (set! r (latex-mathjax-pre r))) + (if (not tmtex-use-macros?) + (set! r (latex-expand-macros r))) + (if tmtex-mathjax? + (set! r (latex-mathjax r))) + r))))