1 ; +-----------------------+
2 ; | PureHTML Highlighting |
3 ; +-----------------------+
4
5 ;-
6 ;- Constants
7
8 ; File IDs
9 #PHF_In = 0
10 #PHF_Out = 1
11
12 ; Library IDs
13 #PHL = 0
14
15
16
17 ; Library file patterns
18 CompilerSelect (#PB_Compiler_OS)
19 CompilerCase (#PB_OS_Windows)
20 #PH_LibFile = "SyntaxHilighting.dll"
21 #PH_LibPattern = "DLL Files|*.dll|All Files (*.*)|*.*"
22 CompilerCase (#PB_OS_MacOS)
23 ;? #PH_LibFile =
24 CompilerEndSelect
25
26
27
28
29 ;-
30 ;- Procedures
31
32
33 ; Search for the syntax highlighter library
34 Procedure.i FindLibrary()
35 Protected Result.i = #Null
36 Protected PBHome.s = ""
37 Protected File.s = ""
38 Protected i.i, n.i
39
40 For i = 0 To CountProgramParameters() - 2
41 If (LCase(ProgramParameter(i)) = "-lib")
42 Result = OpenLibrary(#PHL, Trim(ProgramParameter(i+1), #DQUOTE$))
43 If (Result)
44 Break
45 EndIf
46 EndIf
47 Next
48 If (Not Result)
49 Result = OpenLibrary(#PHL, #PH_LibFile)
50 EndIf
51 If (Result)
52 Config\LibFile = GetCurrentDirectory() + #PH_LibFile
53 Else
54 PBHome = GetEnvironmentVariable("PUREBASIC_HOME")
55 If (PBHome)
56 File = PBHome + "SDK" + #PS$ + "Syntax Highlighting" + #PS$ + #PH_LibFile
57 Result = OpenLibrary(#PHL, File)
58 EndIf
59 If (Result)
60 Config\LibFile = File
61 Else
62 File = OpenFileRequester("Syntax Highlighting Library", GetCurrentDirectory(), #PH_LibPattern, 0)
63 If (File)
64 Result = OpenLibrary(#PHL, File)
65 EndIf
66 EndIf
67 EndIf
68
69 ProcedureReturn (Result)
70 EndProcedure
71
72
73
74
75
76 ; Format an integer as a CSS color
77 Procedure.s CSSColor(Color.i)
78 Color = RGB(Blue(Color), Green(Color), Red(Color))
79 ProcedureReturn ("#" + RSet(Hex(Color), 6, "0"))
80 EndProcedure
81
82
83
84
85
86
87 ; Encode HTML text safely
88 Procedure.s EncodeHTML(Input.s)
89
90 ; Escape ampersands (must be done first!)
91 Input = ReplaceString(Input, "&", "&")
92
93 ; Replace whitespace with non-breaking spaces
94 Input = ReplaceString(Input, #TAB$, RSet("", Config\TabLength, " "))
95 CompilerIf (Not #PH_CompactSpaces)
96 Input = ReplaceString(Input, " ", " ")
97 Input = ReplaceString(Input, " ", " ")
98 CompilerEndIf
99
100 ; Escape HTML brackets
101 Input = ReplaceString(Input, "<", "<")
102 Input = ReplaceString(Input, ">", ">")
103
104 ; Escape all newlines
105 CompilerIf (#PH_CompactSpaces)
106 Input = ReplaceString(Input, #CRLF$, #LF$)
107 Input = ReplaceString(Input, #CR$, #LF$)
108 CompilerElse
109 Input = ReplaceString(Input, #CRLF$, "<br/>")
110 Input = ReplaceString(Input, #CR$, "<br/>")
111 Input = ReplaceString(Input, #LF$, "<br/>")
112 Input = ReplaceString(Input, "<br/>", "<br/>" + #LF$)
113 CompilerEndIf
114
115 ProcedureReturn (Input)
116 EndProcedure
117
118
119 ; Check if "string" starts with "prefix" (case insensitive)
120 Procedure.i Starts(String.s, Prefix.s)
121 If (LCase(Left(String, Len(Prefix))) = LCase(Prefix))
122 ProcedureReturn (#True)
123 Else
124 ProcedureReturn (#False)
125 EndIf
126 EndProcedure
127
128
129
130
131
132 ; Callback used by the syntax highlighter library (writes out HTML data)
133 Procedure HTMLCallback(*Position, Length.i, Type.i)
134 Static Raw.s, Breaks.i, Prefix.s
135 Static PrevLine.i, PreWhite.s, PostWhite.s, IncludeNext.i, IncludeSuffix.i
136 Static i.i, j.i, Link.s, LFIndex.i, HTML.s
137
138 Raw = PeekS(*Position, Length)
139
140 If (Config\HideIDE)
141 If (Left(Raw, 16) = "; IDE Options = ")
142 Config\Hidden = #True
143 EndIf
144 EndIf
145
146 If (Length And (Not Config\Hidden))
147 HTML = EncodeHTML(Raw)
148
149 LFIndex = FindString(HTML, #LF$, 1)
150 If (LFIndex)
151 Raw = Mid(HTML, 1, LFIndex)
152 Else
153 Raw = HTML
154 EndIf
155
156 While (Raw)
157
158 PreWhite = ""
159 Repeat
160 If (Left(Raw, 6) = " ")
161 Raw = Mid(Raw, 7)
162 PreWhite + " "
163 ElseIf (Left(Raw, 1) = " ")
164 Raw = Mid(Raw, 2)
165 PreWhite + " "
166 Else
167 Break
168 EndIf
169 ForEver
170
171 PostWhite = ""
172 Repeat
173 If (Right(Raw, 6) = " ")
174 Raw = Left(Raw, Len(Raw) - 6)
175 PostWhite + " "
176 ElseIf (Right(Raw, 1) = " ")
177 Raw = Left(Raw, Len(Raw) - 1)
178 PostWhite + " "
179 Else
180 Break
181 EndIf
182 ForEver
183
184 If (Config\LineCount = 0)
185 PrevLine = 0
186 IncludeNext = 0
187 Config\LineCount = 1
188 EndIf
189
190 If (Config\IncludeLinks)
191 If (Starts(Raw, "includefile") Or Starts(Raw, "xincludefile"))
192 IncludeNext = 2
193 IncludeSuffix = #True
194 ElseIf (Starts(Raw, "includepath") Or Starts(Raw, "includebinary"))
195 IncludeNext = 2
196 IncludeSuffix = #False
197 EndIf
198 EndIf
199
200 If (Config\LineNumbers)
201 If (Config\LineCount <> PrevLine)
202 Prefix = RSet(Str(Config\LineCount), Config\LineDigits + 1, " ") + " "
203 CompilerIf (Not #PH_CompactSpaces)
204 Prefix = ReplaceString(Prefix, " ", " ")
205 CompilerEndIf
206 Prefix = "<span class='" + StyleRef(#PHS_LineNumber) + "'>" + Prefix + "</span>"
207 WriteString(#PHF_Out, Prefix)
208 PrevLine = Config\LineCount
209 EndIf
210 Breaks = CountString(Raw, #LF$)
211 Config\LineCount + Breaks
212 EndIf
213
214 WriteString(#PHF_Out, PreWhite)
215 If (Raw)
216 WriteString(#PHF_Out, "<span class='" + StyleRef(Type) + "'>")
217 If (IncludeNext = 1)
218 i = FindString(Raw, #DQUOTE$, 1)
219 If (i)
220 j = FindString(Raw, #DQUOTE$, i + 1)
221 EndIf
222 If (Not (i And j))
223 IncludeNext = 0
224 EndIf
225 EndIf
226 If (IncludeNext = 1)
227 WriteString(#PHF_Out, Mid(Raw, 1, i))
228 Link = Mid(Raw, i+1, j - i - 1)
229 WriteString(#PHF_Out, "<a href='" + EncodeHTML(Link))
230 If (IncludeSuffix)
231 WriteString(#PHF_Out, "." + GetExtensionPart(Config\OutFile))
232 EndIf
233 WriteString(#PHF_Out, "'>" + Link)
234 WriteString(#PHF_Out, "</a>")
235 WriteString(#PHF_Out, Mid(Raw, j))
236 IncludeNext = 0
237 Else
238 If (IncludeNext = 2)
239 IncludeNext = 1
240 EndIf
241 WriteString(#PHF_Out, Raw)
242 EndIf
243 WriteString(#PHF_Out, "</span>")
244 EndIf
245 WriteString(#PHF_Out, PostWhite)
246
247 If (LFIndex)
248 HTML = Mid(HTML, LFIndex + 1)
249 LFIndex = FindString(HTML, #LF$, 1)
250 If (LFIndex)
251 Raw = Mid(HTML, 1, LFIndex)
252 Else
253 Raw = HTML
254 EndIf
255 Else
256 Raw = ""
257 EndIf
258
259 Wend
260 EndIf
261 EndProcedure
262
263
264 ; Count the number of lines in a text buffer
265 Procedure CountLines(*Buffer)
266 Protected *C.CHARACTER, CRs.i, LFs.i
267
268 If (*Buffer)
269 *C = *Buffer
270 While (*C\c)
271 If (*C\c = #LF)
272 LFs + 1
273 ElseIf (*C\c = #CR)
274 CRs + 1
275 EndIf
276 *C + SizeOf(CHARACTER)
277 Wend
278
279 If (LFs > 0)
280 Config\LineTotal = LFs
281 Else
282 Config\LineTotal = CRs
283 EndIf
284 If (Config\LineTotal)
285 Config\LineDigits = Int(Log10(Config\LineTotal)) + 1
286 Else
287 Config\LineDigits = 1
288 EndIf
289
290 EndIf
291 EndProcedure
292
293
294
295 ; Syntax-highlight a specific source file, save as the specified HTML file
296 Procedure.i HighlightFile(Input.s, Output.s)
297 Protected Result.i = #False
298 Protected *InBuffer, InLength.i
299 Protected CSS.s, i.i, Temp.s
300
301 If (Input And ReadFile(#PHF_In, Input))
302 If (Output And CreateFile(#PHF_Out, Output))
303 InLength = Lof(#PHF_In)
304 If (InLength > 0)
305 *InBuffer = AllocateMemory(InLength + 8)
306 If (*InBuffer)
307 If (ReadData(#PHF_In, *InBuffer, InLength))
308 Config\LineCount = 0
309 Config\Hidden = #False
310 CountLines(*InBuffer)
311
312 ; Generate body CSS style
313 If (Config\LineNumbers)
314 CSS = " margin:0px;" + #LF$
315 Else
316 CSS = ""
317 EndIf
318 CSS + " background-color:" + CSSColor(Config\BGColor) + ";" + #LF$
319 CSS + " font-family:" + Config\FontName + ",monospace;" + #LF$
320 CSS + " font-size:" + Str(Config\FontSize) + "pt;" + #LF$
321 CompilerIf (#PH_CompactSpaces)
322 CSS + " white-space:pre;" + #LF$
323 CompilerEndIf
324
325 If (Config\FullPage)
326
327 ; Generate HTML header
328 WriteString(#PHF_Out, "<!DOCTYPE html PUBLIC " + #DQUOTE$ + "-//W3C//DTD XHTML 1.0 Transitional//EN" + #DQUOTE$ + " " + #LF$)
329 WriteString(#PHF_Out, " " + #DQUOTE$ + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" + #DQUOTE$ + ">" + #LF$)
330 WriteString(#PHF_Out, "<html>" + #LF$)
331 WriteString(#PHF_Out, "<head>" + #LF$)
332 ;WriteString(#PHF_Out, "<!ENTITY sp >" + #LF$)
333 WriteString(#PHF_Out, "<title>" + EncodeHTML(GetFilePart(Input)) + "</title>" + #LF$ + #LF$)
334
335 ; Generate a comment header
336 WriteString(#PHF_Out, "<!-- Generated using " + #PH_Title + " " + VersionString(#PH_Version) + " -->" + #LF$)
337 WriteString(#PHF_Out, "<!-- Original file: " + GetFilePart(Input) + " -->" + #LF$)
338 WriteString(#PHF_Out, "<!-- Date: " + FormatDate("%mm/%dd/%yyyy, %hh:%ii", Date()) + " -->" + #LF$ + #LF$)
339
340 ; Generate CSS style table
341 WriteString(#PHF_Out, "<style type='text/css'>" + #LF$)
342 WriteString(#PHF_Out, "body {" + #LF$ + CSS + "}" + #LF$)
343 For i = 0 To #PHS_Count - 1
344 WriteString(#PHF_Out, "span." + StyleRef(i) + " {" + #LF$)
345 WriteString(#PHF_Out, " color:" + CSSColor(Style(i)\Color) + ";" + #LF$)
346 If (i = #PHS_LineNumber)
347 WriteString(#PHF_Out, " background-color:" + CSSColor(Config\LNColor) + ";" + #LF$)
348 EndIf
349 If (Style(i)\Bold)
350 WriteString(#PHF_Out, " font-weight:bold;" + #LF$)
351 EndIf
352 If (Style(i)\Italic)
353 WriteString(#PHF_Out, " font-style:italic;" + #LF$)
354 EndIf
355 If (Style(i)\Underline)
356 Temp = "underline,"
357 Else
358 Temp = ""
359 EndIf
360 If (Style(i)\Strike)
361 Temp + "line-through,"
362 EndIf
363 If (Temp)
364 WriteString(#PHF_Out, " text-decoration:" + Trim(Temp, ",") + ";" + #LF$)
365 EndIf
366
367 WriteString(#PHF_Out, "}" + #LF$)
368 Next i
369 WriteString(#PHF_Out, "a:link { color:inherit; text-decoration:underline; }" + #LF$)
370 WriteString(#PHF_Out, "a:visited { color:inherit; text-decoration:underline; }" + #LF$)
371 WriteString(#PHF_Out, "a:hover { color:" + CSSColor(Style(#PHS_Keyword)\Color) + "; text-decoration:underline; }" + #LF$)
372 WriteString(#PHF_Out, "a:active { color:" + CSSColor(Style(#PHS_Keyword)\Color) + "; text-decoration:underline; }" + #LF$)
373 WriteString(#PHF_Out, "</style>" + #LF$)
374
375 ; Generate body header
376 WriteString(#PHF_Out, "</head>" + #LF$)
377 WriteString(#PHF_Out, "<body>")
378 CompilerIf (Not #PH_CompactSpaces)
379 WriteString(#PHF_Out, #LF$ + #LF$)
380 CompilerEndIf
381 Else
382 ;? partial HTML (paragraph with border?)
383 EndIf
384
385 ; Call Syntax Highlighting library
386 CompilerSelect (#PB_Compiler_OS)
387 CompilerCase (#PB_OS_Windows)
388 CallFunction(0, "SyntaxHighlight", *InBuffer, InLength, @HTMLCallback(), 0)
389 CompilerDefault
390 ;?
391 CompilerEndSelect
392
393 ; Finish full HTML page
394 If (Config\FullPage)
395
396 ; Remove extra linefeed
397 If (Config\Hidden)
398 CSS = #LF$ + "</span>"
399 i = Len(CSS)
400 Temp = Space(i)
401 FileSeek(#PHF_Out, Loc(#PHF_Out) - i)
402 ReadData(#PHF_Out, @Temp, i)
403 If (Temp = CSS)
404 FileSeek(#PHF_Out, Loc(#PHF_Out) - i)
405 WriteString(#PHF_Out, "</span>")
406 EndIf
407 EndIf
408
409 ; Generate HTML footer
410 WriteString(#PHF_Out, "</body>" + #LF$)
411 WriteString(#PHF_Out, "</html>")
412 Else
413 ;? partial HTML
414 EndIf
415
416 Result = #True
417 EndIf
418 FreeMemory(*InBuffer)
419 EndIf
420 EndIf
421 CloseFile(#PHF_Out)
422 Else
423 EndIf
424 CloseFile(#PHF_In)
425 Else
426 EndIf
427
428 ProcedureReturn (Result)
429 EndProcedure
430
431
432
433 ; Search the specified folder and highlight all source files
434 Procedure.i HighlightFolder(Path.s)
435 Protected Result.i = #False
436 NewList InFile.s()
437
438 Config\SuccessFiles = ""
439 Config\FailedFiles = ""
440 If (ExamineDirectory(0, Path, ""))
441 While (NextDirectoryEntry(0))
442 If (DirectoryEntryType(0) = #PB_DirectoryEntry_File)
443 Select (LCase(GetExtensionPart(DirectoryEntryName(0))))
444 Case "pb", "pbi"
445 AddElement(InFile())
446 InFile() = Path + DirectoryEntryName(0)
447 EndSelect
448 EndIf
449 Wend
450 FinishDirectory(0)
451 If (ListSize(InFile()) > 0)
452 Result = #True
453
454 ForEach (InFile())
455 Config\InFile = InFile()
456 Config\OutFile = InFile() + ".htm"
457 If (HighlightFile(Config\InFile, Config\OutFile))
458 Config\SuccessFiles + Config\OutFile + #LF$
459 Else
460 Config\FailedFiles + Config\OutFile + #LF$
461 Result = #False
462 EndIf
463 Next
464
465 Config\SuccessFiles = RTrim(Config\SuccessFiles, #LF$)
466 Config\FailedFiles = RTrim(Config\FailedFiles, #LF$)
467 If (Not Result)
468 If (Config\SuccessFiles)
469 Warn("Generated:" + #LF$ + Config\SuccessFiles + #LF$ + #LF$ + "Failed:" + #LF$ + Config\FailedFiles)
470 Else
471 Warn("Failed to generate:" + #LF$ + Config\FailedFiles)
472 EndIf
473 EndIf
474
475 Else
476 Warn("No PureBasic files found!")
477 EndIf
478 Else
479 Warn("Input path could not be found!")
480 EndIf
481
482 Config\OutFile = ""
483
484 ProcedureReturn (Result)
485 EndProcedure
486
487
488
489
490
491 ; Validate the form and begin file/folder highlight
492 Procedure.i TryHighlight()
493 Protected Result.i = #True
494 Protected Valid.i = #True
495
496 Config\InFile = GetGadgetText(#PHG_InFile)
497 Config\OutFile = GetGadgetText(#PHG_OutFile)
498 Config\Folder = GetGadgetState(#PHG_InPathOption)
499 Config\InPath = GetGadgetText(#PHG_InPath)
500 Config\InPath = RTrim(Config\InPath, #PS$)
501
502 Config\FullPage = #True
503 Config\FontName = GetGadgetText(#PHG_FontName)
504 Config\FontSize = Val(GetGadgetText(#PHG_FontSize))
505 Config\BGColor = GetGadgetData(#PHG_BGColor)
506 Config\TabLength = Val(GetGadgetText(#PHG_TabLength))
507 Config\LineNumbers = GetGadgetState(#PHG_LineNumbers)
508 Config\LNColor = GetGadgetData(#PHG_LNColor)
509 Config\HideIDE = GetGadgetState(#PHG_HideIDE)
510 Config\IncludeLinks = GetGadgetState(#PHG_Links)
511 Config\OpenDone = GetGadgetState(#PHG_OpenDone)
512
513 If (Config\Folder)
514 If (Config\InPath)
515 Valid = #True
516 Else
517 Warn("Select a valid input folder.")
518 SetActiveGadget(#PHG_InPath)
519 Valid = #False
520 EndIf
521 Else
522 If (Config\InFile)
523 If (Config\OutFile)
524 Valid = #True
525 Else
526 Warn("Select a valid output file.")
527 SetActiveGadget(#PHG_OutFile)
528 Valid = #False
529 EndIf
530 Else
531 Warn("Select a valid input file.")
532 SetActiveGadget(#PHG_InFile)
533 Valid = #False
534 EndIf
535 EndIf
536
537 If (Valid)
538 If (Config\Folder)
539 Result = HighlightFolder(Config\InPath + #PS$)
540 If (Result)
541 If (Config\OpenDone)
542 RunProgram(Config\InPath + #PS$)
543 Else
544 Info("Successfully generated:" + #LF$ + Config\SuccessFiles)
545 EndIf
546 Else
547 ; handled in HighlightFolder(), maybe should be here
548 EndIf
549 Else
550 Result = HighlightFile(Config\InFile, Config\OutFile)
551 If (Result)
552 If (Config\OpenDone)
553 RunProgram(Config\OutFile)
554 Else
555 Info("Successfully generated:" + #LF$ + Config\OutFile)
556 EndIf
557 Else
558 Warn("Failed to generate:" + #LF$ + Config\OutFile)
559 EndIf
560 EndIf
561 EndIf
562
563 ProcedureReturn (Result)
564 EndProcedure
565
566 ;-
567 ; EOF