' Datos globales
Dim Shared NoSimbolo
Dim Shared PalRes$(50)
Dim Shared NPalRes
Dim Shared Simbolos$(40)
Dim Shared NSimbolos
Dim Shared IdEstandar$(40)
Dim Shared NIdEstandar
Dim Shared Estado
Dim Shared PosIniCom
Dim Shared PosIniCad
Dim Shared NCom
Dim Shared CarCad$
Dim Shared Com1$, Com2$
Dim Shared Cad1$, Cad2$

Sub MAIN
	' Esta rutina recorre un programa fuente en Módula2 (previamente 
	'importado por Word), resaltando palabras reservadas, comentarios,
	' etc.
	' Con poco trabajo se puede adaptar para otros lenguajes

	' Datos
	Estado = 0 :' 0-Normal, 1-Comentario, 2-String
	NoSimbolo = 10000
	Com1$ = "(*"
	Com2$ = "*)"
	Cad1$ = Chr$(34)
	Cad2$ = "'"

	Inicializa

' Empezamos a recorrer el documento
PrincipioDeDocumento
While Not(AlFinalDelDocumento())
 SelecPalabraActual
 Palabra$ = Selección$()

 ' Primero vemos si es palabra reservada o id. estandar
 ' Si no es un simbolo, vemos si es una palabra reservada
 If Estado = 0 Then
	' Si no es ni cadena de texto, ni comentario, ver que es
	' ¿Será palabra reservada?
	If Busca(Palabra$, PalRes$, NPalRes) >= 0 Then
		Negrita 1
	ElseIf Busca(Palabra$, IdEstandar$, NIdEstandar) >= 0 Then
		Negrita 1
		CarácterColor 2
 	Else
		ResaltaSimbolo(Palabra$)
	End If
	
 Else
   ResaltaSimbolo(Palabra$)
 End If :' Fin de If (Estado=0)
 

 ' Palabra siguiente
 PalabraDerecha
Wend

End Sub

Sub Inicializa
	' Lista de palabras reservadas. 
	PalRes$(0) = "AND"
	PalRes$(1) = "ARRAY"
	PalRes$(2) = "BEGIN"
	PalRes$(3) = "BY"
	PalRes$(4) = "CASE"
	PalRes$(5) = "CONST"
	PalRes$(6) = "DEFINITION"
	PalRes$(7) = "DIV"
	PalRes$(8) = "DO"
	PalRes$(9) = "ELSE"
	PalRes$(10) = "ELSIF"
	PalRes$(11) = "END"
	PalRes$(12) = "EXIT"
	PalRes$(13) = "EXPORT"
	PalRes$(14) = "FOR"
	PalRes$(15) = "FROM"
	PalRes$(16) = "IF"
	PalRes$(17) = "IMPLEMENTATION"
	PalRes$(18) = "IMPORT"
	PalRes$(19) = "IN"
	PalRes$(20) = "LOOP"
	PalRes$(21) = "MOD"
	PalRes$(22) = "MODULE"
	PalRes$(23) = "NOT"
	PalRes$(24) = "OF"
	PalRes$(25) = "OR"
	PalRes$(26) = "POINTER"
	PalRes$(27) = "PROCEDURE"
	PalRes$(28) = "QUALIFIED"
	PalRes$(29) = "RECORD"
	PalRes$(30) = "REPEAT"
	PalRes$(31) = "RETURN"
	PalRes$(32) = "SET"
	PalRes$(33) = "THEN"
	PalRes$(34) = "TO"
	PalRes$(35) = "TYPE"
	PalRes$(36) = "UNTIL"
	PalRes$(37) = "VAR"
	PalRes$(38) = "WHILE"
	PalRes$(39) = "WITH"

	NPalRes = 39

	Ordena(PalRes$, NPalRes)

	' Ahora Los Simbolos
	Simbolos$(0) = "+"
	Simbolos$(1) = "'"
	Simbolos$(2) = "-"
	Simbolos$(3) = "*"
	Simbolos$(4) = "/"
	Simbolos$(5) = "="
	Simbolos$(6) = "#"
	Simbolos$(7) = "<>"
	Simbolos$(8) = "<="
	Simbolos$(9) = "<"
	Simbolos$(10) = ">="
	Simbolos$(11) = ">"
	Simbolos$(12) = "&"
	Simbolos$(13) = "~"
	Simbolos$(14) = "("
	Simbolos$(15) = ")"
	Simbolos$(16) = "["
	Simbolos$(17) = "]"
	Simbolos$(18) = "{"
	Simbolos$(19) = "}"
	Simbolos$(20) = ":="
	Simbolos$(21) = "."
	Simbolos$(22) = ","
	Simbolos$(23) = ":"
	Simbolos$(24) = ";"
	Simbolos$(25) = "|"
	Simbolos$(26) = ".."
	Simbolos$(27) = "^"

	NSimbolos = 27
	Ordena(Simbolos$, NSimbolos)

	' Identificadores estandar
	IdEstandar$(0) = "VAL"
	IdEstandar$(1) = "ABS"
	IdEstandar$(2) = "BITSET"
	IdEstandar$(3) = "BOOLEAN"
	IdEstandar$(4) = "CAP"
	IdEstandar$(5) = "CARDINAL"
	IdEstandar$(6) = "CHAR"
	IdEstandar$(7) = "CHR"
	IdEstandar$(8) = "DEC"
	IdEstandar$(9) = "EXCL"
	IdEstandar$(10) = "FALSE"
	IdEstandar$(11) = "FLOAT"
	IdEstandar$(12) = "HALT"
	IdEstandar$(13) = "HIGH"
	IdEstandar$(14) = "INC"
	IdEstandar$(15) = "INCL"
	IdEstandar$(16) = "INTEGER"
	IdEstandar$(17) = "LONGINT"
	IdEstandar$(18) = "LONGREAL"
	IdEstandar$(19) = "MAX"
	IdEstandar$(20) = "MIN"
	IdEstandar$(21) = "NIL"
	IdEstandar$(22) = "ODD"
	IdEstandar$(23) = "ORD"
	IdEstandar$(24) = "PROC"
	IdEstandar$(25) = "REAL"
	IdEstandar$(26) = "SIZE"
	IdEstandar$(27) = "TRUE"
	IdEstandar$(28) = "TRUNC"
	NIdEstandar = 28
	Ordena(IdEstandar$, NIdEstandar)


End Sub
' Mira Palabra$, resalta los simbolos y gestiona los comentarios y los 'inicios de cadena


Sub ResaltaSimbolo(Palabra$)
' Nos recorremos las palabra letra por letra hasta que deje de coincidir
	
	i = 1
	PosIni = ObtenerPosIniSel()
	lPalabra = Len(Palabra$)

	While i <= lPalabra

	If Estado = 0 Then

	 TxtTmp$ = ""
	 nSimb = NoSimbolo
	 iIni = i

	 ' Extraemos un simbolo
	 While (Estado = 0) And (i <= lPalabra)
	  ultSimb = nSimb
	  TxtTmp$ = TxtTmp$ + Mid$(Palabra$, i, 1)
	  ' Vemos si es inicio de cadena o de comentario
	  If (TxtTmp$ = Cad1$) Or (TxtTmp$ = Cad2$) Then
		  ' Es un inicio de cadena
		  PosIniCad = PosIni + i - 1
		  Estado = 2 :' Dentro de cadena
		  ' Recordamos con que abrimos la cadena
		  CarCad$ = TxtTmp$
	  ElseIf TxtTmp$ = Com1$ Then
		  ' Es un inicio de comentario
		  PosIniCom = PosIni + i - 2
		  Estado = 1 :' Dentro de comentario
		  NCom = 1
	  Else
		' Ni cadena ni comentario, ¿será un simbolo?
 	    nSimb = BuscaSimbolo(TxtTmp$)
		If (nSimb < 0) Then
		  ' Si antes de este carácter, había un simbolo válido marcar
		  If (ultSimb <> NoSimbolo) And (ultSimb < 500) Then
	      	' Hemos encontrado un simbolo, y completo
		  	FijarIntervaloSelección PosIni + iIni - 1, PosIni + i - 1
		  	Negrita 1
		  	CarácterColor 14
		  End If

		  ' De todas formas, palabra nueva
		  iIni = iIni + 1
		  i = iIni - 1
		  TxtTmp$ = ""
		  nSimb = NoSimbolo
		End If
		' Si el nSimb>500, pues que siga currando
	  End If
	  i = i + 1
	 Wend
	 ' Solo salimos de aquí si se termino la palabra o si se
	 ' empezó una cadena o comentario
	 ' Si antes de terminar había un simbolo válido, pués a ello
	  If (Estado = 0) And (nSimb < 500) Then
	      ' Hemos encontrado un simbolo, y completo
		  FijarIntervaloSelección PosIni + iIni - 1, PosIni + i - 1
		  Negrita 1
		  CarácterColor 14
	  End If


	ElseIf Estado = 1 Then
	  ' Estamos dentro de un comentario
	  ' Seguimos analizando la palabra buscando marcas de comentario
	  While (NCom > 0) And (i < lPalabra)
		If (Mid$(Palabra$, i, 2) = Com1$) Then
			NCom = NCom + 1
		ElseIf Mid$(Palabra$, i, 2) = Com2$ Then
			NCom = NCom - 1
		End If
		i = i + 1
	  Wend
	  i = i + 1
	  If (NCom = 0) Then
		'Termina el comentario, resaltar
		FijarIntervaloSelección PosIniCom, PosIni + i - 1
		Cursiva 1
		Estado = 0
	  End If


	Else
		'Estado es 2 y estamos en una cadena, vemos si termina
		While (i <= lPalabra) And (Estado = 2)
			If (Mid$(Palabra$, i, 1) = CarCad$) Then
		  		'Termina la cadena, resaltar
		  		FijarIntervaloSelección PosIniCad, PosIni + i
		  		Cursiva 1
		  		Negrita 1
		  		Estado = 0
			End If
			i = i + 1
		Wend
	End If :' Fin de If Estado=0...
	Wend :' Fin de while i<Len(Palabra$)

End Sub

Function BuscaSimbolo(Texto$)

	' Buscamos primero coincidencia total
	nSimb = Busca(Texto$, Simbolos$, NSimbolos)
	If nSimb > 0 Then
		BuscaSimbolo = nSimb
	Else
		BuscaSimbolo = BuscaP(Texto$, Simbolos$, NSimbolos)
	End If
End Function

' Ordena el vector de cadenas que se le pasa
Sub Ordena(Vector$(), n)
For i = 1 To n - 1
  k = i : x$ = vector$(i)
  For j = i + 1 To n
	If vector$(j) < x$ Then
		k = j : x$ = vector$(k)
	End If
  Next j
  vector$(k) = vector$(i) : vector$(i) = x$
Next i
End Sub

'
' Busca un elemento en un vector ordenado
Function Busca(x$, Vector$(), n)
  l = 0 : r = n - 1
  While l < r
	m = Int((l + r) / 2)
	If vector$(m) < x$ Then
		l = m + 1
	Else
		r = m
	End If
  Wend
  If vector$(r) = x$ Then
	Busca = r
  Else
	Busca = - 1
  End If
End Function

'
' Busca un elemento en un vector ordenado (coincidencia parcial)
Function BuscaP(x$, Vector$(), n)
  l = 0 : r = n - 1
  lon = Len(x$)
  While l < r
	m = Int((l + r) / 2)
	If Left$(vector$(m), lon) < x$ Then
		l = m + 1
	Else
		r = m
	End If
  Wend
  If Left$(vector$(r), lon) = x$ Then
	BuscaP = r
  Else
	BuscaP = - 1
  End If
End Function