Voilà ce qui traîne sur le net pour Dokuwiki !
ça marche pas mal mais j'ignore à qui ça appartient ...???
Au fait si vous connaissez un hébergeur gratuit proposant dokuwiki ...
Christophe
Const sBOLDSTART = "**"
Const sBOLDEND = "**"
Const sUNDERSTART = "__"
Const sUNDEREND = "__"
Const sITALICSTART = "//"
Const sITALICEND = "//"
Const sMONOSTART = "''"
Const sMONOEND = "''"
Const sSUPERSTART = "<sup>"
Const sSUPEREND = "</sup>"
Const sSUBSTART = "<sub>"
Const sSUBEND = "</sub>"
Const sDELSTART = "<del>"
Const sDELEND = "</del>"
Const sFOOTSTART = "(("
Const sFOOTEND = "))"
Const sHEADCHAR = "="
Const sHORIZLINE = "----"
Const sTABLESEP = "|"
Const sTABLEHEADSEP = "^"
Const sNEWLINE = "\\ "
Const sLITERALSTART = "%%"
Const sLITERALEND = "%%"
Const sORDEREDLIST = "-"
Const sUNORDEREDLIST = "*"
Const sHYPERSTART = "[["
Const sHYPEREND = "]]"
Const sPICTURESTART = "{{wiki:"
Const sPICTUREEND = "}}"
Const sCODESTART = "<code "
Const sDEFAULTCODE = "oobas"
Private sLineEnd As String
Private s As String
Private oVC
Private bInCode As Boolean
Private mCodes
'This routine processes all html files in a directory tree.
Sub Folders()
Dim mTextFile(0)
mTextFile(0) = createUnoStruct("com.sun.star.beans.PropertyValue")
mTextFile(0).name = "FilterName"
mTextFile(0).Value = "Text"
basicLibraries.loadLibrary ("Tools")
'ReadDirectories(ByVal AnchorDir As String, bRecursive as Boolean,
bcheckFileType as Boolean, bGetByTitle as Boolean, Optional
sFileContent(), Optional sExtension as String)
mFiles = ReadDirectories("/var/www/html/dokuwiki/data/ref", True, False,
False, , "html")
'sStart = "file:///var/www/html/dokuwiki/data/"
'nStart = len(sStart) + 1
For i = 0 To UBound(mFiles)
sFile = mFiles(i)
If RIGHT(sFile, 5) = ".html" Then
oSourceDoc = StarDesktop.loadComponentFromURL(sFile, "_blank",
0, array())
oText = oSourceDoc.text
oDestDoc =
StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0,
array())
oDestText = oDestDoc.getText()
' oCursor = oDestText.createTextCursor()
oVC = oDestDoc.CurrentController.viewCursor
subDokuWiki (oText)
' oVC.text.insertString(oVC.text.end,
"[[http://api.openoffice.org/docs/common/"; & mid(sFile, nStart) & "]]",
false)
oDestDoc.storeAsUrl(left(sFile,len(sFile)-4) & "txt", mTextFile())
oDestDoc.close (True)
oSourceDoc.close (False)
' kill sFile 'Uncomment this line to remove the original file
End If
Next
End Sub
'This is the main routine to run on the currently open document
Sub DokuWiki()
oSourceDoc = thisComponent
oDestDoc = fnDokuWiki(oSourceDoc)
'oDestDoc.close(false)
End Sub
Function fnDokuWiki(oSourceDoc)
oText = oSourceDoc.text
'Create a new document
oNewDoc = StarDesktop.loadComponentFromURL("private:factory/swriter",
"_blank", 0, array())
oNewText = oNewDoc.getText()
oCursor = oNewText.createTextCursor()
'oNewText.insertString(oCursor,sDokuWiki , true)
oVC = oNewDoc.CurrentController.viewCursor
mCodes = array("actionscript", "ada", "apache", "asm", "asp", "bash",
"caddcl", "cadlisp", "c_mac", "cpp", "csharp", _
"css", "delphi", "html4strict", "javascript", "java", "lisp", "lua",
"nsis", "objc", "oobas", "pascal", "perl", _
"php-brief", "php", "python", "qbasic", "smarty", "sql", "vbnet",
"vb", "visualfoxpro", "xml", "c")
subDokuWiki (oText)
'Copy to clipboard
'There is a way of doing this via the API but this will do
oVC.gotoStart (False)
oVC.gotoEnd (True)
oFrame = oNewDoc.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:Copy", "", 0, array())
fnDokuWiki = oNewDoc
End Function
Sub subDokuWiki(oText)
sLineEnd = chr(10)
'If not oDoc.supportsService("com.sun.star.text.TextDocument") then
' msgBox "Sorry - I can only create DokuWiki documents out of text
documents", 16, "Error"
' exit function
'end if
s = ""
oEnum1 = oText.createEnumeration
' loop over all paragraphs
While oEnum1.hasMoreElements
oTextElement = oEnum1.nextElement
If oTextElement.supportsService("com.sun.star.text.Paragraph") Then
subParagraph (oTextElement)
ElseIf
oTextElement.supportsService("com.sun.star.text.TextTable") Then
subTable (oTextElement)
End If
Wend
If bInCode Then
subAddString ("</code>" & sLineEnd)
End If
End Sub
Sub subParagraph(oTextElement)
nHeadLevel = oTextElement.ParaChapterNumberingLevel + 1
bInList = False
sCode = oTextElement.ParaStyleName
sCode = fnInCode(sCode)
If bInCode And sCode = "" Then
subAddString ("</code>" & sLineEnd)
bInCode = False
End If
If nHeadLevel >= 1 And nHeadLevel <= 5 Then
sHead = string(7 - nHeadLevel, sHEADCHAR)
subAddString (sLineEnd & sHead & oTextElement.string & sHead &
sLineEnd)
ElseIf sCode <> "" Then
If Not bInCode Then
subAddString (sCODESTART & sCode & ">" & sLineEnd)
bInCode = True
End If
subAddString (oTextElement.string & sLineEnd)
Else
If oTextElement.NumberingIsNumber Then 'if not
isEmpty(oTextElement.NumberingLevel) then
' xray.xray oTextElement
bInList = True
subAddString (string((oTextElement.NumberingLevel + 1)
* 2, " "))
If InStr("0123456789", left(oTextElement.string, 1)) >
0 Then
subAddString (sORDEREDLIST)
Else
subAddString (sUNORDEREDLIST)
End If
End If
oEnum2 = oTextElement.createEnumeration
' loop over all text portions
While oEnum2.hasMoreElements
oTextPortion = oEnum2.nextElement
subAddString (fnTextPortion(oTextPortion, False))
Wend
subAddString (sLineEnd)
If oTextElement.bottomBorder.OuterLineWidth > 0 Then
subAddString (sHORIZLINE & sLineEnd)
Else
If Not bInList Then subAddString (sLineEnd)
End If
End If
End Sub
Sub subTable(oTable)
mCellNames = oTable.getCellNames
nmaxCols = 0
For i = 0 To UBound(mCellNames)
sCellName = mCellNames(i)
nCol = 0
For j = 1 To Len(sCellName)
ch = mid(sCellName, j, 1)
Select Case ch
Case "A" To "Z"
nCol = nCol * 26 + (asc(ch) - asc("A"))
Case "0" To "9"
'nRow = val(mid(sCellName, j)) - 1
Exit For
End Select
Next
If nCol > nmaxCols Then nmaxCols = nCol
Next
nRows = oTable.rows.count - 1
If nmaxCols = 0 Then
For i = 0 To nRows
oCell = oTable.getCellByPosition(0, i)
oCellEnum = oCell.createEnumeration
While oCellEnum.hasMoreElements
subParagraph (oCellEnum.nextElement)
Wend
Next
Exit Sub
End If
Dim mCells(nRows, nmaxCols)
'for i = 0 to nRows
' for j = 0 to nmaxCols - 1
' mCells(i, j) = ""
' next
'next
For i = 0 To UBound(mCellNames)
sCellName = mCellNames(i)
nCol = 0
For j = 1 To Len(sCellName)
ch = mid(sCellName, j, 1)
Select Case ch
Case "A" To "Z"
nCol = nCol * 26 + (asc(ch) - asc("A"))
Case "0" To "9"
nRow = val(mid(sCellName, j)) - 1
Exit For
End Select
Next
oCell = oTable.getCellByName(sCellName)
sCell = " "
oCellEnum = oCell.createEnumeration
While oCellEnum.hasMoreElements
oTextElement = oCellEnum.nextElement
If sCell <> " " Then
sCell = sCell & sNEWLINE
End If
If oTextElement.ParaStyleName = "Table Heading" Then
sSep = sTABLEHEADSEP
Else
sSep = sTABLESEP
End If
If oTextElement.NumberingIsNumber Then
If InStr("0123456789",
left(oTextElement.string, 1)) > 0 Then
sCell = sCell &
str(val(oTextElement.string))
Else
sCell = sCell & "* "
End If
End If
oPortionEnum = oTextElement.createEnumeration
While oPortionEnum.hasMoreElements
oTextPortion = oPortionEnum.nextElement
sCell = sCell & fnTextPortion(oTextPortion, True)
Wend
Wend
sCell = trim(sCell)
Select Case oTextElement.paraAdjust
Case com.sun.star.style.ParagraphAdjust.CENTER
sCell = " " & sCell & " "
Case com.sun.star.style.ParagraphAdjust.RIGHT
sCell = " " & sCell
End Select
mCells(nRow, nCol) = sCell
Next
For i = 0 To nRows
sRow = ""
sRow = sRow & sTABLESEP
bHeading = False
For j = 0 To nmaxCols
If mCells(i, j) <> "" Then
If j = 0 And InStr(mCells(i, j), chr(10)) = 0 Then
bHeading = True
Else
bHeading = False
End If
End If
sRow = sRow & mCells(i, j) & sTABLESEP
Next
If bHeading Then
If i = 0 Then
sRow = string(6, sHEADCHAR) & mCells(i, 0) &
string(6, sHEADCHAR) & sLineEnd & sLineEnd
Else
sRow = string(5, sHEADCHAR) & mCells(i, 0) &
string(5, sHEADCHAR) & sLineEnd & sLineEnd
End If
Else
sRow = sRow & sLineEnd
End If
subAddString (sRow)
Next
subAddString (sLineEnd)
End Sub
Function fnTextPortion(oTextPortion, bInTable As Boolean)
If Not isNull(oTextPortion.footnote) Then
fnTextPortion = sFOOTSTART & oTextPortion.footnote.string &
sFOOTEND
ElseIf oTextPortion.hyperlinkURL <> "" Then
'NB: If the link has separate text portions (i.e. formats
inside it) this will repeat the link :(
fnTextPortion = sHYPERSTART &
fnHyperConvert(oTextPortion.hyperlinkURL) & sTABLESEP &
oTextPortion.string & sHYPEREND
ElseIf oTextPortion.TextPortionType = "Frame" Then
'The above condition may need to be tightened
sName =
oTextPortion.createContentEnumeration("com.sun.star.text.TextContent").nextElement.name
If sName <> "" Then
fnTextPortion = sPICTURESTART & sName & sPICTUREEND
End If
Else
sPortion = oTextPortion.string
If sPortion = "" Then
fnTextPortion = ""
Exit Function
End If
If bInTable Then
'In case the separators are actually in the text of the
table
mSplits = split(sPortion, sTABLESEP)
sPortion = join(mSplits, sLITERALSTART & sTABLESEP &
sLITERALEND)
mSplits = split(sPortion, sTABLEHEADSEP)
sPortion = join(mSplits, sLITERALSTART & sTABLEHEADSEP
& sLITERALEND)
Else
'In the unlikley event of a paragraph starting and
finishing with separator characters.
sFirstChar = left(sPortion, 1)
If sFirstChar = sTABLESEP Or sFirstChar = sTABLEHEADSEP
Then
sPortion = sLITERALSTART & sFirstChar &
sLITERALEND & mid(sPortion, 2)
End If
End If
'Convert smart quotes
mSplits = split(sPortion, "“")
sPortion = join(mSplits, chr(34))
mSplits = split(sPortion, "�")
sPortion = join(mSplits, chr(34))
mSplits = split(sPortion, "‘")
sPortion = join(mSplits, "'")
mSplits = split(sPortion, "’")
sPortion = join(mSplits, "'")
'Convert em dashes
mSplits = split(sPortion, "–")
sPortion = join(mSplits, "-")
'In case the text holds any of the formatting charaters make
sure that they are treated literally
mSplits = split(sPortion, sBOLDSTART)
sPortion = join(mSplits, sLITERALSTART & sBOLDSTART & sLITERALEND)
mSplits = split(sPortion, sUNDERSTART)
sPortion = join(mSplits, sLITERALSTART & sUNDERSTART & sLITERALEND)
mSplits = split(sPortion, sITALICSTART)
sPortion = join(mSplits, sLITERALSTART & sITALICSTART &
sLITERALEND)
mSplits = split(sPortion, sMONOSTART)
sPortion = join(mSplits, sLITERALSTART & sMONOSTART & sLITERALEND)
mSplits = split(sPortion, sSUPERSTART)
sPortion = join(mSplits, sLITERALSTART & sSUPERSTART & sLITERALEND)
mSplits = split(sPortion, sSUBSTART)
sPortion = join(mSplits, sLITERALSTART & sSUBSTART & sLITERALEND)
mSplits = split(sPortion, sDELSTART)
sPortion = join(mSplits, sLITERALSTART & sDELSTART & sLITERALEND)
mSplits = split(sPortion, sFOOTSTART)
sPortion = join(mSplits, sLITERALSTART & sFOOTSTART & sLITERALEND)
mSplits = split(sPortion, sPICTURESTART)
sPortion = join(mSplits, sLITERALSTART & sPICTURESTART &
sLITERALEND)
mSplits = split(sPortion, sCODESTART)
sPortion = join(mSplits, sLITERALSTART & sCODESTART & sLITERALEND)
mSplits = split(sPortion, sLineEnd)
sPortion = join(mSplits, sNEWLINE & " ")
'This is not very elegant as it will produce **bold**//**bold &
italic**//
'rather than **bold//bold & italic//**
If oTextPortion.charWeight > 100 Then sPortion = sBOLDSTART &
sPortion & sBOLDEND
If oTextPortion.charPosture > 0 Then sPortion = sITALICSTART &
sPortion & sITALICEND
If oTextPortion.charUnderline > 0 Then sPortion = sUNDERSTART &
sPortion & sUNDEREND
If oTextPortion.charFontPitch =
com.sun.star.awt.FontPitch.FIXED Then sPortion = sMONOSTART & sPortion &
sMONOEND
If oTextPortion.charEscapement > 0 Then sPortion = sSUPERSTART
& sPortion & sSUPEREND
If oTextPortion.charEscapement < 0 Then sPortion = sSUBSTART &
sPortion & sSUBEND
If oTextPortion.charStrikeOut > 0 Then sPortion = sDELSTART &
sPortion & sDELEND
fnTextPortion = sPortion
End If
End Function
Function fnHyperConvert(sURL As String) As String
Const sINTLINK = "doku.php?id="
'sIDL = "vnd.sun.star.help://sbasic/text/sbasic/shared/"
'sGuide = "file:///var/www/html/dokuwiki/DevelopersGuide"
'nIDL = len(sIDL)
'nGuide = len(sGuide)
nStartInternalLink = InStr(sURL, sINTLINK)
If nStartInternalLink > 0 Then
nStartInternalLink = nStartInternalLink + Len(sINTLINK)
fnHyperConvert = mid(sURL, nStartInternalLink)
'elseif sIDL = left(sURL, nIDL) then
' sTemp = mid(sURL, nIDL + 1)
' sTemp = left(stemp,(instr(sTemp, ".xhp")-1))
' mSplits = split(sTemp, ".html")
' sTemp = join(mSplits, "")
' mSplits = split(sTemp, "/")
fnHyperConvert = sTemp 'join(mSplits, ":")
'elseif left(sURL, nGuide) = sGuide then
' sTemp = "http://api.openoffice.org/docs/DevelopersGuide"; &
mid(sURL, nGuide + 1)
' mSplits = split(sTemp, ".xhtml")
' fnHyperConvert = join(mSplits, ".htm")
Else
fnHyperConvert = sURL
End If
End Function
Function fnInCode(sParaStyleName)
nCode = InStr(1, sParaStyleName, "Code")
If nCode > 0 Then
nCode = nCode + 4
For i = 0 To UBound(mCodes)
If InStr(nCode, sParaStyleName, mCodes(i)) > 0 Then
fnInCode = mCodes(i)
Exit For
End If
Next
ElseIf sParaStyleName = "Preformatted Text" Then
fnInCode = sDEFAULTCODE
Else
fnInCode = ""
End If
End Function
Sub subAddString(sAdd As String)
If sAdd = sLineEnd Then 'A paragraph can't be > 64k therefore this hack
makes sure of some paragraph breaks
oVC.text.insertControlCharacter(oVC,
com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
Else
oVC.text.insertString(oVC, sAdd , false)
End If
End Sub
---------------------------------------------------------------------
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
