'===========================================================================
' Subject: HTML Tag Stripper                  Date: 06-15-01 (19:34)       
'  Author: Vincent Voois                      Code: XBASIC                 
'  Origin: vvacme@worldonline.nl            Packet: XBASIC.ABC
'===========================================================================
'
'
' ####################
' #####  PROLOG  #####
' ####################
'
PROGRAM	"htmlTagStripper"  ' 1-8 char program/file name without .x or any .extent
VERSION	"1.0000"    ' version number - increment before saving altered program
'
' This text manipulator strips html tags out of HTML pages to make them readable
' within text-applications
'
' Done by Vincent Voois
'
'
' ******  Comment libraries in/out as needed  *****
'
'	IMPORT	"xma"   ' Math library     : SIN/ASIN/SINH/ASINH/LOG/EXP/SQRT...
'	IMPORT	"xcm"   ' Complex library  : complex number library  (trig, etc)
	IMPORT	"xst"   ' Standard library : required by most programs
'	IMPORT	"xgr"   ' GraphicsDesigner : required by GuiDesigner programs
'	IMPORT	"xui"   ' GuiDesigner      : required by GuiDesigner programs
'
TYPE LITERAL
	XLONG	.Start
	XLONG	.End
END TYPE

DECLARE FUNCTION  Entry ()
DECLARE FUNCTION  RemoveTags (data$)
DECLARE FUNCTION  GetLiterals (data$)

LITERAL #Literals[-1]
'
'
' ######################
' #####  Entry ()  #####
' ######################
'
' Programs contain:
'
'   Simply a small demonstration program to quickly remove HTML-tags from within HTML files.
'   It does not work when tags are spread across more lines than one!
'
FUNCTION  Entry ()
STATIC HtmlLines
STATIC TLiterals$[]

SaveFile$ = "e:/html/ds1.ohe"
ReadFile$ = "e:/html/test.html"

	XstClearConsole()

	XstLoadStringArray(ReadFile$, @HtmlArray$[])

	data$ = ""

FOR HtmlLines = 0 TO UBOUND(HtmlArray$[])
	data$ = HtmlArray$[HtmlLines]

	MyError = GetLiterals(@data$)

	IF MyError THEN
		PRINT #MCError$
	END IF


'##############################################################################
'remove all literals so that scanning variables, commands and values are easier
'##############################################################################

	IF UBOUND(#Literals[]) > -1 THEN
		REDIM TLiterals$[UBOUND(#Literals[])]

		FOR X = 0 TO UBOUND(#Literals[])

			IF (#Literals[X].End-1-#Literals[X].Start) > 0  THEN
				TLiterals$[X] = MID$(data$, #Literals[X].Start + 1, #Literals[X].End-1-#Literals[X].Start)
			ELSE
				TLiterals$[X] = ""
			END IF

		NEXT X

		FOR X = 0 TO UBOUND(TLiterals$[])
			Replace = SIZE(TLiterals$[X]) + 2

			LocateLiteral$ = CHR$(34) + TLiterals$[X] + CHR$(34)

			Start = INSTR(data$, LocateLiteral$)

			Add$ = "^L" + TRIM$(STRING$(X))

			IF Replace > 0 THEN
				data$ = XstMergeStrings$(data$, Add$, Start, Replace)
			END IF

		NEXT X

'		PRINT data$

	END IF

'##########################################################
'space out special characters to make them a separate token
'##########################################################

	done = $$FALSE
	Char = 0
	RepChar$ = ""

	IF data$ THEN

		DO

			SELECT CASE data${Char}

				CASE 60, 62	'<, >
					RepChar$ = " " + CHR$(data${Char}) + " "

			END SELECT

			IF RepChar$ THEN
				TrimChar$ = TRIM$(RepChar$)

				replace = SIZE(TrimChar$)

				data$ = XstMergeStrings$ (data$, RepChar$, Char + 1, replace)

				SkipSize  =  replace + 2

				Char = Char + SkipSize
			ELSE
				INC Char
			END IF

			RepChar$ = ""

			IF Char > SIZE(data$)-1 THEN
				done = $$TRUE
			END IF


		LOOP UNTIL done

	END IF


	MyError = RemoveTags(@data$)

	data$ = TRIM$(data$)

'#####################################################################################################
' In the end after we removed the tags, we will bring back the literals that were not inside the tags.
' (We do want to have the HTML text contents do we?)
'#####################################################################################################

	DO
		IF INSTRI(data$, "^L") THEN
			EndOfLine = SIZE(data$)-1

			FOR X = INSTRI(data$, "^L") + 1 TO EndOfLine

				IF  data${X} = 32 THEN
					EXIT FOR
				END IF

				TempVal$ = TempVal$ + CHR$(data${X})
			NEXT X
			Replace = SIZE(TempVal$) + 2
			Location = INSTRI(data$, "^L")
			Reset$ = TLiterals$[XLONG(TempVal$)]

			data$ = XstMergeStrings$(data$, Reset$, Location, Replace)
		ELSE
			EXIT DO
		END IF

	LOOP

	PRINT STRING$(HtmlLines+1);" :"; data$
	HtmlArray$[HtmlLines] = data$
NEXT HtmlLines


XstSaveStringArray(SaveFile$ @HtmlArray$[])

END FUNCTION
'
'
' ###########################
' #####  RemoveTags ()  #####
' ###########################
'
'
' To remove all html-<#Tags#> we steal the same code and construction to find the double quotes in the literal scanner.
' Now we also remove the tags as soon as we found them all.
'
'
FUNCTION  RemoveTags (data$)


	REDIM TSlash[-1]
	REDIM #Literals[-1]
	#CommentStart = 0

	QuoteStatus = 0

	index = 0

	FOR X = 0 TO SIZE(data$) -1

		SELECT CASE data${X}

			CASE 60	' <

					QuoteLiteral = 0

					REDIM #Literals[UBOUND(#Literals[])+1]

					#Literals[UBOUND(#Literals[])].Start = X + 1

			CASE 62  ' >

					QuoteLiteral = 0

					IF UBOUND(#Literals[]) <> -1 THEN
						#Literals[UBOUND(#Literals[])].End = X + 1
					END IF


		END SELECT

	NEXT X

	IF UBOUND(#Literals[]) > -1 THEN
		REDIM TLiterals$[UBOUND(#Literals[])]

		FOR X = 0 TO UBOUND(#Literals[])

			IF (#Literals[X].End-1-#Literals[X].Start) > 0  THEN
				TLiterals$[X] = MID$(data$, #Literals[X].Start + 1, #Literals[X].End-1-#Literals[X].Start)
			ELSE
				TLiterals$[X] = ""
			END IF

		NEXT X

		FOR X = 0 TO UBOUND(TLiterals$[])
			LocateLiteral$ = "<" + TLiterals$[X] + ">"

			Start = INSTR(data$, LocateLiteral$) - 1

			Replace = SIZE(LocateLiteral$)+1

			Add$ = ""

			IF Replace > 0 THEN
				data$ = XstMergeStrings$(data$, Add$, Start, Replace)
			END IF

		NEXT X

'		PRINT data$

	END IF

'	FOR X = 0 TO UBOUND(#Literals[])
'		PRINT #Literals[X].Start + 1; " - " ; #Literals[X].End-1-#Literals[X].Start ; " -> " ;
'		PRINT MID$(data$, #Literals[X].Start + 1, #Literals[X].End-1-#Literals[X].Start)
'	NEXT X


END FUNCTION
'
'
' ############################
' #####  GetLiterals ()  #####
' ############################
'
'
' To prevent that we detect a "<" or a ">" in a literal text-line as an openening or closing marker we will first replace
' all literals for a "^L#"  marker  so "My dog in the window" becomes ^L0 if it is the first literal in the line or ^L1
' if it is the second and so on.
'
'
FUNCTION  GetLiterals (data$)


	REDIM TSlash[-1]
	REDIM #Literals[-1]
	#CommentStart = 0

	QuoteStatus = 0

	index = 0

	IF INSTRI(data$, "^") THEN
		#MCError$ = "Error, \"^\" Invalid sign in variable"

		RETURN -1
	END IF

	FOR X = 0 TO SIZE(data$) -1

		SELECT CASE data${X}

			CASE 92 ' \
				REDIM TSlash[UBOUND(TSlash[])+1]
				TSlash[UBOUND(TSlash[])] = X+1

			CASE 34, 39  ' ", '

				IFZ QuoteStatus THEN

					QuoteLiteral = 0

					FOR Z = 0 TO UBOUND(TSlash[])

						IF TSlash[Z] == X THEN
							#MCError$ = "No opening quote or illegal character in variable!"

							RETURN -1
						END IF

					NEXT Z

					REDIM #Literals[UBOUND(#Literals[])+1]

					#Literals[UBOUND(#Literals[])].Start = X + 1

					QuoteStatus = QuoteStatus XOR 1
				ELSE
					QuoteLiteral = 0

					FOR Z = 0 TO UBOUND(TSlash[])

						IF TSlash[Z] == X THEN
							QuoteLiteral = 1
						END IF

					NEXT Z

					IFZ QuoteLiteral THEN
						#Literals[UBOUND(#Literals[])].End = X + 1

						QuoteStatus = QuoteStatus XOR 1
					END IF

				END IF

		END SELECT

	NEXT X

	IF QuoteStatus THEN
		#MCError$ = "No opening / closing quote or illegal character in variable"

		RETURN -1
	END IF

' Test procedure
'	FOR X = 0 TO UBOUND(#Literals[])
'		PRINT #Literals[X].Start + 1; " - " ; #Literals[X].End-1-#Literals[X].Start; " -> ";
'		PRINT MID$(data$, #Literals[X].Start + 1, #Literals[X].End-1-#Literals[X].Start)
'	NEXT X

END FUNCTION
END PROGRAM