#!/usr/bin/newlisp

;; @module      jedit-mode-generator
;; @description jEdit newLISP mode generator
;; @author      m35, Lutz
;; @location    http://www.newlisp.org/index.cgi?Code_Contributions
;; @version 0.42 - generates jEdit 4.2 compatable syntax
;; @version 0.43 - added type 2 in sym-to-xml for 9.4.5 and after, L.M. Nov 2008
;; @version 0.50 - generates jEdit 4.3 compatable syntax, added newlispdoc and deprecated symbols, m35 Nov 2008
;; @version 0.51 - general code and newlispdoc improvements, added platform specific symbols, m35 Dec 2008
;; @version 0.52 - added missing '@link' and fixed digit regex, m35 Dec 2008
;; @version 0.53 - Fixed digit regex more, m35 Dec 2008
;;
;; Written for newLISP v10, newlispdoc 2.0, and jEdit 4.3pre15
;;
;; Generates the xml for a jEdit newLISP edit mode.
;; All default primitives and symbols found in the MAIN context will be
;; added as keywords.
;;
;; Copy the file created with this program to your jEdit "modes" sub-directory
;; in your jEdit settings directory.
;;
;; Your modes directory is:
;;
;; On Windows<br> <tt>%USERPROFILE%\.jedit\modes\</tt>
;;
;; On Linux and Mac<br> <tt>~/.jedit/modes/</tt>
;;
;; Be sure to also include a line in your "catalog" file, also found in your
;; modes sub-directory. e.g.
;; <pre>
;; &lt;MODE NAME="newlisp" FILE="<generated file>" FILE_NAME_GLOB="*.lsp" FIRST_LINE_GLOB="#!/*newlisp*"/&gt;
;; </pre>
;; There are a number of ways you can customize jEdit's syntax highlighting.
;; For more information, see your jEdit documentation about writing edit modes.

; Copy all the MAIN symbols into MAIN-SYMBOLS context
(dolist (x (symbols))
	(set (sym x 'MAIN-SYMBOLS) (eval x))
)

; Three symbols need to be restored: $idx, x, and MAIN-SYMBOLS

(set 'MAIN-SYMBOLS:$idx nil) ; the $idx symbol is nil by default

(delete 'MAIN-SYMBOLS:x)     ; the x symbol doesn't exist by default

; and the MAIN-SYMBOLS symbol doesn't exist by default
; (have to set the symbol to nil before deleting it
;  to prevent crash on earlier newlisp versions)
(set 'MAIN-SYMBOLS:MAIN-SYMBOLS nil)
(delete 'MAIN-SYMBOLS:MAIN-SYMBOLS)

;-------------------------------------------------------------------------------

(set 'generator-version "0.53")

(set 'deprecated '(default command-line unless integer))

(set 'platform-specific 
	'(fork net-ping parse-date peek share unicode utf8 utf8len wait-pid)
)

; Check properties of the newlisp environment
(set 'istk? (lambda? tk))
(set 'ver (sys-info -2))
(set 'isutf8? (not (zero? (& (sys-info -1) 128))))

(set 'generator-comment
	(append
		{<!-- Generated by jedit-newlisp-mode-generator v} generator-version { -->}
	)
)
(set 'newlisp-comment
	(string
		{<!-- with newLISP}
		(if istk? "-tk" "") " v." ver " on " ostype (if isutf8? " UTF-8" "")
		{ -->}
	)
)

; Escapes forbidden XML characters: & < >
(define (encode-xml s)
   (replace ">" (replace "<" (replace "&" s "&amp;") "&lt;") "&gt;")
)

; Converts a newLISP symbol to jEdit xml
(define (sym-to-xml x , sym-type sym-name i)
	; Find the symbol type using the (dump) function.
	; <http://www.alh.net/newlisp/phpbb/viewtopic.php?p=219>
	; See newlisp.h in the source distribution for the full list of values.
	(set 'sym-type
		(& 15 (nth 1 (dump (eval x))))
	)
	(set 'sym-name (string x))
	; Remove the context from the symbol name (is there a better way to do this?)
	(if (set 'i (find ":" sym-name))
		(set 'sym-name (slice sym-name (+ i 1) ) )
	)


	(case sym-type
		(0  ; nil and other symbols that have a nil value
			(if (= sym-name "nil")
				"<KEYWORD2>nil</KEYWORD2>"
				(if (starts-with (string x) "MAIN:")
					nil ; tk has a leftover symbol (MAIN:result)
					(append "<KEYWORD3>" (encode-xml sym-name) "</KEYWORD3>")
				)
			)
		)
		(1  ; true and other symbols that = true
			(if (= sym-name "true")
				"<KEYWORD2>true</KEYWORD2>"
				(append "<KEYWORD3>" (encode-xml sym-name) "</KEYWORD3>")
			)
		)
		(2  ; symbols that are a number (none by default, but just in case)
			(append "<KEYWORD3>" (encode-xml sym-name) "</KEYWORD3>")
		)
		(4  ; symbols that are a string: ostype
			(append "<KEYWORD3>" (encode-xml sym-name) "</KEYWORD3>")
		)
		(6  ; contexts: MAIN, SYS (for tk), Class, and Tree
			(append "<KEYWORD4>" (encode-xml sym-name) "</KEYWORD4>")
		)
		(7  ; primitive functions
			(append "<KEYWORD1>" (encode-xml sym-name) "</KEYWORD1>")
		)
		(11 ; expressions (i.e. lists)
			(append "<KEYWORD3>" (encode-xml sym-name) "</KEYWORD3>")
		)
		(12 ; lambda (exit in newlisp-tk)
			(append "<KEYWORD1>" (encode-xml sym-name) "</KEYWORD1>")
		)
		(true
			; New and exciting symbols must have been
			; added since newLISP v10 that we don't
			; have handling for.
			(throw-error
				(string "Unhandled type " sym-type " for symbol " sym-name)
			)
		)
	)
)

; Maps the symbols of a context to the proper jEdit XML code
; Also adds fn and lambda to the list, and the list of deprecated symbols
(define (print-symbols-mapped-to-xml ctx int-indent str-indent , sym-to-xml-list line)

	(set 'sym-to-xml-list
		(append 
			; add platform specific symbols
			; this formatting will be overridden by any duplicates below
			(map (fn (x) (string "<INVALID>" x "</INVALID>" )) 
				platform-specific
			)
			; add fn and lambda
			'( {<KEYWORD1>fn</KEYWORD1>} {<KEYWORD1>lambda</KEYWORD1>} )
			(sort
				(map sym-to-xml (symbols ctx) )
			)
			; add deprecated symbols
			; this formatting will override any duplicates above
			(map (fn (x) (string "<INVALID>" x "</INVALID>" )) 
				deprecated
			)
		)
	)

	(dolist (line sym-to-xml-list)
		(println (dup str-indent int-indent) line)
	)
)


(set 'template-header (append
[text]
|	<?xml version="1.0"?>
|	<!DOCTYPE MODE SYSTEM "xmode.dtd">
|	[/text] generator-comment [text]
|	[/text] newlisp-comment [text]
|
|	<MODE>
||		<PROPS>
|||			<PROPERTY NAME="lineComment" VALUE=";" />
|||			<PROPERTY NAME="noWordSep" VALUE="_-+?!@$%^&amp;*/|\&lt;&gt;.~`" />
|||			<!-- Uncomment this to enable auto indent
|||			<PROPERTY NAME="indentOpenBrackets" VALUE="(" />
|||			<PROPERTY NAME="indentCloseBrackets" VALUE=")" />
|||			<PROPERTY NAME="electricKeys" VALUE=")" />
|||			<PROPERTY NAME="doubleBracketIndent" VALUE="false" />
|||			<PROPERTY NAME="lineUpClosingBracket" VALUE="true" />
|||			-->
||		</PROPS>
||
||
||		<!-- ESCAPE attribute removed from <RULES> for jEdit 4.3 -->
||		<RULES
|||			IGNORE_CASE="FALSE"
|||			HIGHLIGHT_DIGITS="TRUE"
|||			DIGIT_RE="(0x[\da-fA-F]+|[+-]?0\d+|([+-]?(0|[1-9]\d*)(\.\d*)?|\.\d+)([eE][+-]?\d+)?)"
|||			NO_WORD_SEP="_-+?!@$%^&amp;*/|\&lt;&gt;.~`">
|||
|||
|||			<!-- Operators -->
|||			<SEQ TYPE="OPERATOR">)</SEQ>
|||			<SEQ TYPE="OPERATOR">(</SEQ>
|||			<SEQ TYPE="OPERATOR">:</SEQ>
|||			<!-- Uncomment for highlighting quoted symbols (works for jEdit 4.3)
|||			<MARK_FOLLOWING TYPE="LITERAL4" MATCH_TYPE="OPERATOR">'</MARK_FOLLOWING>
|||			-->
|||
|||
|||			<!-- newlispdoc -->
|||			<EOL_SPAN TYPE="COMMENT3" AT_LINE_START="TRUE"
||||			DELEGATE="newlispdoc"
||||			NO_LINE_BREAK="TRUE">;;</EOL_SPAN>
|||
|||			<!-- Comments -->
|||			<EOL_SPAN TYPE="COMMENT1">;</EOL_SPAN>
|||			<EOL_SPAN TYPE="COMMENT1">#</EOL_SPAN>
|||
|||
|||			<!-- Text literals -->
|||			<!-- ESCAPE attribute added for jEdit 4.3 -->
|||			<SPAN TYPE="LITERAL1" ESCAPE="\">
||||			<BEGIN>"</BEGIN>
||||			<END>"</END>
|||			</SPAN>
|||
|||			<!-- NO_ESCAPE attribute removed for jEdit 4.3 -->
|||			<SPAN TYPE="LITERAL2">
||||			<BEGIN>{</BEGIN>
||||			<END>}</END>
|||			</SPAN>
|||
|||			<!-- NO_ESCAPE attribute removed for jEdit 4.3 -->
|||			<SPAN TYPE="LITERAL2">
||||			<BEGIN>[/text] "[text]" [text]</BEGIN>
||||			<END>[/text] "[/text]" [text]</END>
|||			</SPAN>
|||
|||
|||			<!-- [cmd] -->
|||			<SPAN TYPE="LITERAL3" DELEGATE="MAIN">
||||			<BEGIN>[cmd]</BEGIN>
||||			<END>[/cmd]</END>
|||			</SPAN>
|||
|||
|||			<!-- Highlight bracketed symbols -->
|||			<!-- NO_ESCAPE attribute removed for jEdit 4.3 -->
|||			<SPAN TYPE="LITERAL4">
||||			<BEGIN>[</BEGIN>
||||			<END>]</END>
|||			</SPAN>
|||
|||
|||			<!-- Built-in keywords -->
|||			<KEYWORDS>
[/text]))

(set 'template-footer
[text]
|||			</KEYWORDS>
|||
||		</RULES>
||
||
||		<RULES SET="newlispdoc" IGNORE_CASE="FALSE" DEFAULT="COMMENT3">
|||
|||			<SEQ TYPE="MARKUP">&lt;h1&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;h2&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;h3&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;h4&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/h1&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/h2&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/h3&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/h4&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;i&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/i&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;em&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/em&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;b&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/b&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;tt&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/tt&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;p&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/p&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;br&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;br/&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;pre&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/pre&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;center&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/center&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;li&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/li&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/ul&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;ul&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;/blockquote&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;blockquote&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;hr&gt;</SEQ>
|||			<SEQ TYPE="MARKUP">&lt;hr/&gt;</SEQ>
|||
|||			<SEQ TYPE="MARKUP">[h1]</SEQ>
|||			<SEQ TYPE="MARKUP">[h2]</SEQ>
|||			<SEQ TYPE="MARKUP">[h3]</SEQ>
|||			<SEQ TYPE="MARKUP">[h4]</SEQ>
|||			<SEQ TYPE="MARKUP">[/h1]</SEQ>
|||			<SEQ TYPE="MARKUP">[/h2]</SEQ>
|||			<SEQ TYPE="MARKUP">[/h3]</SEQ>
|||			<SEQ TYPE="MARKUP">[/h4]</SEQ>
|||			<SEQ TYPE="MARKUP">[i]</SEQ>
|||			<SEQ TYPE="MARKUP">[/i]</SEQ>
|||			<SEQ TYPE="MARKUP">[em]</SEQ>
|||			<SEQ TYPE="MARKUP">[/em]</SEQ>
|||			<SEQ TYPE="MARKUP">[b]</SEQ>
|||			<SEQ TYPE="MARKUP">[/b]</SEQ>
|||			<SEQ TYPE="MARKUP">[tt]</SEQ>
|||			<SEQ TYPE="MARKUP">[/tt]</SEQ>
|||			<SEQ TYPE="MARKUP">[p]</SEQ>
|||			<SEQ TYPE="MARKUP">[/p]</SEQ>
|||			<SEQ TYPE="MARKUP">[br]</SEQ>
|||			<SEQ TYPE="MARKUP">[br/]</SEQ>
|||			<SEQ TYPE="MARKUP">[pre]</SEQ>
|||			<SEQ TYPE="MARKUP">[/pre]</SEQ>
|||			<SEQ TYPE="MARKUP">[center]</SEQ>
|||			<SEQ TYPE="MARKUP">[/center]</SEQ>
|||			<SEQ TYPE="MARKUP">[li]</SEQ>
|||			<SEQ TYPE="MARKUP">[/li]</SEQ>
|||			<SEQ TYPE="MARKUP">[/ul]</SEQ>
|||			<SEQ TYPE="MARKUP">[ul]</SEQ>
|||			<SEQ TYPE="MARKUP">[/blockquote]</SEQ>
|||			<SEQ TYPE="MARKUP">[blockquote]</SEQ>
|||			<SEQ TYPE="MARKUP">[hr]</SEQ>
|||			<SEQ TYPE="MARKUP">[hr/]</SEQ>
|||
|||			<KEYWORDS>
||||				<LABEL>@module</LABEL>
||||				<LABEL>@index</LABEL>
||||				<LABEL>@description</LABEL>
||||				<LABEL>@location</LABEL>
||||				<LABEL>@version</LABEL>
||||				<LABEL>@author</LABEL>
||||				<LABEL>@syntax</LABEL>
||||				<LABEL>@param</LABEL>
||||				<LABEL>@return</LABEL>
||||				<LABEL>@example</LABEL>
||||				<LABEL>@link</LABEL>
|||			</KEYWORDS>
|||
||		</RULES>
|	</MODE>
[/text])


(define (print-parse-template str-template str-indent , int-bars )

	(dolist ( line (parse str-template {[\r\n]+} 0) )
		; search for leading bars
		; (# of bars) - 1 = how much to indent
		(set '$0 nil)
		(regex {^\|+} line)
		(if (string? $0) (begin  ; skip lines that have no bars
			(set 'int-bars (length $0) )
			; remove leading bars and surrounding white-space
			(replace {(^[\|\s]+|\s+$)} line "" 0)
			; print the indented line
			(println (dup str-indent (- int-bars 1)) line )
		))
	)
)



(define (generate-syntax-file  str-out-file str-indent , int-file)
	(set 'int-file (open str-out-file "write") )

	(if (not int-file)
		(throw-error (append "Unable to open output file " str-out-file) )
	)

	(device int-file)
	(print-parse-template template-header str-indent)
	(print-symbols-mapped-to-xml MAIN-SYMBOLS 3 str-indent)
	(print-parse-template template-footer str-indent)
	(close int-file)
)

################################################################################

(set 'out-file
	(string "newlisp"
		(if istk? "-tk" "")
		ver
		"-" ostype
		(if isutf8? "-utf8" "")
		".xml"))

(generate-syntax-file out-file "\t")

(dolist (line (list
		(append "Generated jEdit syntax file: " out-file)
		{}
		(append {Copy } out-file { to your jEdit "modes" sub-directory} )
		{in your jEdit settings directory.}
		{}
		{Your modes directory is:}
		{}
		{On Windows        %USERPROFILE%\.jedit\modes\}
		{On Linux and Mac  ~/.jedit/modes/}
		{}
		{Be sure to also include a line in your "catalog" file, also found in your}
		{modes sub-directory. e.g.}
		{}
		(append {   <MODE NAME="newlisp" FILE="} out-file {"})
		{         FILE_NAME_GLOB="*.lsp" FIRST_LINE_GLOB="#!/*newlisp*"/>}
		{}
		{There are a number of ways you can customize jEdit's syntax highlighting.}
		{For more information, see your jEdit documentation about writing edit modes.}
	))
	(println line)
)

(exit)
; eof


syntax highlighting with newLISP and newLISPdoc