Convert script to HTML.scpt

-- Configuration settings
property makeCompleteHTMLFile : true

-- Global properties
property nl : ASCII character 10
property CSSArray : 0
property attributeRunArray : 0

on run
	tell application "Script Editor"
		set currentDoc to document 1
		set HTMLString to ""
		
		set HTMLString to HTMLString & "<pre class=\"applescript\">" & nl
		set numberOfRuns to number of (every attribute run in text of currentDoc)
		repeat with i from 1 to numberOfRuns
			set atts to properties of attribute run i of text of currentDoc
			set HTMLString to HTMLString & "<span class=\"as" & (my makeAttributeRunIntoCSSStyle(properties of attribute run i of text of currentDoc)) & "\">"
			set HTMLString to HTMLString & my replaceAllInListFast(attribute run i of text of currentDoc, {"&", "<", ">"}, {"&amp;", "&lt;", "&gt;"}) & "</span>"
		end repeat
		
		set HTMLString to HTMLString & "</pre>"
		
		set HTMLFile to ""
		if (makeCompleteHTMLFile) then
			set HTMLFile to "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"
    \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">
<html xmlns=\"http://www.w3.org/1999/xhtml\">" & nl & "<head>" & nl & "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\" />
" & nl & "<style type=\"text/css\">" & nl & "/*<![CDATA[*/" & nl & nl
			
			repeat with CSSStyle in CSSArray
				if class of CSSStyle is string then set HTMLFile to HTMLFile & CSSStyle
			end repeat
			
			set HTMLFile to HTMLFile & nl & "/*]]>*/" & nl & "</style>" & nl & "<title>" & name of currentDoc & "</title>" & nl & "</head>" & nl & "<body>" & nl
			
			set HTMLFile to HTMLFile & HTMLString & nl & "</body>" & nl & "</html>" & nl
		else
			set HTMLFile to "/***** CSS *****/" & nl
			repeat with CSSStyle in CSSArray
				if class of CSSStyle is string then set HTMLFile to HTMLFile & CSSStyle
			end repeat
			set HTMLFile to HTMLFile & nl & nl & "/***** HTML ****/" & nl
			set HTMLFile to HTMLFile & HTMLString
		end if
		
		
	end tell
	
	set fileDest to choose file name
	set tmpUTF16file to "/private/tmp/utf16-" & text 3 thru -1 of ((random number) as text)
	set tmpUTF16file to POSIX file tmpUTF16file
	set theFile to open for access tmpUTF16file with write permission
	write HTMLFile to theFile
	close access theFile
	
	convertFileEncoding(tmpUTF16file, fileDest, "UTF-16", "UTF-8")
	
	tell application "System Events"
		if name extension of fileDest is "" then
			set name of fileDest to name of fileDest & ".html"
		end if
	end tell
	
end run

on convertColor(c)
	set x to ""
	
	repeat with z from 1 to 3
		
		set i to ((item z of c) / 256) - 1 as integer
		
		if i = -1 then
			set i to 0
		end if
		
		set j to i / 17 as integer
		
		if j = 15 then
			set x to x & "F"
		else if j = 14 then
			set x to x & "E"
		else if j = 13 then
			set x to x & "D"
		else if j = 12 then
			set x to x & "C"
		else if j = 11 then
			set x to x & "B"
		else if j = 10 then
			set x to x & "A"
		else
			set x to x & j as string
		end if
		
		set j to i mod 16
		
		if j = 15 then
			set x to x & "F"
		else if j = 14 then
			set x to x & "E"
		else if j = 13 then
			set x to x & "D"
		else if j = 12 then
			set x to x & "C"
		else if j = 11 then
			set x to x & "B"
		else if j = 10 then
			set x to x & "A"
		else
			set x to x & j as string
		end if
	end repeat
	return x
end convertColor

on replaceAll(str, chr, repl)
	if str contains chr then
		repeat while str contains chr
			set i to offset of chr in str
			
			if (i is not 1) then
				set frnt to characters 1 thru (i - 1) of str
			else
				set frnt to ""
			end if
			if (i + 1 ≤ length of str) then
				set bck to characters (i + 1) thru length of str
			else
				set bck to ""
			end if
			
			set str to (frnt as string) & repl & (bck as string)
		end repeat
	end if
	return str
end replaceAll

on makeAttributeRunIntoCSSStyle(attRun)
	set x to attRun as list as string
	if attributeRunArray contains x then
		return indexOfItemInList(x, attributeRunArray)
	else
		set attributeRunArray to attributeRunArray & {x}
		
		-- Add attribute properties to CSSArray
		set css to ".as" & length of attributeRunArray & " {" & nl
		if (x contains "bold") then set css to css & "	font-weight: bold;" & nl
		if (x contains "italic") then set css to css & "	font-style: italic;" & nl
		set css to css & "	color: #" & my convertColor(color of attRun) & ";" & nl
		set css to css & "}" & nl
		set CSSArray to CSSArray & {css}
	end if
	return length of attributeRunArray
end makeAttributeRunIntoCSSStyle

on indexOfItemInList(itm, lst)
	repeat with i from 1 to number of items in lst
		if item i of lst is equal to itm then
			return i
		end if
	end repeat
	return -1
end indexOfItemInList



on convertFileEncoding(inFile, outFile, fromEncoding, toEncoding)
	if class of inFile is not string then set inFile to POSIX path of inFile
	if class of outFile is not string then set outFile to POSIX path of outFile
	-- fromEncoding and toEncoding have to be encodings supported by iconv
	do shell script "iconv -f " & fromEncoding & " -t " & toEncoding & space & quoted form of inFile & " > " & quoted form of outFile
end convertFileEncoding



on replaceAllInListFast(theHaystack, theNeedles, theReplacements)
	if ((count of theNeedles) is (count of theReplacements)) then
		repeat with i from 1 to count of theNeedles
			set theHaystack to ListToString from (stringToList from theHaystack for item i of theNeedles) for item i of theReplacements
		end repeat
	end if
	return theHaystack
end replaceAllInListFast

on replaceAllFast(theHaystack, theNeedle, theReplacement)
	return ListToString from (stringToList from theHaystack for theNeedle) for theReplacement
end replaceAllFast

on ListToString from theList for myDelimiters
	tell AppleScript
		
		-- Diese Funktion ermöglicht das Unterteilen von Strings anhand beliebiger Zeichen
		-- AppleScript wird veranlaßt Listeneinträge mit myDelimiters (z.B. ";") als Trennzeichen zu einem Text zu verbinden	
		set theSavedDelimiters to AppleScript's text item delimiters
		set text item delimiters to myDelimiters
		
		set outString to theList as text
		
		
		-- Um möglichen Probleme in diesem und anderen Scripts aus dem Weg zu gehen, 
		-- wird alles wieder in den vorherigen Zustand gebracht
		-- Restore the text item delimiters (in the interests of being a good citizen).
		set text item delimiters to theSavedDelimiters
		
		return outString
	end tell
end ListToString

on stringToList from theString for myDelimiters
	tell AppleScript
		
		-- Diese Funktion ermöglicht das Unterteilen von Strings anhand beliebiger Zeichen
		-- AppleScript wird veranlaßt Text anhand von myDelimiters (z.B. ";") in Einzelteile zu zerlegen	
		set theSavedDelimiters to AppleScript's text item delimiters
		set text item delimiters to myDelimiters
		
		set outList to text items of theString
		
		
		-- Um möglichen Probleme in diesem und anderen Scripts aus dem Weg zu gehen, 
		-- wird alles wieder in den vorherigen Zustand gebracht
		-- Restore the text item delimiters (in the interests of being a good citizen).
		set text item delimiters to theSavedDelimiters
		
		return outList
	end tell
end stringToList