OpenOffice.org Forum :: Writer to Palm eReader conversion macro, v. 2.1

[Home] [FAQ] [Search] [Memberlist] [Usergroups] [Register]

[Profile] [Log in to check your private messages] [Log in]

Writer to Palm eReader conversion macro, v. 2.1

OOoForum.org Forum Index -> OpenOffice.org Code Snippets

View previous topic :: View next topic

Author

Message

poxi1023
General User

Joined: 08 Jul 2007
Posts: 24

Posted: Fri Feb 01, 2008 6:14 pm Post subject: Writer to Palm eReader conversion macro, v. 2.1

I like reading Project Gutenberg texts in my Palm TX. I noticed OO.o has an export filter for "Aportis (Palm)" docs, but not for Palm eReader. I prefer that format, because it shows bold and italic text, chapter index, etc., using the (free) "Palm Markup Language". See http://www.ereader.com/dropbook for more info. So I wrote a macro to convert a Writer document to PML. My first attempt was posted at http://www.oooforum.org/forum/viewtopic.phtml?t=67301.

Now I have rewritten most of the code, and added the missing features to get real WYSIWYG, within PML limitations: footnotes, graphics, styles, etc.

There are some interesting features even for those who do not use Palm eReader:

My main interest was getting nice formatted text from OOo into my Palm, and learn some OOo Basic on the way. I hope this is useful for others.

Code:

REM ***** BASIC *****

'**********************************************************************
'                   odt2pml
'
' This macro exports a Writer document into a "Palm Markup Language"
' tagged plain text file, ready to be processed by DropBook for
' Palm eReader. Cfr: http://www.ereader.com/dropbook
'
' You may enable direct calling of "DropBook.exe", see almost at the
' end of the first macro, "odt2pml". You will get a .pdb file, ready
' to be transferred to your handheld.
'
' odt2pml is WYSIWYG, within PML limitations: format your document
' as you like, and Palm eReader will show it mostly in a similar way.
' That includes character, paragraph and page styles, footnotes,
' graphics (for details see "sbGraphics"), and direct formatting.
' Tables are not supported and will be ignored.
' Lists are not supported either. On exporting, numbers will appear,
' without indents, bullets disappear...
'
' Since I am learning OOo Basic with this macro, it is heavily commented
' and sources are documented. I wish to express my sincere thanks
' to all who have posted code that helped me to get here.
'
'**********************************************************************
'
' Copyright © 2008 poxi1023 AT gmail DOT com
' Version: 2.1, 6-Feb-2008
'
' This library is free software; you can redistribute it and/or
' modify it under the terms of the GNU Lesser General Public
' License as published by the Free Software Foundation; either
' version 3 of the License, or (at your option) any later version.
'
' This library 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
' Lesser General Public License for more details.
'
' See: http://www.gnu.org/licenses/lgpl.html
'
' All trademarks and registered trademarks mentioned herein
' are the property of their respective owners.
'
'**********************************************************************

'Private variables (only available in the module in which they are defined)
Private oDoc as object, oCC as object, oText as object
Private oBMarks as object
Private sDocURL As String, sDocDir As String, sFileN As String
Private oPBar as object, oPB2 as object, oPB3 as object       'status indicators
Private fStandardCharHeight as long       'Compare to "large font"
Private sPrevPageStyle as string       'Change in page style implies page break before!
Private sTitle as string             'Title shown in eReader

Sub odt2pml

Dim Args(1) As New com.sun.star.beans.PropertyValue
Dim nVar As Integer
Dim sTex As String, sMsg As String, sMsgDB As String
' dim t as long 'timer

oDoc=ThisComponent
oCC = oDoc.CurrentController
oText = oDoc.Text
oPBar = oCC.StatusIndicator

'Show text in status bar
oPBar.start("odt2pml: Welcome!",0)

If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then
   GlobalScope.BasicLibraries.LoadLibrary("Tools")
End If

'Explanation
sTex = "This macro converts your document into Palm" & Chr$(13)_
   & "Markup Language formatted text, and, if you" & Chr$(13)_
   & "set it so, calls DropBook to make a .prc file" & Chr$(13)_
   & "ready to be synced to your handheld." & Chr$(13)_
   & "See http://www.ereader.com/dropbook for more info." & Chr$(13) & Chr$(13)_
   & "Continue?"
nVar = MsgBox(sTex,52,"odt2pml")
If nVar = 7 Then          'Answer: No!
   oPBar.end()
   End
End If

'Before processing: check save status
If oDoc.hasLocation=False Then
   MsgBox ("Please save text as .odt document before processing!",16,"odt2pml")
   oPBar.end()
   End
End If

sDocURL = oDoc.getURL()
'subs from global Basic library "Tools"
sDocDir=DirectoryNameoutofPath(sDocURL, "/")
sFileExt=GetFileNameExtension(sDocURL)
sFileN=GetFileNamewithoutExtension(sDocURL)    'with path!
If NOT(sFileExt="odt") Then
   MsgBox ("Please save text as .odt document before processing!",16,"odt2pml")
   oPBar.end()
   End
End If
If (oDoc.isModified) Then 'save before processing!
   oDoc.store()
End If

' Avoiding screen refreshment to save some time
' Cfr. http://www.oooforum.org/forum/viewtopic.phtml?t=49527
oDoc.lockControllers
' oCC.Frame.ContainerWindow.Enable = False 'does not save more time, if you don't move
                                 'around your doc during macro execution
' t = timer                         'If you want to control time savings...

'Process doc: call subs
sbBookmarks
sbGraphics
sbTraverseText
sbTitle
sbSpecialCodes

'Show text in status bar
oPB3.end()
oPBar.start("odt2pml: Saving...",0)

'Save the current Writer document as a .pml ISO 8859-15 plain text file.
   'From: txt2tags extension, http://quasiwiki.sourceforge.net/
Args(0).Name="FilterName"
Args(0).Value="Text (encoded)"
Args(1).Name = "FilterOptions"
Args(1).Value = "ISO_8859_15,CRLF,,,"
sBackupFile = sFileN & ".pml"
oDoc.StoreToURL(sBackupFile, Args())

oPBar.setText("odt2pml: Calling DropBook...")

'If there is a previous .pdb file, delete it!
sFileP = sFileN & ".pdb"
If FileExists(sFileP) Then
   Kill sFileP
End If

' a$ = "Elapsed time = " & timer-t & Chr(13)
' MsgBox a$

sMsg = "Ready!" & Chr$(13) & Chr$(13) & "You may use DropBook now to process: "_
   & Chr$(13) & Chr$(13) & ConvertFromURL(sBackupFile) & Chr$(13) & " "
sMsgDB = "Ready!" & Chr$(13) & Chr$(13) & "If DropBook showed no errors, you may transfer "_
   & Chr$(13) & Chr$(13) & ConvertFromURL(sFileN) & ".pdb" & Chr$(13) & Chr$(13) &_
   "now to your handheld." & Chr$(13) & " "

'*****************************************************************************************
'                Call DropBook
'*****************************************************************************************
' If you want to enable direct processing by "DropBook.exe", you may uncomment
' (i. e. erase the leading ' from) the following lines, depending on your OS.
' Before doing this, you must insert the correct path to DropBook.exe on your computer!
'*****************************************************************************************
' On Linux, you need Wine. Make sure that Wine config has set "Z:" as / (root) directory.
'
' With Linux, correct and uncomment the following lines:
' sDBFile = "Z:" & ReplaceString(ConvertFromURL(sBackupFile),"\","/")
' shell("wine /usr/bin/DropBook.exe",1,CHR$(34) & sDBFile & CHR$(34),true)
' sMsg = sMsgDB
'*****************************************************************************************
' With Windows, correct and uncomment the following lines:
' sDBFile = ConvertFromURL(sBackupFile)
' shell("C:\Programme\DropBook1.5.2.exe",1,CHR$(34) & sDBFile & CHR$(34),true)
' sMsg = sMsgDB
'*****************************************************************************************

oPBar.end()
' oCC.Frame.ContainerWindow.Enable = True
oDoc.unlockControllers

'Reload original doc
'Cfr. http://www.pitonyak.org/AndrewMacro.odt,
   'Listing 5.17: Load a document into an existing frame
oDoc.setModified(False)
oDoc = oCC.Frame.LoadComponentFromUrl(sDocURL,"",0,Array())

'All done!
MsgBox (sMsg,0,"odt2pml")

End Sub

Sub sbBookmarks
'cfr: http://www.oooforum.org/forum/viewtopic.phtml?t=53042 , JohnV

Dim oBM as object, oReplace as object, oCurs as object
Dim sNam as string

oPBar.setText("odt2pml: Bookmarks and graphics...")

'First things first: if there is any "\" in the text, replace it now!
oReplace = oDoc.createReplaceDescriptor()
oReplace.SearchCaseSensitive = True
oReplace.SearchRegularExpression=False
oReplace.SearchString = "\"
oReplace.ReplaceString = "\\"
oDoc.ReplaceAll(oReplace)
'replace Tab with 4 spaces
oReplace.SearchRegularExpression=True
oReplace.SearchString = "\t"
oReplace.ReplaceString = "\a160\a160\a160\a160"
oDoc.ReplaceAll(oReplace)

oCurs = oText.CreateTextCursor()
sPrevPageStyle = oCurs.PageStyleName 'Get first PageStyleName
                              'Change in page style implies page break before paragraph!

oBMarks = oDoc.getBookmarks

For I = 0 to oBMarks.Count - 1
   oBM = oBMarks.getByIndex(I).getAnchor
   sNam = oBMarks.getByIndex(I).Name
   oBM.String = "\Q=""" & sNam & """" & oBM.String
   oBM.CharCaseMap = 0       'Sorry, no SmallCaps here!
                        'DropBook wouldn't find the formatted Bookmark.
Next

End Sub

sub sbGraphics
'Embedded images will be ignored. Use only linked images following PML specs:
'For DropBook to find the image, it must be present in the subdirectory whose name matches
'that of the PML text file. For example, if "pmlsample.txt" contains a reference to an
'image called "intro.png", then there must be a subdirectory called "pmlsample_img" that
'contains intro.png. The directory's name is the name of the PML file (without the .txt extension)
'with "_img" appended.
'Images must be in PNG format and cannot be filtered or interlaced. Image depth must be 8 bits or
'less (256 colors, no transparency!). Any color table may be used for color images.
'Image files must be less than or equal to 65505 bytes in size, since they are embedded into the
'.pdb format of the book; Palm database records are limited to 65505 bytes in length. Since images
'are compressed, the actual image displayed by the reader may be much larger than 64K.
'Cfr: http://www.ereader.com/dropbook/pml

'On Palm TX, images wider than 320 pixel or taller than 420 pixel will be represented by a
'thumbnail that the user can tap to view the entire image. Others will be shown in-line.
'Images can not be anchored at a page or a frame.
'Beware: Setting graphic title also places graphic inside a frame!
'Best use "at/as character" anchor. "At paragraph" may change actual placement of graphic in PML.
Dim oGraphics as object
Dim oThisGraphic as object
Dim sFilename as string
Dim nAnchorType as integer

oGraphics = oDoc.getGraphicObjects()

for i = 0 to oGraphics.Count - 1

   oThisGraphic = oGraphics.GetByIndex(i)
   sFilename = FilenameOutOfPath(ConvertToURL(oThisGraphic.GraphicURL), "/")
   nAnchorType = oThisGraphic.AnchorType
   'cfr. http://api.openoffice.org/docs/common/ref/com/sun/star/text/TextContentAnchorType.html

      Select Case nAnchorType
         Case 2,3
            'Images anchored at page or frame will be ignored!
         Case else
            If InStr(sFilename, "vnd.sun") <> 0 Then
            'Embedded images will be ignored!
            ElseIf InStr(sFilename, "cover.png") <> 0 Then
                  'will be included at start of document
            ElseIf Right(sFilename, 4) = ".png" Then
            'this is the right one!
            oAnchor = oGraphics.GetByIndex(i).getAnchor
            oAnchor.String = "\m=""" & sFilename & """" & oAnchor.String
            Else
               'Other image formats will be ignored!
            End If
      End Select

next i

end sub

Sub sbTraverseText
'From: http://www.pitonyak.org/AndrewMacro.odt, Listing 7.52: Enumerate paragraph level text content.

Dim oParEnum as object 'Enumerator used to enumerate the paragraphs
Dim oPar as object    'The enumerated paragraph
Dim oCurs as object
Dim sParEx as string 'The exported paragraph
Dim oPB2
Dim n as integer, nPara as integer    'Paragraph counter

'Show text in new status bar
nPara = oDoc.ParagraphCount
oPB2 = oCC.Frame.createStatusIndicator
oPB2.start("odt2pml: Formatting paragraphs...",nPara)
n = 0

'Get "Standard" style CharHeight (I'll use it to compare "large font" height)
oCurs = oText.CreateTextCursor()
oCurs.GoToEnd(False)
oText.insertControlCharacter(oCurs,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,FALSE)
oCurs.ParaStyleName = "Standard"
fStandardCharHeight = oCurs.CharHeight

REM Enumerate the paragraphs.
REM Tables are enumerated along with paragraphs
oParEnum = oDoc.getText().createEnumeration()

Do While oParEnum.hasMoreElements()
   oPar = oParEnum.nextElement()
   REM This avoids the tables.
   If oPar.supportsService("com.sun.star.text.Paragraph") Then

      n = n + 1
      oPB2.setValue(n)

      'Call Paragraph analysis
      sParEx=fnExportParagraph(oPar)

      'Replace Paragraph text
      oCursor = oPar.Text.createTextCursorByRange(oPar)
      oText.insertString(oCursor,sParEx,TRUE)

   End If
Loop

oPB2.end()

'Put footnotes at the end
oPBar.start("odt2pml: Footnotes...",0)
sbMoveFootnoteText

End Sub

Sub sbMoveFootnoteText
'cfr. AndrewMacro: Listing 7.44: Delete between two delimiters with search and replace.

Dim oOpenSearch, oCloseSearch 'Open and Close descriptors
Dim oOpenFound, oCloseFound 'Open and Close find objects
Dim oCurs as object
Dim sFoot as string       'Footnote text

oCurs = oText.CreateTextCursor()

' Create descriptors from the searchable document.
oOpenSearch = oDoc.createSearchDescriptor()
oCloseSearch = oDoc.createSearchDescriptor()

' Set the text for which to search and other
oOpenSearch.SearchString = "{{"
oCloseSearch.SearchString = "}}"

' Find the first open delimiter
oOpenFound = oDoc.findFirst(oOpenSearch)
Do While Not IsNull(oOpenFound)

'Search for the closing delimiter starting from the open delimiter
oCloseFound = oDoc.findNext( oOpenFound.End, oCloseSearch)
If IsNull(oCloseFound) Then
' Print "Footnotes: Found an opening bracket but no closing bracket!"
Exit Do
Else
' Clear the open bracket
oOpenFound.setString("")
' Clear the close bracket
oCloseFound.setString("")
' select the text inside the brackets
oOpenFound.gotoRange(oCloseFound, True)
sFoot = oOpenFound.getString()
' clear the text inside the brackets
oOpenFound.setString("")

'write the text at the end of the main document
oCurs.GoToEnd(False)
oText.insertControlCharacter(oCurs,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,FALSE)
   oText.insertString(oCurs,sFoot,false)

   'continue search
oOpenFound = oDoc.findNext( oOpenFound.End, oOpenSearch)

End If
Loop
End Sub

sub sbTitle
'Cfr tutorial.pdf, StarOfﬁce Programmer’s Tutorial, p. 57
'In other locales (e. g. Spanish OOo), style names remain in English!

Dim oCurs as object

'Show text in status bar
oPBar.setText("odt2pml: Ebook title...")

sTitle=fnGetDocTitle()

'DropBook Title
oCurs = oText.CreateTextCursor()
oText.insertControlCharacter(oCurs,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,FALSE)
oCurs.gotoStart(FALSE)
oCurs.ParaStyleName = "Standard"
oText.insertString(oCurs,"\vTITLE=""" & sTitle & """\v",FALSE)

'Is there a cover image to insert?
sCover = sFileN & "_img/cover.png"
If FileExists(sCover) Then    'Insert cover image!
   oText.insertControlCharacter(oCurs,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,FALSE)
   oText.insertString(oCurs,"\m=""cover.png""",FALSE)
End If

end sub

Sub sbSpecialCodes
' From: http://www.pitonyak.org/AndrewMacro.odt, Listing 7.42: Replace multiple characters

Dim inCod(), outCod()
Dim n as integer
Dim oReplace as object

'Special cases mentioned in http://www.ereader.com/dropbook/converting and
   'http://www.ereader.com/dropbook/tips
'Table from: http://www.ereader.com/dropbook/pml/characters
   'You could add http://www.ereader.com/dropbook/pml/extended, if you need those characters.
'"€" and some other symbols (last line) are not documented. I found them in:
'http://www.memoware.com/?screen=doc_detail&doc_id=13409&p=contributor_id^!19684~!

'The first two characters are a non breaking space and a soft hyphen
inCod() = Array(" ", "", "...", ". . .", "''", CHR$(34)&"'", "'"&CHR$(34), "--",_
   "¡", "¢", "£", "¤", "¥", "¦", "§", "¨", "©", "ª",_
   "«", "¬", "", "®", "¯", "°", "±", "²", "³", "´",_
   "µ", "¶", "·", "¸", "¹", "º", "»", "¼", "½", "¾", _
   "¿", "À", "Á", "Â", "Ã", "Ä", "Å", "Æ", "Ç", "È", _
   "É", "Ê", "Ë", "Ì", "Í", "Î", "Ï", "Ð", "Ñ", "Ò", _
   "Ó", "Ô", "Õ", "Ö", "×", "Ø", "Ù", "Ú", "Û", "Ü", _
   "Ý", "Þ", "ß", "à", "á", "â", "ã", "ä", "å", "æ", _
   "ç", "è", "é", "ê", "ë", "ì", "í", "î", "ï", "ð", _
   "ñ", "ò", "ó", "ô", "õ", "ö", "÷", "ø", "ù", "ú", _
   "û", "ü", "ý", "þ", "ÿ",_
   "‚", "ƒ", "„", "…", "†", "‡", "Š", "‹", "Œ", "‘", _
   "’", "“", "”", "•", "–", "—", "™", "š", "›", "œ", "Ÿ",_
   "€", "ˆ", "‰", "♢", "♣", "♡", "♠", "˜")

outCod() = Array("\a160","\-","\a133","\a133",CHR$(34),CHR$(34)&"\a160'","'\a160"&CHR$(34),"\a151",_
   "\a161","\a162","\a163","\a164","\a165","\a166","\a167","\a168","\a169","\a170",_
   "\a171","\a172","\a173","\a174","\a175","\a176","\a177","\a178","\a179","\a180",_
   "\a181","\a182","\a183","\a184","\a185","\a186","\a187","\a188","\a189","\a190",_
   "\a191","\a192","\a193","\a194","\a195","\a196","\a197","\a198","\a199","\a200",_
   "\a201","\a202","\a203","\a204","\a205","\a206","\a207","\a208","\a209","\a210",_
   "\a211","\a212","\a213","\a214","\a215","\a216","\a217","\a218","\a219","\a220",_
   "\a221","\a222","\a223","\a224","\a225","\a226","\a227","\a228","\a229","\a230",_
   "\a231","\a232","\a233","\a234","\a235","\a236","\a237","\a238","\a239","\a240",_
   "\a241","\a242","\a243","\a244","\a245","\a246","\a247","\a248","\a249","\a250",_
   "\a251","\a252","\a253","\a254","\a255",_
   "\a130","\a131","\a132","\a133","\a134","\a135","\a138","\a139","\a140","\a145",_
   "\a146","\a147","\a148","\a149","\a150","\a151","\a153","\a154","\a155","\a156","\a159",_
   "\a128","\a136","\a137","\a141","\a142","\a143","\a144","\a152")

'Show text in new status bar
oPB3 = oCC.Frame.createStatusIndicator
oPB3.start("odt2pml: Replacing special codes...",UBound(outCod()))

oReplace = oDoc.createReplaceDescriptor()
oReplace.SearchCaseSensitive = True
oReplace.SearchRegularExpression = False

For n = LBound(inCod()) To UBound(outCod())
   oPB3.setValue(n)
   oReplace.SearchString = inCod(n)
   oReplace.ReplaceString = outCod(n)
   oDoc.ReplaceAll(oReplace)
Next n

End Sub

Function fnGetDocTitle() As String

Dim sDocTitle as String

sDocTitle = oDoc.DocumentInfo.Title

If sDocTitle = "" Then
   sDocTitle = ConvertFromURL(GetFileNameWithoutExtension(sDocURL,"/")) 'no path
End If
If Len(sDocTitle) >29 Then                'DropBook's limit
   sDocTitle = InputBox ("This title has more than 29 characters. "_
      & Chr$(13) & "Please shorten it:", "odt2pml", sDocTitle)
End If

sDocTitle = ReplaceString(sDocTitle," -",":") 'Colons not permitted in PML title
fnGetDocTitle = sDocTitle

End Function

function fnExportParagraph(oParagraph As Object) as string
'from: http://www.oooforum.org/forum/viewtopic.phtml?t=12507

Dim oEnum As Object, oEnumObj As Object
dim oFootnote as object
dim sString as string, sPortion as string, sType as string
dim sLink as string, sNam as string
dim I as integer
Static nFoot As integer 'retains its value between calls, initially 0
                  'cfr AndrewMacro, 14.2.3

oEnum = oParagraph.createEnumeration()
sString = ""
While oEnum.hasMoreElements()
oEnumObj = oEnum.nextElement()
sType = oEnumObj.TextPortionType
sPortion = oEnumObj.GetString
sLink = oEnumObj.HyperLinkURL
If sType = "Text" Then 'this portion is a text object!
if sPortion <> "" then
If oEnumObj.CharEscapement < 0 THEN 'this portion is formatted in subscript
sPortion = "\Sb" & sPortion & "\Sb"
elseif oEnumObj.CharEscapement > 100 THEN 'this portion is formatted in superscript
sPortion = "\Sp" & sPortion & "\Sp"
else                '\Sb and \Sp should not be mixed with bold, italic, etc.
   if oEnumObj.CharCaseMap = 4 THEN
   'this portion is formatted in SmallCaps
   sPortion = fnSmallCaps(sPortion)    'DropBook ignores upper/lower case!
   end if
   If oEnumObj.CharWeight > 105 THEN
   'this portion is formatted in bold. Constant values for different types of Bold:
   'http://api.openoffice.org/docs/common/ref/com/sun/star/awt/FontWeight.html
   sPortion = "\B" & sPortion & "\B"
   end if
   if oEnumObj.CharPosture = com.sun.star.awt.FontSlant.ITALIC THEN
   'this portion is formatted in italic
   sPortion = "\i" & sPortion & "\i"
   end if
   if oEnumObj.CharUnderline > 0 THEN
   'this portion is underlined. Constant values for different types of Underline:
   'http://api.openoffice.org/docs/common/ref/com/sun/star/awt/FontUnderline.html
   sPortion = "\u" & sPortion & "\u"
   end if
   if oEnumObj.CharStrikeout > 0 THEN
   'this portion is striked out. Constant values for different types of Strikeout:
   'http://api.openoffice.org/docs/common/ref/com/sun/star/awt/FontStrikeout.html
   sPortion = "\o" & sPortion & "\o"
   end if
   If oEnumObj.CharHeight > fStandardCharHeight THEN
   'this portion's font is larger than standard
   sPortion = "\l" & sPortion & "\l"
   end if
end if
if sLink <> "" then                   'this portion is a hyperlink
      For I = 0 to oBMarks.Count - 1
         sNam = oBMarks.getByIndex(I).Name
      if InStr(sLink,sNam) > 0 then    'only internal links are recognized!
      sPortion = "\q=""#" & sNam & """" & sPortion & "\q"
      exit for
   end if
      Next
end if
sString = sString & sPortion
end if

ElseIf sType = "Footnote" Then 'this portion is a footnote
nFoot = nFoot + 1
oFootnote = oEnumObj.Footnote 'get the footnote object
'If I don't call this fn, direct formatting inside footnote (bold...) gets lost.
sFootText = fnFootnoteDirectFormat(oFootnote)
sString = sString & "\Sp\Fn=""footnote" & nFoot & """[" & nFoot & "]\Fn\Sp" & _
"{{<footnote id=""footnote" & nFoot & """>" & Chr(10) & sFootText &_
Chr(10) & "</footnote>}}" 'get the footnote text into main text, with {{}}
End If

wend

'Return result, after calling fnExportParaStyle
fnExportParagraph=fnExportParaStyle(oParagraph,sString)

End function

function fnExportParaStyle(oPar as Object, sStr as String) as string

'Indentation
if oPar.ParaLeftMargin > 100 then    'this paragraph is indented (more than 1 mm)
   sStr = "\t" & sStr & "\t"
end if
if oPar.ParaFirstLineIndent > 100 then 'first line indented (more than 1 mm)
   sStr = "\a160\a160\a160\a160" & sStr '4 non-breaking spaces
end if

'Headings and lines
sStyle = oPar.ParaStyleName
Select Case sStyle
Case "Heading 1" , "heading 1"
      sStr = "\X1" & sStr & "\X1"    '"\x" would cause a new page break.
Case "Heading 2" , "heading 2"
      sStr = "\X2" & sStr & "\X2"
Case "Heading 3" , "heading 3"
      sStr = "\X3" & sStr & "\X3"
Case "Heading 4" , "heading 4"
      sStr = "\X4" & sStr & "\X4"
Case "Horizontal Line"
      sStr = "\w=""30%"""       'adding previous sStr should not be necessary!
      oPar.ParaStyleName="Standard" '30%: just because I like it so. Change it if you want!
Case Else
End Select

'Paragraph adjustment
if oPar.ParaAdjust = 3 then          'this paragraph is centered
   sStr = "\c" & sStr & Chr(10) & "\c" 'closing \c and \r must be on new line
elseif oPar.ParaAdjust = 1 then       'this paragraph is right justified
   sStr = "\r" & sStr & Chr(10) & "\r"
end if

'Top and bottom margins
if oPar.ParaTopMargin > 100 then    'this paragraph has space above (more than 1 mm)
   sStr = Chr(10) & sStr
end if
if oPar.ParaBottomMargin > 100 then    'this paragraph has space below (more than 1 mm)
   sStr = sStr & Chr(10)
end if

'Page breaks
if oPar.BreakType = 4 then          'PAGE_BEFORE
   sStr = "\p" & sStr
elseif oPar.BreakType = 5 then       'PAGE_AFTER
   sStr = sStr & "\p"
end if
   'Change in page style implies page break before paragraph!
if oPar.PageStyleName <> sPrevPageStyle then
   sStr = "\p" & sStr
   sPrevPageStyle = oPar.PageStyleName
end if

'Return result
fnExportParaStyle = sStr

' I've found no way to deal with lists. Numbers appear, without
' indents, bullets disappear...
' Cfr.: http://www.oooforum.org/forum/viewtopic.phtml?t=46054

End function

function fnFootnoteDirectFormat(oFtn as object) As String

Dim oParEnum As Object    'Enumerator used to enumerate the footnote's paragraphs
Dim oPar As Object       'The enumerated paragraph
Dim oSectionEnum As Object 'Enumerator used to enumerate the paragraph sections
Dim oSection As Object    'The enumerated section
Dim sTxt As String       'Contains the edited footnote text
Dim sPortion as string    'Part of the text being worked on

oParEnum = oFtn.getText().createEnumeration()
sTxt = ""
Do While oParEnum.hasMoreElements()
oPar = oParEnum.nextElement()
If oPar.supportsService("com.sun.star.text.Paragraph") Then
oSectionEnum = oPar.createEnumeration()
If sTxt <> "" Then       'Starting footnote's second paragraph
sTxt = sTxt & Chr(10)    'on new line
End If
Do While oSectionEnum.hasMoreElements()
oSection = oSectionEnum.nextElement()
sPortion = oSection.GetString
If oSection.TextPortionType = "Text" Then
   If oSection.CharWeight > 105 THEN
   sPortion = "\B" & sPortion & "\B"
   end if
   if oSection.CharPosture = com.sun.star.awt.FontSlant.ITALIC THEN
   sPortion = "\i" & sPortion & "\i"
   end if
   if oSection.CharUnderline > 0 THEN
   sPortion = "\u" & sPortion & "\u"
   end if
   sTxt = sTxt & sPortion
End If
Loop
End If
Loop
fnFootnoteDirectFormat() = sTxt
end function

Function fnSmallCaps( sStr As String ) As String
'DropBook ignores upper/lowercase in SmallCaps ==> this function formats only
'lowercase letters as SmallCaps.
'cfr: Danny's Basic Library, http://www.oooforum.org/forum/viewtopic.phtml?p=73061#73061
Const cLC = "abcdefghijklmnopqrstuvwxyzßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ"
Dim i as integer
Dim c as string
Dim cResult as string

cResult = ""
For i = 1 To Len( sStr )
c = Mid( sStr, i, 1 )
If InStr( 1, cLC, c, 0 ) > 0 Then
c = "\k" & c & "\k"
EndIf
cResult = cResult & c
Next
fnSmallCaps() = cResult
End Function

Last edited by poxi1023 on Tue Jul 29, 2008 11:49 am; edited 3 times in total

poxi1023
General User

Joined: 08 Jul 2007
Posts: 24

Posted: Tue Feb 05, 2008 7:34 pm Post subject:

I have actualized the code in my previous post, because I added some minor improvements: soft hyphens, strikeout, better handling of hyperlinks, and original document reloading. As far as I see, all PML features are now implemented in order to achieve the best possible WYSIWYG. My next goal is to transform this into an OOo Extension. Please report bugs, requests and suggestions here or PM me. Enjoy!

poxi1023
General User

Joined: 08 Jul 2007
Posts: 24

Posted: Fri Feb 22, 2008 5:27 pm Post subject: Version 3, with dialogs

Well, finally version 3 is ready as OOo extension. I polished the code and added dialog wizards and helper macros, one of them John Vigor's Ascii Formatter. See: http://extensions.services.openoffice.org/project/odt2pml

Display posts from previous:

	OOoForum.org Forum Index -> OpenOffice.org Code Snippets	All times are GMT - 8 Hours
Page 1 of 1

You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum