Rem This macro is part of tex2doc Rem Copyright (C) 1999 Thomas Link Rem This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Rem This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. Rem You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Rem For new versions see http://w3.ihs.ac.at/~link/dwnld/tex2doc.htm Rem ---------------------------------------------------------------- Rem +++ Rem ref: 1, obwohl nicht existent Rem env: titlepage Rem vspace, vspace*, noindent Rem usepackage, xpackage (use these packages) ' changes made by Dobrica Pavlinusic : ' - partial support of Croatian language (enough for me) ' - replace iso8859-2 characters with windows 1250 equvivalents (yak!) ' - do not nuke numbers 1, 2 and/or 3 from text (with xxz$, xxtmp$, xembpic$) ' - replace \textasciitilde{} with tilde ' - replace {c} with c (and {} with nothing) Dim xcapfig$, xcaptab$, xlanguage$, xembpic$, xplattform$, xbookmark$, xcitemode$, xcitecmds$, xpicformats$, xoptions$, xtoc$, xlof$, xlot$, xhead$, xbiblio$, xcitelb$, xciterb$, xxr$, xxz$, xxtmp$, xsansserif$, xtypewriter$, xnoexpcmds$, xtxtstyles$, xmaster$, xpregraph$, xnoformat$, xcitestyle$, xbibfile$, xbibtex$, xfomode$, xcmds2del$, xexact$, xchkpb$, xchkpa$ Dim xr$, xt$, xs$, xb$, xincludeonly$, xdoctype$, xtitlepage, xmaindoc, xbblfile$, xscraplist$, xdir$, xwinname$, xbbl$, xListSep$, xnormfont$, xnormal$, xrecite$, xperiod$, xcay$, xccc$, xldots$, xwordversion Dim cmdfs1__$(), cmdfs2__$(), cmdrs1__$(), cmdrs2__$(), cmdOpt__(), ncmds, maxcmds Dim lablab__$(), labname__$(), labtype__$(), labpos__(), maxlab, nlab Dim xcites__$(), xcitec, xcitemax Dim xsaved__$(), xsaved_, xsavedmax Public Sub MAIN() ReDim cmdfs1__$(100) ReDim cmdfs2__$(100) ReDim cmdrs1__$(100) ReDim cmdrs2__$(100) ReDim cmdOpt__(100) ReDim lablab__$(100) ReDim labname__$(100) ReDim labtype__$(100) ReDim labpos__(100) ReDim xcites__$(500) ReDim xsaved__$(500) Dim version$ Dim stdoptions$ Dim button Dim x$ Dim n$ Dim a$ Dim b$ xcapfig$ = "" xcaptab$ = "" xlanguage$ = "" xembpic$ = "" xplattform$ = "" xbookmark$ = "" xcitemode$ = "" xcitecmds$ = "" xpicformats$ = "" xoptions$ = "" xtoc$ = "" xlof$ = "" xlot$ = "" xhead$ = "" xbiblio$ = "" xcitelb$ = "" xciterb$ = "" xxr$ = "" xxz$ = "" xxtmp$ = "" xsansserif$ = "" xtypewriter$ = "" xnoexpcmds$ = "" xtxtstyles$ = "" xmaster$ = "" xpregraph$ = "" xnoformat$ = "" xcitestyle$ = "" xbibfile$ = "" xbibtex$ = "" xfomode$ = "" xcmds2del$ = "" xexact$ = "" xchkpb$ = "" xchkpa$ = "" xr$ = "" xt$ = "" xs$ = "" xb$ = "" xincludeonly$ = "" xdoctype$ = "" xtitlepage = 0 xmaindoc = 0 xbblfile$ = "" xscraplist$ = "" xdir$ = "" xwinname$ = "" xbbl$ = "" xListSep$ = "" xnormfont$ = "" xnormal$ = "" xrecite$ = "" xperiod$ = "" xcay$ = "" xccc$ = "" xldots$ = "" xwordversion = 0 ncmds = 0 maxcmds = 0 maxlab = 0 nlab = 0 xcitec = 0 xcitemax = 0 xsaved_ = 0 xsavedmax = 0 version$ = "29.3.99" maxlab = 99 maxcmds = 99 xcitemax = 499 xsavedmax = 499 Rem ### xlanguage$: Deutsch, Deutsch (Schweiz), English (AUS), English (UK), English (US) xlanguage$ = "Croatian" Rem ### xcitemode$: latex (if empty), apacite.sty xcitemode$ = "apacite.sty" Rem ### Variables for use with BibTeX xcitestyle$ = "xapacite2" ' ### Default Bst-file xbibfile$ = "soz" ' ### Default Bibliography Rem ### xcitecmds$: cite, fullcite, shortcite, citeA, fullciteA, shortciteA, citeauthor, fullciteauthor, citeyear (scite), citeyearNP, citeNP, fullciteNP, shortciteNP Rem ### Most of these commands are only available if apacite.sty is selected as citemode. The list of supported cite commands has to start and end with an comma, and must not contain spaces. Only the commands in this list are translated. xcitecmds$ = ",cite,citeyear,scite," Rem ### xpicformats$: eps, wmf, pict, pct, gif Rem ### The list of supported filename endings has to start and end with an comma, and must not contain spaces. xpicformats$ = ",eps,wmf,pict,pct,gif," Rem ### xtxtstyles$: emph, textup, textit, textsl, textsc, textmd, textbf, textrm, textsf, texttt, tiny, scriptsize, footnotesize, small, normalsize, large, Large, LARGE, huge, Huge, superscript, subscript Rem ### em, upshape, itshape, slshape, scshape, mdseries, bfseries, rmfamily, sffamily, ttfamily xtxtstyles$ = ",emph,textup,textit,textsl,textsc,textmd,textbf,textrm,textsf,texttt,tiny,scriptsize,footnotesize,small,normalsize,large,Large,LARGE,huge,Huge,superscript,subscript,em,upshape,itshape,slshape,scshape,mdseries,bfseries,rmfamily,sffamily,ttfamily," Rem xtxtstyles$ = ",emph,superscript,subscript," Rem ### xnoexpcmds$: List of commands that are not expanded because the are handled otherwise. xnoexpcmds$ = "" Rem ### xcmds2del$: Commands, that will be deleted. Rem ### As valid pattern matching expression! xcmds2del$ = ",newpage,enlargethispage\*,enlargethispage,protect,pagebreak," Rem ### xfomode$: manager, open (default) xfomode$ = "open" Rem ### xexact$: Take more care (& time) with these options Rem ### supported: headings, multicolumn, tabular, list xexact$ = ",headings,multicolumn,tabular,list," Rem ### xchkpb$: Make sure there is a new paragraph mark before these commands xchkpb$ = ",begin," Rem ### xchkpa$: Make sure there is a new paragraph mark after these commands xchkpa$ = ",end," Rem ### xoptions$: text, docbody, ref, footnote, bibliography, lists, lof, lot, toc, include, tabular, table, figure, cite, graphic, booktabs, germsty, multicolumn, newcommand, skip, fontstyles, environment, recite, headings, title, cleanup, verb, savemath, Rem ### BibTeX, DocumentVars, singlefile, stdoptions$ = "text,ref,footnote,bibliography,lists,lof,lot,toc,include,tabular,table,figure,cite,graphic,booktabs,germsty,multicolumn,newcommand,skip,fontstyles,environment,headings,title,cleanup,verb,savemath," WordBasic.BeginDialog 580, 226, "tex2doc " + version$ WordBasic.CheckBox 10, 10, 150, 10, "text", "checktext" WordBasic.CheckBox 10, 30, 150, 10, "ref", "checkref" WordBasic.CheckBox 10, 50, 150, 10, "footnote", "checkfootnote" WordBasic.CheckBox 10, 70, 150, 10, "bibliography", "checkbibliography" WordBasic.CheckBox 10, 90, 150, 10, "lists", "checklists" WordBasic.CheckBox 10, 110, 150, 10, "lof", "checklof" WordBasic.CheckBox 10, 130, 150, 10, "lot", "checklot" WordBasic.CheckBox 10, 150, 150, 10, "toc", "checktoc" WordBasic.CheckBox 10, 170, 150, 10, "docvars", "checkdocvars" WordBasic.CheckBox 210, 10, 150, 10, "include", "checkinclude" WordBasic.CheckBox 210, 30, 150, 10, "tabular", "checktabular" WordBasic.CheckBox 210, 50, 150, 10, "table", "checktable" WordBasic.CheckBox 210, 70, 150, 10, "figure", "checkfigure" WordBasic.CheckBox 210, 90, 150, 10, "cite", "checkcite" WordBasic.CheckBox 210, 110, 150, 10, "graphic", "checkgraphic" WordBasic.CheckBox 210, 130, 150, 10, "booktabs", "checkbooktabs" WordBasic.CheckBox 210, 150, 150, 10, "germsty", "checkgermsty" WordBasic.CheckBox 210, 170, 150, 10, "recite", "checkrecite" WordBasic.CheckBox 410, 10, 150, 10, "multicolumn", "checkmulticolumn" WordBasic.CheckBox 410, 30, 150, 10, "newcommand", "checknewcommand" WordBasic.CheckBox 410, 50, 150, 10, "skip", "checkskip" WordBasic.CheckBox 410, 70, 150, 10, "fontstyles", "checkfontstyles" WordBasic.CheckBox 410, 90, 150, 10, "environment", "checkenvironment" WordBasic.CheckBox 410, 110, 150, 10, "headings", "checkheadings" WordBasic.CheckBox 410, 130, 150, 10, "title", "checktitle" WordBasic.CheckBox 410, 150, 150, 10, "cleanup", "checkcleanup" WordBasic.CheckBox 410, 170, 150, 10, "docbody", "checkdocbody" WordBasic.PushButton 10, 200, 80, 20, "Standard" WordBasic.PushButton 220, 200, 80, 20, "&Selection" WordBasic.PushButton 310, 200, 80, 20, "Single &File" WordBasic.PushButton 400, 200, 80, 20, "&Combine" WordBasic.PushButton 490, 200, 80, 20, "&BibTeX" WordBasic.CancelButton 100, 200, 80, 21 WordBasic.EndDialog Dim tmldialog As Object: Set tmldialog = WordBasic.CurValues.UserDialog button = WordBasic.Dialog.UserDialog(tmldialog, 1) xoptions$ = "," xoptions$ = xoptions$ + "DocumentVars," xoptions$ = xoptions$ + "recite," xoptions$ = xoptions$ + "checkpara," If button = 1 Then xoptions$ = xoptions$ + stdoptions$ ElseIf button = 3 Then xoptions$ = xoptions$ + "text,footnote,bibliography,lists,tabular,table,figure,cite,graphic,booktabs,germsty,multicolumn,skip,fontstyles,environment,headings,title,cleanup," ElseIf button = 4 Then xoptions$ = ",ref,include,headings,newcommand,lof,lot,toc,chkdoc," ElseIf button = 5 Then xoptions$ = ",BibTeX," ElseIf button = 2 Then If tmldialog.checktext = 1 Then xoptions$ = xoptions$ + "text," If tmldialog.checkref = 1 Then xoptions$ = xoptions$ + "ref," If tmldialog.checkfootnote = 1 Then xoptions$ = xoptions$ + "footnote," If tmldialog.checkbibliography = 1 Then xoptions$ = xoptions$ + "bibliography," If tmldialog.checklists = 1 Then xoptions$ = xoptions$ + "lists," If tmldialog.checklof = 1 Then xoptions$ = xoptions$ + "lof," If tmldialog.checklot = 1 Then xoptions$ = xoptions$ + "lot," If tmldialog.checktoc = 1 Then xoptions$ = xoptions$ + "toc," If tmldialog.checkinclude = 1 Then xoptions$ = xoptions$ + "include," If tmldialog.checktabular = 1 Then xoptions$ = xoptions$ + "tabular," If tmldialog.checktable = 1 Then xoptions$ = xoptions$ + "table," If tmldialog.checkfigure = 1 Then xoptions$ = xoptions$ + "figure," If tmldialog.checkcite = 1 Then xoptions$ = xoptions$ + "cite," If tmldialog.checkgraphic = 1 Then xoptions$ = xoptions$ + "graphic," If tmldialog.checkbooktabs = 1 Then xoptions$ = xoptions$ + "booktabs," If tmldialog.checkgermsty = 1 Then xoptions$ = xoptions$ + "germsty," If tmldialog.checkmulticolumn = 1 Then xoptions$ = xoptions$ + "multicolumn," If tmldialog.checknewcommand = 1 Then xoptions$ = xoptions$ + "newcommand," If tmldialog.checkskip = 1 Then xoptions$ = xoptions$ + "skip," If tmldialog.checkfontstyles = 1 Then xoptions$ = xoptions$ + "fontstyles," If tmldialog.checkenvironment = 1 Then xoptions$ = xoptions$ + "environment," If tmldialog.checkheadings = 1 Then xoptions$ = xoptions$ + "headings," If tmldialog.checktitle = 1 Then xoptions$ = xoptions$ + "title," If tmldialog.checkcleanup = 1 Then xoptions$ = xoptions$ + "cleanup," If tmldialog.checkrecite = 1 Then xoptions$ = xoptions$ + "recite," If tmldialog.checkdocvars = 1 Then xoptions$ = xoptions$ + "docvars," If tmldialog.checkdocbody = 1 Then xoptions$ = xoptions$ + "docbody," Else GoTo endee End If init initScrap readDocumentVars Rem BeginnDokument WordBasic.EditReplaceClearFormatting WordBasic.EditFindClearFormatting xdoctype$ = findearg$("\\documentclass*\{(*)\}", "\1", 0) If xdoctype$ <> "" Then xmaindoc = -1 Else xmaindoc = 0 xmaster$ = findearg$("%%% TeX-master: " + Chr(34) + "(*)" + Chr(34), "\1", 0) If xmaster$ <> "" Then xmaster$ = xdir$ + xmaster$ + ".tex" x$ = findearg$("\\bibliography\{(*)\}", "\1", 0) If x$ <> "" Then xbibfile$ = x$ ElseIf WordBasic.[GetDocumentVar$](xbiblio$) <> "" Then xbibfile$ = WordBasic.[GetDocumentVar$](xbiblio$) End If x$ = findearg$("\\bibliographystyle\{(*)\}", "\1", 0) If x$ <> "" Then xcitestyle$ = x$ Rem ******************************** BibTeX If isOption("BibTeX") Then citeWord Rem ******************************** include & input If Not isOption("singlefile") And isOption("include") Then includeandinput Rem ******************************** Newcommand If Not isOption("singlefile") And isOption("newcommand") Then newcommand Rem ******************************** Save If isOption("verb") Then saveVerb If isOption("savemath") Then saveMath Rem ******************************** Absatz & Kommentare If isOption("text") Then shrinkTeX Rem DateiDokumentLayout .Registerkarte = "0", .SeitenrandOben = "3 cm", .SeitenrandUnten = "3 cm", .SeitenrandLinks = "3 cm", .SeitenrandRechts = "3 cm", .Bundsteg = "0 cm", .SeitenBreite = "", .SeitenLŠnge = "", .HochQuer = - 1, .AusrichtungVertikal = - 1, ' .AnwAuf = 4, .GgbrSeiten = 0, .AbstandKopfzeile = "1,25 cm", .AbstandFu§zeile = "1,25 cm", .AbschnittsBeginn = 2, .GeradeUngeradeSeiten = 1, .ErsteSeiteAnders = 0, .Endnoten = 0, .ZeilenNr = 0, .AnfangsNr = "", .VomText = "", .ZŠhlintervall = "0", .Numer 'ierArt = - 1 Rem defFormat(xnormal$) textStyle (n$) replpmf "$(*)$", "\1" WordBasic.EditReplaceClearFormatting End If Rem ******************************** Bibliographie bib: If isOption("bibliography") Then biblio Rem ******************************** Sections If isOption("headings") Then If xdoctype$ = "article" Then replHeadings "section", "1" replHeadings "subsection", "2" replHeadings "subsubsection", "3" xtitlepage = 0 Else replHeadings "chapter", "1" replHeadings "section", "2" replHeadings "subsection", "3" replHeadings "subsubsection", "4" xtitlepage = -1 End If WordBasic.FormatHeadingNumbering Preset:="3" WordBasic.EditReplaceClearFormatting WordBasic.EditReplaceFont Bold:=1 rStyle "paragraph" replpmf "\\paragraph\{(*)\}", "\1" rStyle "subparagraph" replpmf "\\subparagraph\{(*)\}", "\1" WordBasic.EditReplaceClearFormatting End If titel: If isOption("title") Then maketitle Rem ******************************** Table, Figure captabfig: If isOption("table") Then WordBasic.InsertAddCaption Name:=xcaptab$ tablec End If If isOption("figure") Then figurec End If Rem ******************************** Tabellen tab_: If isOption("tabular") Then tabular1 Rem +++ tabbing Rem ******************************** Grafiken If isOption("graphic") Then WordBasic.InsertAddCaption Name:=xcapfig$ bilder End If Rem ******************************** Textstyles If isOption("fontstyles") Then repl "\begin{", "\@pg{\begin{" replpm "(\\end\{*\})", "\1}" a$ = lcar$(xtxtstyles$) b$ = lcdr$(xtxtstyles$) While a$ <> "" replFontStyle (a$) a$ = lcar$(b$) b$ = lcdr$(b$) Wend If inList(xtxtstyles$, "superscript") Then WordBasic.EditReplaceFont Superscript:=1 replpmf "^^\{(*)\}", "\1" WordBasic.EditReplaceClearFormatting End If If inList(xtxtstyles$, "subscript") Then WordBasic.EditReplaceFont Subscript:=1 replpmf "_\{(*)\}", "\1" WordBasic.EditReplaceClearFormatting End If End If Rem ******************************** Environments If isOption("environment") Then replEnv "quote", "Zitat" replEnv "quotation", "Zitat" replEnv "zitat", "Zitat" replEnv "abstract", "Abstract" replEnv "center", "Center" replEnv "flushright", "Flushright" replEnv "flushleft", "Flushleft" End If Rem ******************************** Bib, Cite If isOption("cite") Then replCites ElseIf isOption("recite") Then revertOldCites End If Rem ******************************** Listen listen: If isOption("lists") Then listen Rem ******************************** Kopf-, Fußzeilen Rem +++ If xdoctype$ = "article" Then WordBasic.StartOfDocument WordBasic.InsertPageNumbers Type:=1, Position:=1, FirstPage:=1 Else WordBasic.StartOfDocument WordBasic.InsertPageNumbers Type:=1, Position:=1, FirstPage:=0 End If Rem ******************************** Feinheiten If isOption("cleanup") Then stripCmd "@pg" a$ = lcar$(xcmds2del$) b$ = lcdr$(xcmds2del$) While a$ <> "" delCmd (a$) a$ = lcar$(b$) b$ = lcdr$(b$) Wend repl "\,", "" repl " " + xr$, xr$ repl xr$ + " ", xr$ WordBasic.FormatPageNumber ChapterNumber:=0, NumRestart:=0, NumFormat:=0, StartingNum:="0", level:=0, Separator:=0 End If Rem ******************************** Restore restoreSaved If isOption("verb") Then verb Rem ******************************** Ref, Pageref If isOption("ref") Then labels updateLabPos pageref ref ElseIf isOption("headings") Then dolabel "\@hd", xhead$ End If Rem ******************************** \\ If isOption("text") Then repl xxz$, xr$ Rem ******************************** Skip If isOption("skip") Then rStyle "xskip" repl "\smallskip", xr$ + xr$ repl "\medskip", xr$ + xr$ + xr$ repl "\bigskip", xr$ + xr$ + xr$ + xr$ WordBasic.EditReplaceClearFormatting End If Rem ******************************** Fußnoten If isOption("footnote") Then replFootnotes Rem ******************************** Verzeichnisse If isOption("lof") Then listoffigures If isOption("lot") Then listoftables If isOption("toc") Then tableofcontents Rem ******************************** document-Environment If xmaindoc And isOption("docbody") Then WordBasic.StartOfDocument finde "\begin{document}" If WordBasic.EditFindFound() Then WordBasic.CharRight 1 WordBasic.StartOfDocument 1 WordBasic.WW6_EditClear End If finde "\end{document}" If WordBasic.EditFindFound() Then WordBasic.CharLeft 1 WordBasic.EndOfDocument 1 WordBasic.WW6_EditClear End If End If ende: exitScrap writeDocumentVars endee: End Sub Rem **************************************************************** Rem ******************************** Init Private Sub init() Dim n xxr$ = "¶" ' ### temporary characters xxz$ = " x3x " ' ### not to be used elsewhere xxtmp$ = " y2y " ' ### xembpic$ = " z1z " ' ### How to embed pictures xpregraph$ = "abb:" ' ### Prefix for graphic-labels xperiod$ = "," ' ### for numbers xListSep$ = "," xincludeonly$ = "" xbblfile$ = "" xdir$ = WordBasic.[FileNameInfo$](WordBasic.[FileName$](), 5) xwinname$ = WordBasic.[WindowName$]() xbbl$ = "" xcay$ = " " ' Cites: Seperator Author-Year xccc$ = "; " ' Cites: Seperator Citation; Citation n = InStr(WordBasic.[AppInfo$](2), ".") If n > 0 Then xwordversion = WordBasic.Val(WordBasic.[Left$](WordBasic.[AppInfo$](2), n - 1)) Else xwordversion = WordBasic.Val(WordBasic.[AppInfo$](2)) End If nlab = 0 xcitec = 0 xsaved_ = 0 If LCase(WordBasic.[Left$](xlanguage$, 7)) = "deutsch" Then xcapfig$ = "Abbildung" xcaptab$ = "Tabelle" xbiblio$ = "Bibliographie" xtoc$ = "Inhaltsverzeichnis" xlof$ = "Abbildungsverzeichnis" xlot$ = "Tabellenverzeichnis" ElseIf LCase(WordBasic.[Left$](xlanguage$, 7)) = "english" Then xcapfig$ = "Figure" xcaptab$ = "Table" xbiblio$ = "Bibliography" xtoc$ = "Contents" xlof$ = "Figures" xlot$ = "Tables" ElseIf LCase(WordBasic.[Left$](xlanguage$, 7)) = "croatia" Then xcapfig$ = "Slika" xcaptab$ = "Tablica" xbiblio$ = "Bibliografija" xtoc$ = "Sadržaj" xlof$ = "Slike" xlot$ = "Tabele" ElseIf xlanguage$ = "~~~" Then xcapfig$ = "~~~" ' "Figure" xcaptab$ = "~~~" ' "Table" xbiblio$ = "~~~" ' "Bibliography" xtoc$ = "~~~" ' "Contents" xlof$ = "~~~" ' "Figures" xlot$ = "~~~" ' "Tables" Else newLang1 "lang" End If If xcitemode$ = "apacite.sty" Then xcitelb$ = "(" ' ### Braces for enclosing xciterb$ = ")" ' ### citations Else xcitelb$ = "[" xciterb$ = "]" End If If InStr(WordBasic.[AppInfo$](1), "Macintosh") Then xplattform$ = "mac" Rem xldots$ = "…" xldots$ = "..." xb$ = "N" ' ### long dash xsansserif$ = "Helvetica" ' ### Sans serif font xtypewriter$ = "Courier" ' ### Typewriter font xrecite$ = "!!" xbibtex$ = "Vbib" ' ### Name of BibTeX application; leave empty if you don't want to run BibTeX automatically; on a Mac use the creator signature; be aware that this might make Word & OS crash Else xplattform$ = "win" xb$ = "-" Rem xldots$ = "…" xldots$ = "..." xsansserif$ = "Arial" xtypewriter$ = "New Courier" xrecite$ = "°°" xbibtex$ = "bibtex" ' ### Name of BibTeX application; leave empty if you don't want to run BibTeX automatically; on a Mac use the creator signature; be aware that this might make Word & OS crash End If If InStr(WordBasic.[AppInfo$](16), "Deutsch") Then xt$ = "^t" xr$ = "^a" xs$ = "^g" xnormal$ = "Standard" xnormfont$ = "Absatz-Standardschriftart" xbookmark$ = "Textmarke" xnoformat$ = "(Keine Formatvorlage)" If xplattform$ = "mac" Then xhead$ = "†berschrift" Else xhead$ = "Überschrift" End If ElseIf InStr(WordBasic.[AppInfo$](16), "English") Then xt$ = "^t" ' ### Tabulator xr$ = "^p" ' ### Paragraph xs$ = "^s" ' ### non-breaking space xnormal$ = "Normal" ' ### normal para formating xnormfont$ = "Default Paragraph Font" ' ### normal font xbookmark$ = "Bookmark" ' ### name for bookmarks xhead$ = "Heading" ' ### name for headings xnoformat$ = "(No Style)" ' ### null style ElseIf InStr(WordBasic.[AppInfo$](16), "~~~") Then xt$ = "~~~" ' ### Tabulator xr$ = "~~~" ' ### Paragraph xs$ = "~~~" ' ### non-breaking space xnormal$ = "~~~" ' ### normal para formating xnormfont$ = "~~~" ' ### normal font xbookmark$ = "~~~" ' ### name for bookmarks xhead$ = "~~~" ' ### name for headings xnoformat$ = "~~~" ' ### null style Else newLang1 "lang" End If End Sub Private Sub newLang1(fs1$) Dim fs$ Dim x fs$ = Chr(126) + Chr(126) + Chr(126) WordBasic.BeginDialog 482, 100, "Microsoft Word" WordBasic.OKButton 10, 70, 80, 21 WordBasic.CancelButton 120, 70, 80, 21 WordBasic.Text 10, 10, 400, 13, "tex2dox can't deal with the language of Word" WordBasic.Text 10, 25, 400, 13, "You will to have to edit the macro" WordBasic.Text 10, 40, 400, 13, "Search for " + Chr(34) + fs$ + Chr(34) WordBasic.EndDialog Dim nld As Object: Set nld = WordBasic.CurValues.UserDialog x = WordBasic.Dialog.UserDialog(nld) If x <> 0 Then If xwordversion < 8 Then WordBasic.ToolsMacro Name:="tmlTeX2Doc", Edit:=1, Show:=0, description:="", NewName:="" finde (fs$) Stop End If End Sub Private Sub xStyle(n$) If WordBasic.[StyleDesc$](n$) = "" Then defformat (n$) WordBasic.Style n$ End Sub Private Sub rStyle(n$) Select Case n$ Case "Flushright" WordBasic.EditReplacePara Alignment:=0 Case "Center" WordBasic.EditReplacePara Alignment:=1 Case "Flushleft" WordBasic.EditReplacePara Alignment:=2 Case Else If WordBasic.[StyleDesc$](n$) = "" Then defformat (n$) WordBasic.EditReplaceStyle Style:=n$ End Select End Sub Private Sub textStyle(n$) Select Case n$ Case "emph", "em" WordBasic.EditReplaceFont Italic:=1 Case "textup", "upshape" Case "textit", "itshape" WordBasic.EditReplaceFont Italic:=1 Case "textsl", "slshape" WordBasic.EditReplaceFont Italic:=1 Case "textsc", "scshape" WordBasic.EditReplaceFont SmallCaps:=1 Case "textmd", "mdseries" WordBasic.EditReplaceFont Bold:=0 Case "textbf", "bfseries" WordBasic.EditReplaceFont Bold:=1 Case "textrm", "rmfamily" Case "textsf", "sffamily" WordBasic.EditReplaceFont Font:=xsansserif$ Case "texttt", "ttfamily" WordBasic.EditReplaceFont Font:=xtypewriter$ Case "tiny" WordBasic.EditReplaceFont Points:="6" Case "scriptsize" WordBasic.EditReplaceFont Points:="7" Case "footnotesize" WordBasic.EditReplaceFont Points:="8" Case "small" WordBasic.EditReplaceFont Points:="9" Case "normalsize" Case "large" WordBasic.EditReplaceFont Points:="14" Case "Large" WordBasic.EditReplaceFont Points:="16" Case "LARGE" WordBasic.EditReplaceFont Points:="20" Case "huge" WordBasic.EditReplaceFont Points:="24" Case "Huge" WordBasic.EditReplaceFont Points:="28" Case Else End Select End Sub Private Sub textFormat(n$) Select Case n$ Case "emph", "em" WordBasic.FormatFont Italic:=1 Case "textup", "upshape" Case "textit", "itshape" WordBasic.FormatFont Italic:=1 Case "textsl", "slshape" WordBasic.FormatFont Italic:=1 Case "textsc", "scshape" WordBasic.FormatFont SmallCaps:=1 Case "textmd", "mdseries" WordBasic.FormatFont Bold:=0 Case "textbf", "bfseries" WordBasic.FormatFont Bold:=1 Case "textrm", "rmfamily" Case "textsf", "sffamily" WordBasic.FormatFont Font:=xsansserif$ Case "texttt", "ttfamily" WordBasic.FormatFont Font:=xtypewriter$ Case "tiny" WordBasic.FormatFont Points:="6" Case "scriptsize" WordBasic.FormatFont Points:="7" Case "footnotesize" WordBasic.FormatFont Points:="8" Case "small" WordBasic.FormatFont Points:="9" Case "normalsize" Case "large" WordBasic.FormatFont Points:="14" Case "Large" WordBasic.FormatFont Points:="16" Case "LARGE" WordBasic.FormatFont Points:="20" Case "huge" WordBasic.FormatFont Points:="24" Case "Huge" WordBasic.FormatFont Points:="28" Case Else End Select End Sub Private Sub defformat(n$) Select Case n$ Case xnormal$ WordBasic.FormatStyle Name:="Standard", BasedOn:=xnoformat$, NextStyle:="Standard", Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara LeftIndent:="0 cm", RightIndent:="0 cm", Before:="0 pt", After:="0 pt", LineSpacingRule:=0, LineSpacing:="", Alignment:=3, WidowControl:=1, KeepWithNext:=0, KeepTogether:=0, PageBreak:=0, NoLineNum:=0, DontHyphen:=0, Tab:="0", FirstIndent:="12 pt" WordBasic.FormatDefineStyleLang Language:=xlanguage$ Case "_" + xhead$ + " 1" WordBasic.FormatStyle Name:="_" + xhead$ + " 1", BasedOn:=xhead$ + " 1", NextStyle:=xnormal$, Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara FirstIndent:="0 pt" Case "_" + xhead$ + " 2" WordBasic.FormatStyle Name:="_" + xhead$ + " 2", BasedOn:=xhead$ + " 2", NextStyle:=xnormal$, Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara FirstIndent:="0 pt" Case "_" + xhead$ + " 3" WordBasic.FormatStyle Name:="_" + xhead$ + " 3", BasedOn:=xhead$ + " 3", NextStyle:=xnormal$, Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara FirstIndent:="0 pt" Case "_" + xhead$ + " 4" WordBasic.FormatStyle Name:="_" + xhead$ + " 4", BasedOn:=xhead$ + " 4", NextStyle:=xnormal$, Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara FirstIndent:="0 pt" Case "xskip" WordBasic.FormatStyle Name:="xskip", BasedOn:=xnormal$, NextStyle:=xnormal$, Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara Before:="0 pt", FirstIndent:="0 pt", LineSpacingRule:=4, LineSpacing:="4 pt" Case "paragraph" WordBasic.FormatStyle Name:="paragraph", BasedOn:=xnormal$, NextStyle:=xnormal$, Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara FirstIndent:="0 pt" Case "subparagraph" WordBasic.FormatStyle Name:="subparagraph", BasedOn:=xnormal$, NextStyle:=xnormal$, Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara FirstIndent:="12 pt" Case "Zitat" WordBasic.FormatStyle Name:="Zitat", BasedOn:=xnormal$, NextStyle:="Zitat", Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara Before:="0 pt", After:="0 pt", LeftIndent:="24 pt", RightIndent:="24 pt", FirstIndent:="0 pt" Case "Abstract" WordBasic.FormatStyle Name:="Abstract", BasedOn:=xnormal$, NextStyle:="Abstract", Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara Before:="0 pt", After:="0 pt", LeftIndent:="24 pt", RightIndent:="24 pt", FirstIndent:="12 pt" WordBasic.FormatDefineStyleFont Points:=9, Italic:=1 Case "Abbildung" WordBasic.FormatStyle Name:="Abbildung", BasedOn:=xnormal$, NextStyle:=xnormal$, Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara Before:="0 pt", After:="0 pt", WidowControl:=0, KeepWithNext:=1, KeepTogether:=1, Alignment:=1, FirstIndent:="0 pt" Case "Enumerate" WordBasic.FormatStyle Name:="Enumerate", BasedOn:=xnormal$, NextStyle:="Enumerate", Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara LeftIndent:="12 pt", FirstIndent:="-12 pt" Case "Datum" WordBasic.FormatStyle Name:="Datum", BasedOn:=xnormal$, NextStyle:=xnormal$, Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara FirstIndent:="0 pt", Alignment:=1, KeepTogether:=1, DontHyphen:=1 WordBasic.FormatDefineStyleFont Points:="18", Bold:=1 Case "Autor" WordBasic.FormatStyle Name:="Autor", BasedOn:=xnormal$, NextStyle:=xnormal$, Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara FirstIndent:="0 pt", Alignment:=1, KeepTogether:=1, DontHyphen:=1 WordBasic.FormatDefineStyleFont Points:="22", Bold:=1 Case "Haupttitel" WordBasic.FormatStyle Name:="Haupttitel", BasedOn:=xnormal$, NextStyle:=xnormal$, Type:=0, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStylePara FirstIndent:="0 pt", Alignment:=1, KeepTogether:=1, DontHyphen:=1 WordBasic.FormatDefineStyleFont Points:="26", Bold:=1 Case "Fehlermeldung" WordBasic.FormatStyle Name:="Fehlermeldung", BasedOn:=xnormfont$, Type:=1, AddToTemplate:=0, Define:=1 WordBasic.FormatDefineStyleFont Color:=6, Bold:=1 Case Else End Select End Sub Rem ******************************** Utils Private Sub fehlermeldung(x$) xStyle "Fehlermeldung" WordBasic.Insert x$ xStyle xnormfont$ End Sub Private Function isOption(opt$) isOption = inList(xoptions$, opt$) End Function Private Function inList(list$, elem$) If InStr(list$, xListSep$ + elem$ + xListSep$) > 0 Then inList = -1 Else inList = 0 End If End Function Private Function lcar$(l$) Dim ll Dim sl Dim x lcar$ = "" ll = Len(l$) sl = Len(xListSep$) If ll > 2 * sl Then x = InStr(1 + sl, l$, xListSep$) If x > 0 Then lcar$ = Mid(l$, 1 + sl, x - sl - 1) End If End If End Function Private Function lcdr$(l$) Dim ll Dim sl Dim x Dim y lcdr$ = "" ll = Len(l$) sl = Len(xListSep$) If ll > 2 * sl Then x = InStr(1 + sl, l$, xListSep$) If x > 0 And ll > x + sl Then y = InStr(x + sl, l$, xListSep$) If y > 0 Then lcdr$ = Mid(l$, x) End If End If End If End Function Private Function rept$(z$, n) Dim m Dim x$ m = 1 x$ = "" While m <= n x$ = x$ + z$ m = m + 1 Wend rept$ = x$ End Function Private Function extractText$() WordBasic.EditSelectAll WordBasic.CharLeft 1, 1 extractText$ = WordBasic.[LTrim$](WordBasic.[RTrim$](WordBasic.[GetText$](WordBasic.GetSelStartPos(), WordBasic.GetSelEndPos()))) End Function Private Function extractArg$(f$, s$, t$, fs$, rs$) clearScrap (s$) If t$ = "" Then WordBasic.EditPaste Else WordBasic.Insert t$ End If If fs$ <> "" And rs$ <> "\\all\\" Then replpm fs$, rs$ extractArg$ = extractText$ If f$ <> "" Then WordBasic.Activate f$ End Function Private Function extractArg_(f$, s$, t$, fs$, rs$) Dim xxx$ If rs$ = "" Then extractArg_ = 0 Else clearScrap (s$) If t$ = "" Then WordBasic.EditPaste Else WordBasic.Insert t$ End If If fs$ <> "" Then replpm fs$, rs$ xxx$ = extractText$ If xxx$ = "" Then extractArg_ = 0 Else extractArg_ = WordBasic.Val(xxx$) End If End If If f$ <> "" Then WordBasic.Activate f$ End Function Private Function countInStr(s$, f$) Dim x Dim p Dim c Dim fl x = 1 p = 1 c = 0 fl = Len(f$) While x > 0 x = InStr(p, s$, f$) If x > 0 Then c = c + 1 p = p + fl End If Wend countInStr = c End Function Private Sub balance(bo$, bc$) Dim pa Dim pe Dim ende Dim bol Dim bcl Dim f Dim level pa = WordBasic.GetSelStartPos() pe = WordBasic.GetSelEndPos() WordBasic.EditSelectAll ende = WordBasic.GetSelEndPos() bol = Len(bo$) bcl = Len(bc$) f = -1 level = 0 WordBasic.SetSelRange pa, pe While f If WordBasic.[GetText$](pe, pe + bol) = bo$ Then level = level + 1 pe = pe + bol Else If WordBasic.[GetText$](pe, pe + bcl) = bc$ Then If level = 0 Then f = 0 WordBasic.SetSelRange pa, pe Else level = level - 1 pe = pe + bcl End If Else If pe > ende Then f = 0 Else pe = pe + 1 End If End If End If Wend End Sub Private Function whichSP$(m$, fs$) If inList(xexact$, m$) Then whichSP$ = fs$ + "\{" Else whichSP$ = fs$ + "\{(*)\}" End If End Function Private Sub doTheCut(m$) If inList(xexact$, m$) Then WordBasic.WW6_EditClear balance "{", "}" WordBasic.EditCut WordBasic.WW6_EditClear Else WordBasic.EditCut End If End Sub Private Sub replCmd(n$) replpm "\\" + n$ + "\{(*)\}", "\1" End Sub Private Sub delCmd(n$) replpm "\\" + n$ + "\{\}", "" replpm "\\" + n$ + "\{(*)\}", "" replpm "\\" + n$ + " @([! ])", "\1" End Sub Private Sub stripCmd(a$) Dim fs$ fs$ = ("\" + a$ + "{") finde (fs$) While WordBasic.EditFindFound() WordBasic.WW6_EditClear balance "{", "}" WordBasic.CharRight WordBasic.WW6_EditClear finde (fs$) Wend End Sub Private Sub repl(n$, l$) WordBasic.EditReplace Find:=n$, Replace:=l$, Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, ReplaceAll:=1, Format:=0, Wrap:=1 End Sub Private Sub replc(n$, l$) WordBasic.EditReplace Find:=n$, Replace:=l$, Direction:=0, MatchCase:=1, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, ReplaceAll:=1, Format:=0, Wrap:=1 End Sub Private Sub replpm(n$, l$) WordBasic.EditReplace Find:=n$, Replace:=l$, Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=1, SoundsLike:=0, ReplaceAll:=1, Format:=0, Wrap:=1 End Sub Private Sub replpmf(n$, l$) WordBasic.EditReplace Find:=n$, Replace:=l$, Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=1, SoundsLike:=0, ReplaceAll:=1, Format:=1, Wrap:=1 End Sub Private Sub replf(n$, l$) WordBasic.EditReplace Find:=n$, Replace:=l$, Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, ReplaceAll:=1, Format:=1, Wrap:=1 End Sub Private Sub replFontStyle(n$) If inList(xtxtstyles$, n$) Then finde "\" + n$ If WordBasic.EditFindFound() Then WordBasic.StartOfDocument doReplFontStyle "\" + n$ + "{", n$, 0, 1 doReplFontStyle "{\" + n$, n$, 0, 2 doReplFontStyle "\" + n$ + " ", n$, 0, 0 doReplFontStyle "\\" + n$ + "[!a-zA-Z]", n$, -1, 3 End If End If End Sub Private Sub doReplFontStyle(fs$, n$, pm, mode) If pm Then findepm (fs$) Else finde (fs$) End If While WordBasic.EditFindFound() If mode = 3 Then WordBasic.CharLeft 1, 1 WordBasic.WW6_EditClear If mode = 2 Then WordBasic.Insert "\@pg{" balance "{", "}" textFormat (n$) WordBasic.CharRight 1 If mode = 1 Then WordBasic.WW6_EditClear If pm Then findepm (fs$) Else finde (fs$) End If Wend End Sub Private Sub findepm(f$) WordBasic.EditFind Find:=f$, Replace:="", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=1, SoundsLike:=0, Format:=0, Wrap:=1 End Sub Private Sub finde(f$) WordBasic.EditFind Find:=f$, Replace:="", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, Format:=0, Wrap:=1 End Sub Private Sub findtxt(mode$, fs$) Dim pm Dim tf Dim fo Dim ca Dim wo Dim ri If InStr(mode$, "p") > 0 Then pm = 1 Else pm = 0 If InStr(mode$, "e") > 0 Then tf = 0 Else tf = 1 If InStr(mode$, "f") > 0 Then fo = 1 Else fo = 0 If InStr(mode$, "c") > 0 Then ca = 1 Else ca = 0 If InStr(mode$, "w") > 0 Then wo = 1 Else wo = 0 If InStr(mode$, "u") > 0 Then ri = 1 Else ri = 0 WordBasic.EditFind Find:=fs$, Direction:=ri, MatchCase:=ca, WholeWord:=wo, PatternMatch:=pm, SoundsLike:=0, Format:=fo, Wrap:=tf End Sub Private Function findearg$(fs$, r$, fdel) Dim f$ Dim s$ f$ = WordBasic.[WindowName$]() findearg$ = "" findepm (fs$) If WordBasic.EditFindFound() Then s$ = newScrap$ If fdel Then WordBasic.EditCut Else WordBasic.EditCopy End If findearg$ = extractArg$(f$, s$, "", fs$, r$) releaseScrap s$ End If End Function Private Function findearg_(fs$, r$, missingvalue, fdel) Dim f$ Dim s$ f$ = WordBasic.[WindowName$]() findearg_ = missingvalue findepm (fs$) If WordBasic.EditFindFound() Then s$ = newScrap$ If fdel Then WordBasic.EditCut Else WordBasic.EditCopy End If findearg_ = extractArg_(f$, s$, "", fs$, r$) releaseScrap s$ End If End Function Private Sub replspecial(a$) repl "\" + a$, "3" repl a$, "" repl "3", a$ End Sub Rem ******************************** Scrap Private Function newScrap$() Dim n Dim f$ n = InStr(xscraplist$, ",") If n > 0 Then newScrap$ = WordBasic.[Left$](xscraplist$, n - 1) If n = Len(xscraplist$) Then xscraplist$ = "" Else xscraplist$ = Mid(xscraplist$, n + 1) End If Else f$ = WordBasic.[WindowName$]() WordBasic.FileNewDefault newScrap$ = WordBasic.[WindowName$]() WordBasic.Activate f$ End If End Function Private Sub clearScrap(s$) WordBasic.Activate s$ WordBasic.EditSelectAll WordBasic.WW6_EditClear End Sub Private Sub releaseScrap(s$) xscraplist$ = s$ + "," + xscraplist$ End Sub Private Sub initScrap() xscraplist$ = "" End Sub Private Sub exitScrap() Dim n Dim a$ n = InStr(xscraplist$, ",") While n > 0 a$ = WordBasic.[Left$](xscraplist$, n - 1) If n = Len(xscraplist$) Then xscraplist$ = "" Else xscraplist$ = Mid(xscraplist$, n + 1) End If schliesse a$ n = InStr(xscraplist$, ",") Wend End Sub Rem ******************************** Files & Fenster Private Sub schliesse(f$) WordBasic.Activate f$ WordBasic.DocClose 2 End Sub Private Sub saveWrdFile() Dim x$ x$ = WordBasic.[FileName$]() WordBasic.FileSaveAs Name:=WordBasic.[Left$](x$, Len(x$) - 3) + "doc", Format:=0, LockAnnot:=0, Password:="", AddToMru:=1, WritePassword:="", RecommendReadOnly:=0, EmbedFonts:=0, NativePictureFormat:=0, FormsData:=0 End Sub Private Function auxFilename$(e$) Dim f$ Dim x$ f$ = WordBasic.[WindowName$]() x$ = WordBasic.[FileName$]() x$ = WordBasic.[Left$](x$, Len(x$) - 3) + e$ If WordBasic.[Files$](x$) <> "" Then WordBasic.FileOpen Name:=x$, ConfirmConversions:=0, ReadOnly:=0, AddToMru:=0, PasswordDoc:="", PasswordDot:="", Revert:=0, WritePasswordDoc:="", WritePasswordDot:="" auxFilename$ = WordBasic.[WindowName$]() ElseIf xmaster$ <> "" Then x$ = WordBasic.[Left$](xmaster$, Len(xmaster$) - 3) + e$ If WordBasic.[Files$](x$) <> "" Then WordBasic.FileOpen Name:=x$, ConfirmConversions:=0, ReadOnly:=0, AddToMru:=0, PasswordDoc:="", PasswordDot:="", Revert:=0, WritePasswordDoc:="", WritePasswordDot:="" auxFilename$ = WordBasic.[WindowName$]() Else auxFilename$ = openMissingFile$(f$, x$, 0) End If End If WordBasic.Activate f$ End Function Private Function openMissingFile$(f$, fn$, cf) Dim hd Dim Dlg As Object Dim x openMissingFile$ = "" If xfomode$ = "manager" Then hd = InStr(fn$, ":") Set Dlg = WordBasic.DialogRecord.FileFind(False) If hd > 0 Then Dlg.SearchPath = WordBasic.[Left$](fn$, hd) Dlg.SubDir = 1 Else Set Dlg = WordBasic.DialogRecord.FileOpen(False) End If Dlg.Name = WordBasic.[FileNameInfo$](fn$, 3) x = WordBasic.Dialog.FileOpen(Dlg) If x <> 0 Then WordBasic.FileOpen Name:=Dlg.Name, ConfirmConversions:=0, ReadOnly:=0, AddToMru:=0, PasswordDoc:="", PasswordDot:="", Revert:=0, WritePasswordDoc:="", WritePasswordDot:="" openMissingFile$ = WordBasic.[WindowName$]() If cf Then WordBasic.EditSelectAll WordBasic.EditCopy WordBasic.FileClose 2 End If WordBasic.Activate f$ End If End Function Rem ******************************** Convert Private Sub shrinkTeX() Dim a$ Dim b$ repl "\ldots", xldots$ Rem repl("\ldots\ ", "... ") Rem repl("\ldots\" + xr$, "... ") Rem repl("\ldots", "...") languageSpecificChars repl "``", Chr(34) repl "''", Chr(34) repl "`", "'" Rem repl("'", "'") repl "---", xb$ repl "--", xb$ repl "~", xs$ repl xr$ + xr$, xxz$ + xxr$ repl xr$, xxz$ repl "\%", xxtmp$ replpm "%*" + xxz$, "" repl xxtmp$, "%" repl xxz$, " " repl xt$, " " repl "\\", xxz$ Rem repl("\\", xxtmp$) Rem repl("\ ", " ") Rem repl(xxtmp$, "\\") Rem replpm(" {2;}([! ])", " \1") replpm "([! ]) @([! ])", "\1 \2" If isOption("checkpara") Then a$ = lcar$(xchkpb$) b$ = lcdr$(xchkpb$) While a$ <> "" replpm "(\\" + a$ + "\{)", xxr$ + "\1" a$ = lcar$(b$) b$ = lcdr$(b$) Wend a$ = lcar$(xchkpa$) b$ = lcdr$(xchkpa$) While a$ <> "" replpm "(\\" + a$ + "\{*\})", "\1" + xxr$ a$ = lcar$(b$) b$ = lcdr$(b$) Wend End If repl xxr$ + " ", xxr$ repl " " + xxr$, xxr$ replpm xxr$ + "@([!" + xxr$ + "])", xxr$ + "\1" repl xxr$, xr$ repl "\textasciitilde{}", "~" Rem repl(xxz$, xr$) replpm "([!\\])\{(?)\}", "\1\2" ' replace {c} with c replpm "([!\\])\{\}", "\1" ' replace {} with nothing End Sub Rem ******************************** language specific chars Private Sub languageSpecificChars() If isOption("germsty") Then repl Chr(34) + "|", "" repl Chr(34) + Chr(34), "" repl Chr(34) + "`", Chr(34) repl Chr(34) + "'", Chr(34) If xplattform$ = "mac" Then replc Chr(34) + "a", "Š" replc Chr(34) + "o", "š" replc Chr(34) + "u", "Y" replc Chr(34) + "A", "€" replc Chr(34) + "O", "…" replc Chr(34) + "U", "†" replc Chr(34) + "s", "§" replc Chr(34) + "S", "SS" Else replc Chr(34) + "a", "ä" replc Chr(34) + "o", "ö" replc Chr(34) + "u", "ü" replc Chr(34) + "A", "Ä" replc Chr(34) + "O", "Ö" replc Chr(34) + "U", "Ü" replc Chr(34) + "s", "ß" replc Chr(34) + "S", "SS" End If ElseIf isOption("~~~") Then Rem ~~~ End If If LCase(WordBasic.[Left$](xlanguage$, 7)) = "croatia" Then replc "¹", "š" replc "©", "Š" replc "¾", "ž" replc "®", "Ž" End If End Sub Rem ******************************** Titel Private Sub maketitle() Dim ftitel$ Dim fautor$ Dim fdate$ Dim xdocstyle$ finde "\maketitle" If WordBasic.EditFindFound() Then ftitel$ = findearg$("\\title\{(*)\}", "\1", -1) If ftitel$ = "" Then ftitel$ = findearg$("\\titel\{(*)\}", "\1", -1) End If fautor$ = findearg$("\\author\{(*)\}", "\1", -1) If fautor$ = "" Then fautor$ = findearg$("\\verfasser\{(*)\}", "\1", -1) End If fdate$ = findearg$("\\date\{(*)\}", "\1", -1) If fdate$ = "" Then fdate$ = findearg$("\\datum\{(*)\}", "\1", -1) If fdate$ = "" Then fdate$ = WordBasic.[Date$]() End If finde "\maketitle" WordBasic.WW6_EditClear WordBasic.InsertPara xStyle "Haupttitel" WordBasic.Insert ftitel$ WordBasic.InsertPara xStyle "Autor" WordBasic.Insert fautor$ WordBasic.InsertPara xStyle "Datum" WordBasic.Insert fdate$ WordBasic.InsertPara If xdocstyle$ = "article" Then WordBasic.InsertPara Else WordBasic.InsertPageNumbers FirstPage:=0 WordBasic.InsertBreak Type:=0 End If End If End Sub Rem ******************************** Bilder Private Sub bilder() replBilder "\\bildc\{*\}\{*\}\{(*)\}\{(*)\}", "2", "1" replBilder "\\epsabbp\[*\]\{(*)\}\{(*)\}", "2", "1" replBilder "\\epsabbp\{(*)\}\{(*)\}", "2", "1" replBilder "\\epsabb\[*\]\{(*)\}\{(*)\}", "2", "1" replBilder "\\epsabb\{(*)\}\{(*)\}", "2", "1" replBilder "\\includegraphics\{(*)\}", "", "1" End Sub Private Sub replBilder(fs$, cap$, fi$) Dim f$ Dim dir_$ Dim s1$ Dim f_ Dim konvf Dim x$ Dim caption_$ Dim fn0$ Dim fn$ Dim fnn$ Dim fpp$ Dim ff Dim pp$ f$ = WordBasic.[WindowName$]() dir_$ = WordBasic.[FileNameInfo$](WordBasic.[FileName$](), 5) s1$ = newScrap$ f_ = -1 If WordBasic.FileConfirmConversions() = 0 Then WordBasic.FileConfirmConversions 1 konvf = 0 End If While f_ findepm (fs$) If WordBasic.EditFindFound() Then x$ = WordBasic.[GetText$](WordBasic.GetSelStartPos(), WordBasic.GetSelEndPos()) WordBasic.WW6_EditClear If cap$ <> "" Then caption_$ = extractArg$("", s1$, x$, fs$, "\" + cap$) fn0$ = extractArg$(f$, s1$, x$, fs$, "\" + fi$) fn$ = dir_$ + fn0$ fnn$ = fn$ fpp$ = Mid(xpicformats$, 2) ff = InStr(fpp$, ",") While ff > 0 And fpp$ <> "" And WordBasic.[Files$](fnn$) = "" pp$ = WordBasic.[Left$](fpp$, ff - 1) fpp$ = Mid(fpp$, ff + 1) fnn$ = fn$ + "." + pp$ ff = InStr(fpp$, ",") Wend If cap$ <> "" Then WordBasic.InsertPara pseudoLabel xpregraph$ + fn0$, xcapfig$ WordBasic.InsertCaption Label:=xcapfig$, Title:=" " + caption_$, Position:=1 End If WordBasic.InsertPara If WordBasic.[Files$](fnn$) <> "" Then WordBasic.InsertPicture Name:=fnn$, LinkToFile:=xembpic$ Else fehlermeldung "*** picture not found: " + fn0$ + " ***" End If xStyle "Abbildung" Else f_ = 0 End If Wend If konvf = 0 Then WordBasic.FileConfirmConversions 0 releaseScrap s1$ WordBasic.Activate f$ End Sub Rem ******************************** Convert: Headings Private Sub replHeadings(n$, ll$) Dim s$ Dim f$ Dim fs$ Dim l$ s$ = newScrap$ f$ = WordBasic.[WindowName$]() fs$ = whichSP$("headings", "\\" + n$) l$ = xhead$ + " " + ll$ doReplHeadings f$, s$, fs$, ll$, l$ fs$ = whichSP$("headings", "\\" + n$ + "\*") l$ = "_" + xhead$ + " " + ll$ doReplHeadings f$, s$, fs$, ll$, l$ releaseScrap (s$) WordBasic.Activate f$ End Sub Private Sub doReplHeadings(f$, s$, fs$, ll$, l$) Dim rs$ Dim h$ findepm (fs$) While WordBasic.EditFindFound() If inList(xexact$, "headings") Then WordBasic.WW6_EditClear balance "{", "}" WordBasic.EditCut WordBasic.WW6_EditClear rs$ = "\\all\\" Else WordBasic.EditCut rs$ = "\1" End If h$ = extractArg$(f$, s$, "", fs$, rs$) xStyle l$ pseudoLabel ll$, xhead$ WordBasic.Insert h$ WordBasic.ParaDown 1 WordBasic.FormatParagraph FirstIndent:="0 cm" findepm (fs$) Wend End Sub Rem ******************************** Convert: Environments Private Sub replEnv(n$, l$) WordBasic.EditReplaceClearFormatting rStyle l$ WordBasic.EditReplace Find:="\\begin\{" + n$ + "\}(*)\\end\{" + n$ + "\}", Replace:="\1", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=1, SoundsLike:=0, ReplaceAll:=1, Format:=1, Wrap:=1 WordBasic.EditReplaceClearFormatting End Sub Rem ******************************** Convert: Footnotes Private Sub replFootnotes() WordBasic.StartOfDocument finde "\footnote{" While WordBasic.EditFindFound() WordBasic.WW6_EditClear balance "{", "}" WordBasic.EditCut WordBasic.WW6_EditClear WordBasic.InsertFootnote Reference:="", NoteType:=0 WordBasic.EditPaste WordBasic.ClosePane finde "\footnote{" Wend End Sub Rem ******************************** Convert: Cites Private Sub replCites() Dim f$ Dim bbl$ f$ = WordBasic.[WindowName$]() If xbbl$ = "" Then bbl$ = auxFilename$("bbl") ElseIf xbbl$ = "*nobbl*" Then bbl$ = "" Else bbl$ = xbbl$ End If If bbl$ <> "" Then WordBasic.Activate bbl$ repl "%" + xr$, "" languageSpecificChars WordBasic.StartOfDocument WordBasic.Activate f$ If isOption("recite") Then revertOldCites Rem % \citeyearNP[postfix]{keys} Rem % produces Year1, ..., YearN, postfix If inList(xcitecmds$, "citeyearNP") Then replCiteCmd "citeyearNP", "y", bbl$, "", "" Rem % \citeyear[postfix]{keys} Rem % produces (Year1, ..., YearN, postfix) If inList(xcitecmds$, "scite") Then replCiteCmd "scite", "y", bbl$, xcitelb$, xciterb$ If inList(xcitecmds$, "citeyear") Then replCiteCmd "citeyear", "y", bbl$, xcitelb$, xciterb$ Rem % \citeauthor{keys} Rem % \fullciteauthor{keys} Rem % \shortciteauthor{keys} Rem % produces Authors1, ..., AuthorN If inList(xcitecmds$, "citeauthor") Then replCiteCmd "citeauthor", "a", bbl$, "", "" If inList(xcitecmds$, "fullciteauthor") Then replCiteCmd "fullciteauthor", "a", bbl$, "", "" If inList(xcitecmds$, "shortciteauthor") Then replCiteCmd "shortciteauthor", "a", bbl$, "", "" Rem % \citeA[postfix]{keys} Rem % \fullciteA[postfix]{keys} Rem % \shortciteA[postfix]{keys} Rem % produces Authors1 (Year1), ..., AuthorN (YearN, postfix) If inList(xcitecmds$, "citeA") Then replCiteCmd "citeA", "ab", bbl$, "", "" If inList(xcitecmds$, "fullciteA") Then replCiteCmd "fullciteA", "ab", bbl$, "", "" If inList(xcitecmds$, "shortciteA") Then replCiteCmd "shortciteA", "ab", bbl$, "", "" Rem % \citeNP[postfix]{keys} Rem % \fullciteNP[postfix]{keys} Rem % \shortciteNP[postfix]{keys} Rem % writes \citation{keys} on .aux Rem % produces prefix Authors1, Year1; Authors2, Year2; ..., postfix If inList(xcitecmds$, "citeNP") Then replCiteCmd "citeNP", "ad", bbl$, "", "" If inList(xcitecmds$, "fullciteNP") Then replCiteCmd "fullciteNP", "ad", bbl$, "", "" If inList(xcitecmds$, "shortciteNP") Then replCiteCmd "shortciteNP", "ad", bbl$, "", "" Rem % \cite[postfix]{keys} Rem % \fullcite[postfix]{keys} Rem % \shortcite[postfix]{keys} Rem % produces (prefix Authors1, Year1; Authors2, Year2; ..., postfix) If inList(xcitecmds$, "cite") Then replCiteCmd "cite", "ad", bbl$, xcitelb$, xciterb$ If inList(xcitecmds$, "fullcite") Then replCiteCmd "fullcite", "ad", bbl$, xcitelb$, xciterb$ If inList(xcitecmds$, "shortcite") Then replCiteCmd "shortcite", "ad", bbl$, xcitelb$, xciterb$ schliesse (bbl$) End If End Sub Private Sub revertOldCites() Dim n Dim ll$ If xcitec > 0 Then For n = 0 To xcitec - 1 ll$ = defineLabelName$("cite", n) If WordBasic.ExistingBookmark(ll$) Then WordBasic.EditBookmark Name:=ll$, GoTo:=1 WordBasic.EditBookmark Name:=ll$, Delete:=1 WordBasic.WW6_EditClear WordBasic.Insert xcites__$(n) End If Next End If xcitec = 0 End Sub Private Function citefs$(cp, cc$) Select Case cp Case 1 citefs$ = "\\" + cc$ + "\<(*)\>\[(*)\]\{(*)\}" Case 2 citefs$ = "\\" + cc$ + "\<(*)\>\{(*)\}" Case 3 citefs$ = "\\" + cc$ + "\[(*)\]\{(*)\}" Case 4 citefs$ = "\\" + cc$ + "\{(*)\}" Case Else citefs$ = "" End Select End Function Private Function citers$(cp) Select Case cp Case 1 ' "\\" + cc$ + "\<(*)\>\[(*)\]\{(*)\}" citers$ = "\1 \3, \2" Case 2 ' "\\" + cc$ + "\<(*)\>\{(*)\}" citers$ = "\1 \2" Case 3 ' "\\" + cc$ + "\[(*)\]\{(*)\}" citers$ = "\2, \1" Case 4 ' "\\" + cc$ + "\{(*)\}" citers$ = "\1" Case Else citers$ = "" End Select End Function Private Function citeid$(cp) Select Case cp Case 1 ' "\\" + cc$ + "\<(*)\>\[(*)\]\{(*)\}" citeid$ = "\3" Case 2 ' "\\" + cc$ + "\<(*)\>\{(*)\}" citeid$ = "\2" Case 3 ' "\\" + cc$ + "\[(*)\]\{(*)\}" citeid$ = "\2" Case 4 ' "\\" + cc$ + "\{(*)\}" citeid$ = "\1" Case Else citeid$ = "" End Select End Function Private Function citepattern(s$, t$, citecmd$) Dim f$ Dim cp Dim n Dim fs$ f$ = WordBasic.[WindowName$]() clearScrap (s$) cp = 0 If xcitemode$ = "apacite.sty" Then n = 1 Else n = 3 If t$ = "" Then WordBasic.EditPaste Else WordBasic.Insert t$ While cp = 0 And n < 5 fs$ = citefs$(n, citecmd$) findepm (fs$) If WordBasic.EditFindFound() Then cp = n Else n = n + 1 Wend citepattern = cp WordBasic.Activate f$ End Function Private Sub replCiteCmd(citecmd$, mode$, aux$, bo$, bc$) Dim f$ Dim s1$ Dim s2$ Dim ffs$ Dim cite$ Dim cp Dim fs$ Dim rs$ Dim id$ Dim id1$ Dim f1 Dim c$ Dim x$ Dim cc$ Dim pa Dim pe Dim cm$ f$ = WordBasic.[WindowName$]() s1$ = newScrap$ s2$ = newScrap$ ffs$ = "\\" + citecmd$ + "[\<\[\{]*\}" findepm (ffs$) While WordBasic.EditFindFound() WordBasic.EditCopy cite$ = extractArg$("", s1$, "", "", "") cp = citepattern(s1$, cite$, citecmd$) If cp > 0 Then fs$ = citefs$(cp, citecmd$) rs$ = citers$(cp) id$ = citeid$(cp) id1$ = extractArg$("", s1$, cite$, fs$, id$) clearScrap (s1$) WordBasic.Insert id1$ WordBasic.StartOfDocument f1 = -1 c$ = "" While f1 findepm "*," If WordBasic.EditFindFound() Then WordBasic.CharLeft 1, 1 x$ = WordBasic.[GetText$](WordBasic.GetSelStartPos(), WordBasic.GetSelEndPos()) WordBasic.WW6_EditClear WordBasic.WW6_EditClear c$ = c$ + getCiteName$(mode$, aux$, s2$, x$) + xccc$ Else WordBasic.EndOfLine 1 WordBasic.CharLeft 1, 1 x$ = WordBasic.[GetText$](WordBasic.GetSelStartPos(), WordBasic.GetSelEndPos()) c$ = c$ + getCiteName$(mode$, aux$, s2$, x$) WordBasic.WW6_EditClear f1 = 0 End If Wend WordBasic.EditSelectAll WordBasic.WW6_EditClear WordBasic.Insert cite$ replpm fs$, rs$ finde (id1$) WordBasic.WW6_EditClear WordBasic.Insert c$ repl xr$, " " If xcitemode$ = "apacite.sty" Then apaciteSpecials cc$ = extractText$ WordBasic.Activate f$ WordBasic.WW6_EditClear If isOption("recite") Then pa = WordBasic.GetSelStartPos() End If WordBasic.Insert bo$ + cc$ + bc$ If isOption("recite") And xcitec <= xcitemax Then pe = WordBasic.GetSelStartPos() WordBasic.SetSelRange pa, pe cm$ = defineLabelName$("cite", xcitec) xcites__$(xcitec) = cite$ xcitec = xcitec + 1 WordBasic.EditBookmark Name:=cm$, Add:=1 End If End If findepm (ffs$) Wend releaseScrap (s1$) releaseScrap (s2$) End Sub Private Function getCiteName$(mode$, aux$, scrap$, id$) Dim f$ Dim fstr$ Dim r$ f$ = WordBasic.[WindowName$]() WordBasic.Activate aux$ fstr$ = "\\bibitem\[[!\]]@\]\{" + id$ + "\}" findepm (fstr$) WordBasic.EditCopy clearScrap (scrap$) WordBasic.EditPaste If xcitemode$ = "apacite.sty" Then Select Case mode$ Case "y" fstr$ = "\\bibitem\[*\{*\}\{*\}\{(*)\}\]\{" + id$ + "\}" r$ = "\1" Case "ab" fstr$ = "\\bibitem\[*\{(*)\}\{*\}\{(*)\}\]\{" + id$ + "\}" r$ = "\1 " + xcitelb$ + "\2" + xciterb$ Case "a" fstr$ = "\\bibitem\[*\{(*)\}\{*\}\{*\}\]\{" + id$ + "\}" r$ = "\1" Case Else fstr$ = "\\bibitem\[*\{(*)\}\{*\}\{(*)\}\]\{" + id$ + "\}" r$ = "\1" + xcay$ + "\2" End Select Else fstr$ = "\\bibitem\[(*)\]\{" + id$ + "\}" r$ = "\1" End If replpm fstr$, r$ getCiteName$ = extractText$ WordBasic.Activate f$ End Function Private Sub apaciteSpecials() repl "\protect", "" repl "\BPGS", "S." repl "\BPG", "S." repl "\BBA{}", "/" repl "\BAAC{}", "/" repl "\BCBL{}", "" repl "\BCnt{1}", "a" repl "\BCnt{2}", "b" repl "\BCnt{3}", "c" repl "\BCnt{4}", "d" repl "\BCnt{5}", "e" repl "\BCnt{6}", "f" repl "\BCnt{7}", "g" repl "\BCnt{8}", "h" repl "\BCnt{9}", "i" repl "\BOthers", "et al." repl "{", "" repl "}", "" End Sub Private Sub apaciteBBL() repl "\begin{thebibliography}{}", "" repl "\end{thebibliography}", "" shrinkTeX repl "\newblock", "" repl "\tped", ": " repl "\tautor", " " repl "\tbo", ". " repl "\tbc", " " repl "\BBOP", "(" repl "\BBCP", ")" repl "\tdate", ": " repl "\tajv", " " repl "\tavp", ": " repl "\tctp", "" repl "\BBOQ", "" repl "\BBCQ", "" repl "\BCBT", "" repl "\BCBL", " " repl "\tIn", " in: " repl "\&", "&" repl " .", "." If LCase(WordBasic.[Left$](xlanguage$, 7)) = "deutsch" Then If xplattform$ = "mac" Then repl "\BUPhD", "Unveršffentlichte Dissertation" Else repl "\BUPhD", "Unveröffentlichte Dissertation" End If repl "\BVOL", "Bd. " repl "\BNUM", "Nr. " repl "\BEDS", "Hg." repl "\BED", "Hg." ElseIf LCase(WordBasic.[Left$](xlanguage$, 7)) = "english" Then repl "\BUPhD", "Unpublished Dissertation" repl "\BVOL", "Vol. " repl "\BNUM", "Nr. " repl "\BEDS", "Eds." repl "\BED", "Ed." ElseIf xlanguage$ = "~~~" Then repl "\BUPhD", "~~~" ' "Unpublished Dissertation" repl "\BVOL", "~~~" ' "Vol. " repl "\BNUM", "~~~" ' "Nr. " repl "\BEDS", "~~~" ' "Eds." repl "\BED", "~~~" ' "Ed." Else newLang1 "lang" End If repl "\Bem", "" Rem replpm("\\Bem\{(*)\}", "\1") replpm "\\bibitem\[*\]\{*\}", "" apaciteSpecials End Sub Rem ******************************** Convert: Labels, Refs Private Sub updateLabPos() Dim n Rem On Error Goto fehler For n = 0 To nlab - 1 If WordBasic.ExistingBookmark(lablab__$(n)) Then WordBasic.EditBookmark Name:=lablab__$(n), GoTo:=1 labpos__(n) = WordBasic.GetSelStartPos() End If Next Rem Goto weiter Rem fehler: Rem BeginnDokument Rem For n = 0 To nlab - 1 Rem EinfYgen labname$(n) + " " + lablab$(n) Rem EinfYgenAbsatz Rem Next Rem weiter: Rem On Error Goto 0 End Sub Private Sub pseudoLabel(n$, type_$) Dim x$ Select Case type_$ Case xhead$ x$ = "hd" Case xcapfig$ x$ = "fig" Case xcaptab$ x$ = "tab" Case Else x$ = type_$ End Select WordBasic.Insert "\@" + x$ + "{" + n$ + "}" End Sub Private Function defineLabelName$(type_$, n) Dim fn$ Dim x Dim x_$ fn$ = WordBasic.[FileNameInfo$](WordBasic.[FileName$](), 3) x = InStr(fn$, ".") If x > 0 Then fn$ = WordBasic.[Left$](fn$, x - 1) x_$ = WordBasic.[LTrim$](Str(n)) x_$ = rept$("0", 3 - Len(x_$)) + x_$ defineLabelName$ = type_$ + x_$ + "_" + fn$ End Function Private Sub defineLabel(n$, type_$) If nlab <= maxlab Then labname__$(nlab) = n$ labtype__$(nlab) = type_$ labpos__(nlab) = WordBasic.GetSelStartPos() lablab__$(nlab) = defineLabelName$(type_$, nlab) WordBasic.EditBookmark Name:=lablab__$(nlab), Add:=1 nlab = nlab + 1 End If End Sub Private Function getLabel$(n$) Dim lab$ Dim n_ lab$ = "" n_ = 0 While n_ < nlab And lab$ = "" If labname__$(n_) = n$ Then lab$ = lablab__$(n_) n_ = n_ + 1 Wend getLabel$ = lab$ End Function Private Function getLabelType$(n$) Dim lab$ Dim n_ lab$ = "" n_ = 0 While n_ < nlab And lab$ = "" If labname__$(n_) = n$ Then lab$ = labtype__$(n_) n_ = n_ + 1 Wend getLabelType$ = lab$ End Function Private Function getLabelPos(n$) Dim lab Dim n_ lab = 0 n_ = 0 While n_ < nlab And lab = 0 If labname__$(n_) = n$ Then lab = labpos__(n_) n_ = n_ + 1 Wend getLabelPos = lab End Function Private Function isNthLabelOfType(n$, type_$) Dim m Dim n_ Dim pos m = 0 If nlab > 0 Then n_ = 0 pos = getLabelPos(n$) For n_ = 0 To nlab - 1 If labtype__$(n_) = type_$ And labpos__(n_) <= pos Then m = m + 1 Next End If isNthLabelOfType = m End Function Private Sub labels() dolabel "\@hd", xhead$ dolabel "\@fig", xcapfig$ dolabel "\@tab", xcaptab$ dolabel "label", xbookmark$ End Sub Private Sub dolabel(fss$, type_$) Dim f$ Dim s$ Dim fs$ Dim ln$ f$ = WordBasic.[WindowName$]() s$ = newScrap$ fs$ = "\\" + fss$ + "\{(*)\}" findepm (fs$) While WordBasic.EditFindFound() WordBasic.EditCut ln$ = extractArg$(f$, s$, "", fs$, "\1") defineLabel ln$, type_$ findepm (fs$) Wend releaseScrap s$ WordBasic.Activate f$ End Sub Private Sub pageref() Dim f$ Dim s$ Dim ln$ f$ = WordBasic.[WindowName$]() s$ = newScrap$ findepm "\\pageref\{*\}" While WordBasic.EditFindFound() WordBasic.EditCut ln$ = getLabel$(extractArg$(f$, s$, "", "\\pageref\{(*)\}", "\1")) If WordBasic.ExistingBookmark(ln$) Then WordBasic.InsertCrossReference ReferenceType:=xbookmark$, ReferenceKind:="7", ReferenceItem:=ln$ Else fehlermeldung "*** pageref not found: " + ln$ + " ***" End If findepm "\\pageref\{*\}" Wend releaseScrap s$ WordBasic.Activate f$ End Sub Private Sub ref() Dim f$ Dim s$ Dim ln0$ Dim ln$ Dim lt$ Dim vart$ Dim nth Dim vfor$ Dim vto$ f$ = WordBasic.[WindowName$]() s$ = newScrap$ findepm "\\ref\{*\}" While WordBasic.EditFindFound() WordBasic.EditCut ln0$ = extractArg$(f$, s$, "", "\\ref\{(*)\}", "\1") ln$ = getLabel$(ln0$) lt$ = getLabelType$(ln0$) vart$ = "" Select Case lt$ Case xcapfig$ nth = isNthLabelOfType(ln0$, xcapfig$) If nth > 0 Then vart$ = xcapfig$ vfor$ = "3" vto$ = WordBasic.[LTrim$](Str(nth)) End If Case xcaptab$ nth = isNthLabelOfType(ln0$, xcaptab$) If nth > 0 Then vart$ = xcaptab$ vfor$ = "3" vto$ = WordBasic.[LTrim$](Str(nth)) End If Case Else nth = isNthLabelOfType(ln0$, xhead$) If nth > 0 Then vart$ = xhead$ vfor$ = "8" vto$ = WordBasic.[LTrim$](Str(nth)) Else vto$ = ln$ If vto$ <> "" Then vart$ = xbookmark$ vfor$ = "9" End If End If End Select If vart$ <> "" Then WordBasic.InsertCrossReference ReferenceType:=vart$, ReferenceKind:=vfor$, ReferenceItem:=vto$ Else fehlermeldung "*** ref not found: " + ln0$ + " ***" End If findepm "\\ref\{*\}" Wend releaseScrap s$ WordBasic.Activate f$ End Sub Rem ******************************** Convert: Listen Private Sub listen() replListen "itemize", 1 replListen "enumerate", 13 replListen "description", 0 End Sub Private Sub replListen(n$, n_) Dim f Dim f_$ Dim s$ Dim fb$ Dim fe$ Dim fb1$ Dim fe1$ Dim fs$ f = -1 f_$ = WordBasic.[WindowName$]() s$ = newScrap$ WordBasic.Activate f_$ fb$ = "\\begin\{" + n$ + "\}" fe$ = "\\end\{" + n$ + "\}" fb1$ = "\begin{" + n$ + "}" fe1$ = "\end{" + n$ + "}" If inList(xexact$, "list") Then fs$ = fb$ Else fs$ = fb$ + "*(\\item*)" + fe$ End If While f findepm (fs$) If WordBasic.EditFindFound() Then If inList(xexact$, "list") Then WordBasic.WW6_EditClear balance fb1$, fe1$ WordBasic.EditCut findepm (fe$) WordBasic.WW6_EditClear Else WordBasic.EditCut End If clearScrap (s$) WordBasic.EditPaste If Not inList(xexact$, "list") Then replpm fs$, "\1" repl xr$ + "\item", "\item" repl "\item", xr$ + "\item" If n_ = 0 Then WordBasic.EditReplaceClearFormatting WordBasic.EditReplaceFont Bold:=1 rStyle "Enumerate" replpmf "\\item\[(*)\]", "\1" WordBasic.EditReplaceClearFormatting description Else WordBasic.EditSelectAll WordBasic.WW7_FormatBulletsAndNumbering Preset:=n_ replpm "\\item @([! ])", "\1" End If WordBasic.StartOfDocument WordBasic.CharRight 1 WordBasic.EndOfDocument 1 WordBasic.EditCut WordBasic.Activate f_$ WordBasic.EditPaste Else f = 0 End If Wend releaseScrap s$ WordBasic.Activate f_$ End Sub Private Sub description() Dim pa0 Dim pe0 Dim f Dim pa Dim pe pa0 = WordBasic.GetSelStartPos() pe0 = WordBasic.GetSelEndPos() If pe0 = pa0 Then WordBasic.EndOfLine WordBasic.ParaUp 1 WordBasic.ParaDown 1, 1 pa0 = WordBasic.GetSelStartPos() pe0 = WordBasic.GetSelEndPos() End If If pe0 > pa0 Then WordBasic.CharLeft 1 f = -1 pa = pa0 While f finde ":" pe = WordBasic.GetSelEndPos() If WordBasic.EditFindFound() And pe < pe0 And pe > pa Then WordBasic.SetSelRange pa, pe WordBasic.Bold WordBasic.ParaDown 1 pa = WordBasic.GetSelStartPos() Else f = 0 End If Wend Rem SetSelRange pa0, pe0 End If End Sub Rem ******************************** Convert: Tabellen Rem \begin{tabular} Rem a & b & c \\ Rem a & b & c \\ Rem \end{tabular} Private Sub tabular1() Dim s$ s$ = newScrap$ replTabellen1 "\\begin\{tabular\}\[*\]", "\\end\{tabular\}", s$ replTabellen1 "\\begin\{tabular\}", "\\end\{tabular\}", s$ replTabellen1 "\\begin\{tabular\*\}\[*\]\{*\}", "\\end\{tabular\*\}", s$ replTabellen1 "\\begin\{tabular\*\}\[*\]", "\\end\{tabular\*\}", s$ replTabellen1 "\\begin\{tabular\*\}\{*\}", "\\end\{tabular\*\}", s$ releaseScrap s$ End Sub Private Sub multicolumn1(mode) Dim f$ Dim s$ Dim mc$ Dim fs$ Dim rs$ Dim nn$ Dim n Dim c$ Dim i f$ = WordBasic.[WindowName$]() s$ = newScrap$ mc$ = "multicxxxxx" Select Case mode Case 1 fs$ = whichSP$("multicolumn", "\\multicolumn\{(*)\}\{*\}") rs$ = mc$ + "{\1}{\2}" Case 2 fs$ = whichSP$("multicolumn", mc$ + "\{(*)\}") rs$ = "\2" Case Else fs$ = whichSP$("multicolumn", "\\multicolumn\{(*)\}\{*\}") rs$ = "\2" End Select findepm (fs$) While WordBasic.EditFindFound() nn$ = WordBasic.[Selection$]() n = extractArg_(f$, s$, nn$, fs$, "\1") doTheCut "multicolumn" If inList(xexact$, "multicolumn") Then If mode = 1 Then c$ = mc$ + "{" + WordBasic.[LTrim$](Str(n)) + "}{" + extractArg$("", s$, "", "", "") + "}" Else c$ = extractArg$("", s$, "", "", "") End If Else c$ = extractArg$("", s$, "", fs$, rs$) End If If mode = 1 Or mode = 3 Then For i = 2 To n c$ = c$ + " & " Next End If WordBasic.Activate f$ WordBasic.Insert c$ If mode = 2 Then For i = 1 To n WordBasic.CharRight 1, 1 Next WordBasic.TableMergeCells finde (xr$) WordBasic.WW6_EditClear WordBasic.FormatParagraph Alignment:=1 End If findepm (fs$) Wend releaseScrap s$ WordBasic.Activate f$ End Sub Private Sub replTabellen1(fbegin$, fend$, s$) Dim f Dim f_$ Dim fs$ Dim pa Dim pe Dim c f = -1 f_$ = WordBasic.[WindowName$]() If inList(xexact$, "tabular") Then fs$ = fbegin$ + "\{" Else fs$ = fbegin$ + "\{*\}(*)" + fend$ End If findepm (fs$) While WordBasic.EditFindFound() If inList(xexact$, "tabular") Then WordBasic.WW6_EditClear balance "{", "}" WordBasic.WW6_EditClear WordBasic.WW6_EditClear pa = WordBasic.GetSelStartPos() findepm (fend$) WordBasic.WW6_EditClear pe = WordBasic.GetSelEndPos() WordBasic.SetSelRange pa, pe End If WordBasic.EditCut clearScrap (s$) WordBasic.EditPaste If Not inList(xexact$, "tabular") Then Rem delCmd("extracolsep") Rem replpm("\@\{*\}", "") replpm fs$, "\1" End If Rem repl("\\", xxtmp$) repl xxz$, xxtmp$ replpm " @" + xxtmp$, xxtmp$ replpm xxtmp$ + " @([! ])", xxtmp$ + "\1" replpm xxtmp$, xr$ repl "\&", xxtmp$ If isOption("multicolumn") Then multicolumn1 (1) Else multicolumn1 (3) End If WordBasic.StartOfDocument findepm "*\\\\" c = countInStr(WordBasic.[GetText$](WordBasic.GetSelStartPos(), WordBasic.GetSelEndPos()), "&") replpm " @&", "&" replpm "& @([! ])", "&\1" repl "&", xt$ repl xxtmp$, "&" WordBasic.EditSelectAll WordBasic.LineUp 1, 1 WordBasic.EndOfLine 1 WordBasic.TextToTable ConvertFrom:="1", NumColumns:=c, InitialColWidth:="Auto", Format:="1", Apply:="167" If isOption("booktabs") Then delCmd "toprule" delCmd "midrule" delCmd "bottomrule" End If If isOption("multicolumn") Then multicolumn1 (2) WordBasic.EditSelectAll WordBasic.EditCut WordBasic.Activate f_$ WordBasic.EditPaste findepm (fs$) Wend WordBasic.Activate f_$ End Sub Rem ---------------------------------------- Caption: Figure, Table Private Sub collCap(fs$, posc$, posl$, env$, cap$) Dim r$ Dim f Dim f_$ Dim s$ Dim lab$ Dim caption_$ Dim collCap_$ r$ = "" f = -1 f_$ = WordBasic.[WindowName$]() s$ = newScrap$ While f findepm (fs$) If WordBasic.EditFindFound() Then WordBasic.EditCut lab$ = extractArg$("", s$, "", fs$, "\" + posl$) caption_$ = extractArg$("", s$, "", fs$, "\" + posc$) clearScrap (s$) WordBasic.InsertCaption Label:=cap$, Title:=" " + caption_$, Position:=1 WordBasic.InsertPara WordBasic.EditPaste replpm fs$, "\1 \3 \5" WordBasic.EditSelectAll WordBasic.EditCut WordBasic.Activate f_$ pseudoLabel lab$, cap$ WordBasic.EditPaste Else f = 0 End If Wend releaseScrap s$ WordBasic.Activate f_$ collCap_$ = r$ End Sub Private Function collCapFS$(env$, n) Select Case n Case 1 collCapFS$ = "\\begin\{" + env$ + "\}\[*\](*)\\caption\{(*)\}(*)\\label\{(*)\}(*)\\end\{" + env$ + "\}" Case 2 collCapFS$ = "\\begin\{" + env$ + "\}(*)\\caption\{(*)\}(*)\\label\{(*)\}(*)\\end\{" + env$ + "\}" Case 3 collCapFS$ = "\\begin\{" + env$ + "\}\[*\](*)\\label\{(*)\}(*)\\caption\{(*)\}(*)\\end\{" + env$ + "\}" Case 4 collCapFS$ = "\\begin\{" + env$ + "\}(*)\\label\{(*)\}(*)\\caption\{(*)\}(*)\\end\{" + env$ + "\}" End Select End Function Private Sub tablec() collCap collCapFS$("table", 1), "2", "4", "table", xcaptab$ collCap collCapFS$("table", 3), "4", "2", "table", xcaptab$ collCap collCapFS$("table", 2), "2", "4", "table", xcaptab$ collCap collCapFS$("table", 4), "4", "2", "table", xcaptab$ End Sub Private Sub figurec() collCap collCapFS$("figure", 1), "2", "4", "figure", xcapfig$ collCap collCapFS$("figure", 3), "4", "2", "figure", xcapfig$ collCap collCapFS$("figure", 2), "2", "4", "figure", xcapfig$ collCap collCapFS$("figure", 4), "4", "2", "figure", xcapfig$ End Sub Rem ******************************** include & input Private Sub includeandinput() Dim f Dim f_$ Dim s$ Dim fs$ Dim m Dim pp$ Dim fn0$ Dim fn$ Dim fn1$ f = 0 f_$ = WordBasic.[WindowName$]() s$ = newScrap$ fs$ = "\\includeonly\{(*)\}" findepm (fs$) If WordBasic.EditFindFound() Then WordBasic.EditCut clearScrap (s$) WordBasic.EditPaste replpm fs$, "\1" shrinkTeX repl " ", "" repl xr$, "" xincludeonly$ = "," + extractText$ + "," WordBasic.Activate f_$ End If m = 1 While f < 2 If m = 1 Then fs$ = "\\include\{(*)\}" pp$ = ".tex" ElseIf m = 2 Then fs$ = "\\input\{(*)\}" pp$ = ".tex" End If findepm (fs$) If WordBasic.EditFindFound() Then WordBasic.EditCut fn0$ = extractArg$("", s$, "", fs$, "\1") If m = 2 Or xincludeonly$ = "" Or InStr(xincludeonly$, "," + fn0$ + ",") Then If WordBasic.[Left$](WordBasic.[Right$](fn0$, 4), 1) <> "." Then fn0$ = fn0$ + pp$ fn$ = xdir$ + fn0$ If isOption("chkdoc") Then fn1$ = WordBasic.[Left$](fn$, Len(fn$) - 3) + "doc" If WordBasic.[Files$](fn1$) <> "" Then fn$ = fn1$ End If End If WordBasic.Insert fn$ WordBasic.Activate f_$ If m = 1 Then WordBasic.InsertBreak Type:=2 If WordBasic.[Files$](fn$) <> "" Then WordBasic.FileOpen Name:=fn$, ConfirmConversions:=0 readDocumentVars WordBasic.EditSelectAll WordBasic.EditCopy WordBasic.DocClose 2 WordBasic.Activate f_$ WordBasic.EditPaste Else If openMissingFile$(f_$, fn$, -1) <> "" Then WordBasic.EditPaste Else fehlermeldung "*** file not found: " + fn0$ + " ***" End If End If f = 0 Else WordBasic.Activate f_$ End If Else m = m Mod 2 + 1 f = f + 1 End If Wend releaseScrap s$ WordBasic.Activate f_$ End Sub Private Sub biblio() Dim f$ Dim fs$ Dim fn$ Dim s$ Dim pa Dim pe f$ = WordBasic.[WindowName$]() fs$ = "\\bibliography\{*\}" fn$ = WordBasic.[FileName$]() fn$ = WordBasic.[Left$](fn$, Len(fn$) - 3) + "bbl" If isOption("recite") And WordBasic.ExistingBookmark(xbiblio$) Then WordBasic.EditBookmark Name:=defineLabelName$(xbiblio$, 0), GoTo:=1 WordBasic.EditBookmark Name:=defineLabelName$(xbiblio$, 0), Delete:=1 End If findepm (fs$) If WordBasic.EditFindFound() Then WordBasic.EditCut s$ = newScrap$ If xdoctype$ = "article" Then WordBasic.InsertBreak Type:=3 Else WordBasic.InsertBreak Type:=2 End If If isOption("recite") Then pa = WordBasic.GetSelStartPos() End If xStyle xhead$ + " 1" WordBasic.Insert xbiblio$ WordBasic.InsertPara xStyle xnormal$ clearScrap (s$) If WordBasic.[Files$](fn$) <> "" Then WordBasic.FileOpen Name:=fn$, ConfirmConversions:=0 WordBasic.EditSelectAll WordBasic.EditCopy WordBasic.DocClose 2 Else xbbl$ = openMissingFile$(f$, fn$, -1) If xbbl$ = "" Then xbbl$ = "*nobbl*" End If WordBasic.EditPaste languageSpecificChars apaciteBBL WordBasic.EditSelectAll xStyle "Enumerate" WordBasic.EditCut releaseScrap s$ WordBasic.Activate f$ WordBasic.EditPaste If isOption("recite") Then pe = WordBasic.GetSelStartPos() WordBasic.SetSelRange pa, pe WordBasic.EditBookmark Name:=defineLabelName$(xbiblio$, 0), Add:=1 End If End If End Sub Rem ******************************** Tables Private Sub tableofcontents() Dim fs$ fs$ = "\tableofcontents" finde (fs$) If WordBasic.EditFindFound() Then WordBasic.EditCut WordBasic.InsertPara xStyle "_" + xhead$ + " 1" WordBasic.Insert xtoc$ WordBasic.InsertPara xStyle xnormal$ On Error Resume Next WordBasic.InsertTableOfContents Outline:=1, From:=1, To:=3, RightAlignPageNumbers:=1, Replace:=0 On Error GoTo -1: On Error GoTo 0 End If End Sub Private Sub listoffigures() Dim fs$ fs$ = "\listoffigures" finde (fs$) If WordBasic.EditFindFound() Then WordBasic.EditCut WordBasic.InsertPara xStyle "_" + xhead$ + " 1" WordBasic.Insert xlof$ WordBasic.InsertPara xStyle xnormal$ On Error Resume Next WordBasic.InsertTableOfContents Outline:=0, From:=1, To:=3, Caption:=xcapfig$, Label:=1, RightAlignPageNumbers:=1, Replace:=0 On Error GoTo -1: On Error GoTo 0 End If End Sub Private Sub listoftables() Dim fs$ fs$ = "\listoftables" finde (fs$) If WordBasic.EditFindFound() Then WordBasic.EditCut WordBasic.InsertPara xStyle "_" + xhead$ + " 1" WordBasic.Insert xlot$ WordBasic.InsertPara xStyle xnormal$ On Error Resume Next WordBasic.InsertTableOfContents Outline:=0, From:=1, To:=3, Caption:=xcaptab$, Label:=1, RightAlignPageNumbers:=1, Replace:=0 On Error GoTo -1: On Error GoTo 0 End If End Sub Rem ********************************* Newcommand Private Sub newcommand() Dim f Dim f_$ Dim s$ ncmds = 0 f = -1 f_$ = WordBasic.[WindowName$]() s$ = newScrap$ Rem cmdsCollect(f$,s$,fs$,name$,num$,optarg$) Rem search string without body! cmdsCollect f_$, s$, "\\newcommand\{(\\[a-zA-Z]@)\}\[([0-9])\]\[(*)\]", "\1", "\2", "\3" cmdsCollect f_$, s$, "\\newcommand\{(\\[a-zA-Z]@)\}\[([0-9])\]", "\1", "\2", "" cmdsCollect f_$, s$, "\\newcommand\{(\\[a-zA-Z]@)\}", "\1", "", "" cmdsCollect f_$, s$, "\\renewcommand\{(\\[a-zA-Z]@)\}\[([0-9])\]\[(*)\]", "\1", "\2", "\3" cmdsCollect f_$, s$, "\\renewcommand\{(\\[a-zA-Z]@)\}\[([0-9])\]", "\1", "\2", "" cmdsCollect f_$, s$, "\\renewcommand\{(\\[a-zA-Z]@)\}", "\1", "", "" envCollect f_$, s$, "\\newenvironment\{([a-zA-Z]@)\}", "\1", "", "" envCollect f_$, s$, "\\newenvironment\{([a-zA-Z]@)\}\[([0-9])\]", "\1", "\2", "" envCollect f_$, s$, "\\renewenvironment\{([a-zA-Z]@)\}", "\1", "", "" envCollect f_$, s$, "\\renewenvironment\{([a-zA-Z]@)\}\[([0-9])\]", "\1", "\2", "" releaseScrap s$ cmdsReplace End Sub Private Sub cmdsReplace() Dim ee Dim n ee = 0 While ee < ncmds * 2 ee = 0 n = 0 While n < ncmds n = n + 1 If cmdOpt__(n) Then replpm (cmdfs2__$(n)), (cmdrs1__$(n)) If Not WordBasic.EditFindFound() Then ee = ee + 1 replpm (cmdfs1__$(n)), (cmdrs2__$(n)) If Not WordBasic.EditFindFound() Then ee = ee + 1 Else replpm (cmdfs2__$(n)), (cmdrs1__$(n)) If Not WordBasic.EditFindFound() Then ee = ee + 1 replpm (cmdfs1__$(n)), (cmdrs1__$(n)) If Not WordBasic.EditFindFound() Then ee = ee + 1 End If Wend repl xxtmp$, "\" Wend End Sub Private Sub cmdsCollect(f$, s$, fs0$, name_$, num$, optarg$) Dim fs$ Dim def$ Dim cname$ Dim cargs Dim copt$ Dim fstr1$ Dim fstr2$ Dim n fs$ = fs0$ + "\{" findepm (fs$) While WordBasic.EditFindFound() And ncmds <= maxcmds def$ = WordBasic.[Selection$]() WordBasic.WW6_EditClear balance "{", "}" WordBasic.EditCut WordBasic.WW6_EditClear cname$ = extractArg$("", s$, def$, fs$, name_$) If Not inList(xnoexpcmds$, cname$) Then ncmds = ncmds + 1 cargs = extractArg_("", s$, def$, fs$, num$) copt$ = extractArg$("", s$, def$, fs$, optarg$) clearScrap (s$) fstr1$ = "\" + cname$ fstr2$ = "\" + cname$ n = 1 If copt$ = "" Then cmdOpt__(ncmds) = 0 Else cmdOpt__(ncmds) = -1 fstr2$ = fstr2$ + "\[(*)\]" n = 2 End If If cargs = 0 Then fstr2$ = fstr2$ + "\{\}" While n <= cargs fstr1$ = fstr1$ + "\{(*)\}" fstr2$ = fstr2$ + "\{(*)\}" n = n + 1 Wend cmdfs1__$(ncmds) = fstr1$ cmdfs2__$(ncmds) = fstr2$ clearScrap (s$) WordBasic.EditPaste repl "\", xxtmp$ repl "#", "\" cmdrs1__$(ncmds) = xxtmp$ + "@pg{" + extractText$ + "}" If copt$ <> "" Then clearScrap (s$) WordBasic.EditPaste repl "\", xxtmp$ repl "#1", copt$ n = 2 While n <= cargs repl "#" + WordBasic.[LTrim$](Str(n)), "\" + WordBasic.[LTrim$](Str(n - 1)) n = n + 1 Wend cmdrs2__$(ncmds) = xxtmp$ + "@pg{" + extractText$ + "}" Else cmdrs2__$(ncmds) = "" End If End If WordBasic.Activate f$ findepm (fs$) Wend End Sub Private Sub envCollect(f$, s$, fs0$, name_$, num$, optarg$) Dim fs$ Dim def$ Dim ep0 Dim ebegin$ Dim eend$ Dim ep1 Dim cname$ Dim cargs Dim copt$ Dim fstr1$ Dim fstr2$ Dim n fs$ = fs0$ findepm (fs$) While WordBasic.EditFindFound() And ncmds <= (maxcmds - 1) def$ = WordBasic.[Selection$]() WordBasic.WW6_EditClear ep0 = WordBasic.GetSelStartPos() finde "{" WordBasic.CharRight 1 balance "{", "}" ebegin$ = WordBasic.[Selection$]() WordBasic.CharRight 1 finde "{" WordBasic.CharRight 1 balance "{", "}" eend$ = WordBasic.[Selection$]() ep1 = WordBasic.GetSelEndPos() WordBasic.SetSelRange ep0, ep1 WordBasic.WW6_EditClear WordBasic.WW6_EditClear Rem ********************* begin ncmds = ncmds + 1 cname$ = extractArg$("", s$, def$, fs$, name_$) cargs = extractArg_("", s$, def$, fs$, num$) copt$ = extractArg$("", s$, def$, fs$, optarg$) clearScrap (s$) fstr1$ = "\\begin\{" + cname$ + "\}" fstr2$ = "\\begin\{" + cname$ + "\}" n = 1 If copt$ = "" Then cmdOpt__(ncmds) = 0 Else cmdOpt__(ncmds) = -1 fstr2$ = fstr2$ + "\[(*)\]" n = 2 End If While n <= cargs fstr1$ = fstr1$ + "\{(*)\}" fstr2$ = fstr2$ + "\{(*)\}" n = n + 1 Wend cmdfs1__$(ncmds) = fstr1$ cmdfs2__$(ncmds) = fstr1$ clearScrap (s$) WordBasic.Insert ebegin$ repl "\", xxtmp$ repl "#", "\" cmdrs1__$(ncmds) = xxtmp$ + "@pg{" + extractText$ If copt$ <> "" Then clearScrap (s$) WordBasic.EditPaste repl "\", xxtmp$ repl "#1", copt$ n = 2 While n <= cargs repl "#" + WordBasic.[LTrim$](Str(n)), "\" + WordBasic.[LTrim$](Str(n - 1)) n = n + 1 Wend cmdrs2__$(ncmds) = xxtmp$ + "@pg{" + extractText$ Else cmdrs2__$(ncmds) = "" End If Rem ********************* end ncmds = ncmds + 1 cmdOpt__(ncmds) = 0 cmdfs1__$(ncmds) = "\\end\{" + cname$ + "\}" cmdfs2__$(ncmds) = "\\end\{" + cname$ + "\}" clearScrap (s$) WordBasic.Insert eend$ repl "\", xxtmp$ repl "#", "\" cmdrs1__$(ncmds) = extractText$ + "}" cmdrs2__$(ncmds) = "" WordBasic.Activate f$ findepm (fs$) Wend End Sub Rem ************************************* DocumentVar Private Sub writeDocumentVars() Dim n If isOption("DocumentVars") Then If nlab > 0 Then WordBasic.SetDocumentVar "nlab", WordBasic.[LTrim$](Str(nlab)) For n = 0 To nlab - 1 WordBasic.SetDocumentVar "ln_" + WordBasic.[LTrim$](Str(n)), labname__$(n) WordBasic.SetDocumentVar "lt_" + WordBasic.[LTrim$](Str(n)), labtype__$(n) WordBasic.SetDocumentVar "ll_" + WordBasic.[LTrim$](Str(n)), lablab__$(n) Next End If If xcitec > 0 Then WordBasic.SetDocumentVar "xcitec", WordBasic.[LTrim$](Str(xcitec)) For n = 0 To xcitec - 1 WordBasic.SetDocumentVar "cite_" + WordBasic.[LTrim$](Str(n)), xcites__$(n) Next End If WordBasic.SetDocumentVar xbiblio$, xbibfile$ End If End Sub Private Sub readDocumentVars() Dim nlab1$ Dim nlab1_ Dim n Dim xcitec1$ Dim xcitec1_ If isOption("DocumentVars") Then nlab1$ = WordBasic.[GetDocumentVar$]("nlab") If nlab1$ <> "" Then nlab1_ = WordBasic.Val(nlab1$) If nlab1_ > 0 Then For n = 0 To nlab1_ - 1 labname__$(n + nlab) = WordBasic.[GetDocumentVar$]("ln_" + WordBasic.[LTrim$](Str(n))) labtype__$(n + nlab) = WordBasic.[GetDocumentVar$]("lt_" + WordBasic.[LTrim$](Str(n))) lablab__$(n + nlab) = WordBasic.[GetDocumentVar$]("ll_" + WordBasic.[LTrim$](Str(n))) Next nlab = nlab + nlab1_ End If End If xcitec1$ = WordBasic.[GetDocumentVar$]("xcitec") If xcitec1$ <> "" Then xcitec1_ = WordBasic.Val(xcitec1$) If xcitec1_ > 0 Then For n = 0 To xcitec1_ - 1 xcites__$(n + xcitec) = WordBasic.[GetDocumentVar$]("cite_" + WordBasic.[LTrim$](Str(n))) Next xcitec = xcitec + xcitec1_ End If End If End If End Sub Rem ****************************** Create AuxFile for use with BibTeX Private Sub citeWord() Dim s$ Dim f$ Dim x$ Dim out$ Dim a$ Dim b$ Dim fext$ Dim Dlg As Object Dim x_ Dim xx$ Dim xaux$ Dim bibtex As Object s$ = newScrap$ f$ = WordBasic.[WindowName$]() x$ = WordBasic.[FileName$]() WordBasic.FileNewDefault out$ = WordBasic.[WindowName$]() WordBasic.Insert "\bibstyle{" + xcitestyle$ + "}" WordBasic.InsertPara WordBasic.InsertPara WordBasic.Insert "\bibdata{" + xbibfile$ + "}" WordBasic.InsertPara WordBasic.InsertPara WordBasic.Activate f$ a$ = lcar$(xcitecmds$) b$ = lcdr$(xcitecmds$) While a$ <> "" citer s$, out$, "\\" + a$ + "*\{(*)\}" a$ = lcar$(b$) b$ = lcdr$(b$) Wend releaseScrap (s$) WordBasic.Activate out$ shrinkTeX fext$ = "aux" If WordBasic.[Left$](WordBasic.[Right$](x$, 4), 1) = "." Then x$ = WordBasic.[Left$](x$, Len(x$) - 3) + fext$ Else x$ = x$ + fext$ End If If xplattform$ = "win" And WordBasic.[Files$](x$) <> "" Then WordBasic.MsgBox "Delete " + x$ + " first" Else Set Dlg = WordBasic.DialogRecord.FileSaveAs(False) WordBasic.CurValues.FileSaveAs Dlg Dlg.Name = x$ Dlg.Format = 2 x_ = WordBasic.Dialog.FileSaveAs(Dlg) If x_ <> 0 Then xx$ = Dlg.Name WordBasic.FileSaveAs Name:=xx$, Format:=2, AddToMru:=0 WordBasic.DocClose 2 If xplattform$ = "win" Then x$ = WordBasic.[Left$](xx$, Len(xx$) - 4) xaux$ = x$ + ".aux" Rem xtxt$ = xx$ Rem If Files$(xaux$) <> "" Then Rem Kill xaux$ Rem EndIf Rem Insert xtxt$ + " " + xaux$ WordBasic.Rename xx$, xaux$ Else x$ = xx$ End If If xbibtex$ <> "" Then WordBasic.BeginDialog 210, 55, "tex2doc" WordBasic.Text 49, 5, 118, 12, "BibTeX starten?" WordBasic.OKButton 6, 32, 90, 20 WordBasic.CancelButton 118, 32, 90, 20 WordBasic.EndDialog Set bibtex = WordBasic.CurValues.UserDialog x_ = WordBasic.Dialog.UserDialog(bibtex) If x_ = -1 Then If xplattform$ = "mac" Then WordBasic.SetFileCreatorAndType x$, xbibtex$ WordBasic.Shell x$ Else WordBasic.Shell xbibtex$ + " " + x$ End If End If End If End If End If End Sub Private Sub citer(s$, out$, fs$) Dim f$ Dim xout$ f$ = WordBasic.[WindowName$]() WordBasic.StartOfDocument findtxt "p", fs$ While WordBasic.EditFindFound() WordBasic.EditCopy WordBasic.CharRight 1 xout$ = "\citation{" + extractArg$("", s$, "", fs$, "\1") + "}" WordBasic.Activate out$ WordBasic.Insert xout$ WordBasic.InsertPara WordBasic.InsertPara WordBasic.Activate f$ findtxt "pe", fs$ Wend End Sub Rem ****************************** Save & Restore Private Sub saveVerb() Dim fs$ Dim pa Dim vfs$ Dim pe Dim x$ fs$ = "\verb" finde (fs$) While WordBasic.EditFindFound() pa = WordBasic.GetSelStartPos() WordBasic.CharRight WordBasic.CharRight 1, 1 vfs$ = WordBasic.[Selection$]() WordBasic.CharRight finde (vfs$) pe = WordBasic.GetSelEndPos() xsaved__$(xsaved_) = WordBasic.[GetText$](pa, pe) WordBasic.SetSelRange pa, pe WordBasic.WW6_EditClear x$ = WordBasic.[LTrim$](Str(xsaved_)) x$ = rept$("0", 3 - Len(x$)) + x$ WordBasic.Insert "\@saved" + x$ xsaved_ = xsaved_ + 1 finde (fs$) Wend End Sub Private Sub saveMath() Rem +++ End Sub Private Sub restoreMath() Rem +++ End Sub Private Sub restoreSaved() Dim n Dim x$ If xsaved_ > 0 Then For n = 0 To xsaved_ - 1 x$ = WordBasic.[LTrim$](Str(n)) x$ = rept$("0", 3 - Len(x$)) + x$ finde "\@saved" + x$ If WordBasic.EditFindFound() Then WordBasic.WW6_EditClear WordBasic.Insert xsaved__$(n) End If Next End If End Sub Rem ****************************** Verb Private Sub verb() Dim fs$ Dim pa Dim vfs$ Dim pe fs$ = "\verb" finde (fs$) While WordBasic.EditFindFound() pa = WordBasic.GetSelStartPos() WordBasic.WW6_EditClear WordBasic.CharRight 1, 1 vfs$ = WordBasic.[Selection$]() WordBasic.WW6_EditClear finde (vfs$) WordBasic.WW6_EditClear pe = WordBasic.GetSelStartPos() WordBasic.SetSelRange pa, pe WordBasic.FormatFont Font:=xtypewriter$ WordBasic.CharRight finde (fs$) Wend End Sub Rem ****************************** vspace, vspace* Private Sub vspace(n$) End Sub