OpenOffice.org Forum at OOoForum.orgThe OpenOffice.org Forum
 
 [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

 
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets
View previous topic :: View next topic  
Author Message
poxi1023
General User
General User


Joined: 08 Jul 2007
Posts: 24

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

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:
    * How to get footnotes into main text
    * How to write something in the main text at the location of bookmarks, links or graphics
    * Nested status indicator bars
    * File manipulation and Shell calls under Linux and Windows
    * How to identify character and paragraph properties
    * Mark only lowercase letters in a string
    * etc...

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, StarOffice 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
Back to top
View user's profile Send private message
poxi1023
General User
General User


Joined: 08 Jul 2007
Posts: 24

PostPosted: Tue Feb 05, 2008 7:34 pm    Post subject: Reply with quote

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!
Back to top
View user's profile Send private message
poxi1023
General User
General User


Joined: 08 Jul 2007
Posts: 24

PostPosted: Fri Feb 22, 2008 5:27 pm    Post subject: Version 3, with dialogs Reply with quote

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
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets All times are GMT - 8 Hours
Page 1 of 1

 
Jump to:  
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


Powered by phpBB © 2001, 2005 phpBB Group