newlispfanclub.alh.net

Code: Select all

#!/usr/bin/newlisp

# ---newLISP jEdit mode generator---
#         ---version 0.41---
;;
;; Originally written for newLISP v9.1 and jEdit v4.2final
;;
;; 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  %USERPROFILE%\.jedit\modes\
;;  On Linux    ~\.jedit\modes\
;;
;; Be sure to also include a line in your "catalog" file, also found in your
;; modes sub-directory.
;; e.g.
;; <MODE NAME="newlisp" FILE="newlisp9101-Win32.xml" FILE_NAME_GLOB="*.lsp" FIRST_LINE_GLOB="#!/*newlisp*"/>
;;                            ^^^^^^^^^^^^^^^^^^^^^
;;                            This should be the file
;;                            outputted by this program
;;
;; There are a number of ways you can customize jEdit's syntax highlighting.
;; For more information, see your jEdit documentation about writing edit modes. 

(context 'JEDIT-MODE-GEN)

(set 'istk? (lambda? tk))
(set 'ver (sys-info -2))
(set 'isutf8? (not (zero? (& (sys-info -1) 128))))

; File name
(set 'outfile 
	(string "newlisp" 
		(if istk? "-tk" "")
		ver
		"-" ostype
		(if isutf8? "-utf8" "")
		".xml"))

; Open the file for writing
(device (open outfile "write"))

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

;; Escapes forbidden XML characters: & < >
(define (encode-xml s)
	(set 's (replace ">" (replace "<" (replace "&" s "&") "<") ">"))
	(set '$0 nil) ; This helps keep the MAIN symbols untouched
	s ; return
)

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

;; Converts a newLISP symbol to jEdit xml
(define (sym-to-xml x)
	; Figure out what type of cell it is by 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.
	(case (& 15 (nth 1 (dump (eval x))))
		(0  ;; nil and other symbols
			(if (= x 'nil)
				"<KEYWORD2>nil</KEYWORD2>"
				(if (starts-with (string x) "MAIN:")
					nil ; tk has a leftover symbol (MAIN:result)
					(append "<KEYWORD3>" (encode-xml (string x)) "</KEYWORD3>")
				)
			)
		)
		(1  ;; true (and other symbols that = true)
			(if (= x 'true)
				"<KEYWORD2>true</KEYWORD2>"
				(append "<KEYWORD3>" (encode-xml (string x)) "</KEYWORD3>")
			)
		)
		(4  ;; string (ostype)
			(append "<KEYWORD3>" (encode-xml (string x)) "</KEYWORD3>")
		)
		(6  ;; contexts (MAIN, and SYS for tk)
			; we don't want this context
			(unless (= x 'JEDIT-MODE-GEN) 
				(append "<KEYWORD3>" (encode-xml (string x)) "</KEYWORD3>"))
		)
		(7  ;; primitive functions
			(append "<KEYWORD1>" (encode-xml (string x)) "</KEYWORD1>")
		)
		(11 ;; expressions (i.e. lists)
			(append "<KEYWORD3>" (encode-xml (string x)) "</KEYWORD3>")
		)
		(12 ;; lambda (exit in newlisp-tk)
			(append "<KEYWORD1>" (encode-xml (string x)) "</KEYWORD1>")
		)
		(true
			; New and exciting symbols must have been 
			; added since newLISP 9.1 that we don't
			; have handling for.
			(throw-error 
				(string "Unhandled symbol type " 
					(& 15 (nth 1 (dump (eval x)))) 
					" for " x))
		)
	)
)

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

;; Map all the symbols to the proper jEdit XML code
(define (symbols-mapped-to-xml)
	(sort               ; 3. sort for easy reading
		(filter string? ; 2. remove anything that isn't a string (nils)
			(map sym-to-xml (symbols 'MAIN)))) ; 1. map the symbols to xml
)

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

;; Prints all MAIN symbols as jEdit xml
(define (print-sym-xml)
	(print
		; combine into a big string
		(join  (symbols-mapped-to-xml) "\n\t\t\t" )
	)
)

################################################################################
###                             Entry point                                  ###

; Write the header
(print
[text]<?xml version="1.0"?>
<!DOCTYPE MODE SYSTEM "xmode.dtd">
<!-- newLISP[/text] 
	(if istk? "-tk" "") 
	" v." ver " on " ostype 
	(if isutf8? " UTF-8" "")
			[text] -->
<MODE>
	<PROPS>
		<PROPERTY NAME="lineComment" VALUE=";" />
		<PROPERTY NAME="noWordSep" VALUE="_-+?!@$%^&*/|\<>.~`" />

		<!-- Auto indent setting -->
		<PROPERTY NAME="indentOpenBrackets" VALUE="(" />
		<PROPERTY NAME="indentCloseBrackets" VALUE=")" />
		<PROPERTY NAME="doubleBracketIndent" VALUE="false" />
		<PROPERTY NAME="lineUpClosingBracket" VALUE="true" />
	</PROPS>

	<RULES ESCAPE="\"
		IGNORE_CASE="TRUE"
		HIGHLIGHT_DIGITS="TRUE"
		DIGIT_RE="(0x[\da-f]+|-?\d+(\.\d+)?(e-?\d+)?)"
		NO_WORD_SEP="_-+?!@$%^&*/|\<>.~`">

		<!-- Comments -->
		<EOL_SPAN TYPE="COMMENT1">;</EOL_SPAN>
		<EOL_SPAN TYPE="COMMENT1">#</EOL_SPAN>

		<!-- Text literals -->
		<SPAN TYPE="LITERAL1">
			<BEGIN>"</BEGIN>
			<END>"</END>
		</SPAN>

		<SPAN TYPE="LITERAL2" NO_ESCAPE="TRUE">
			<BEGIN>{</BEGIN>
			<END>}</END>
		</SPAN>

		<SPAN TYPE="LITERAL2" NO_ESCAPE="TRUE">
			<BEGIN>[/text]
			"[text]"
			[text]</BEGIN>
			<END>[/text]
			"[/text]"
			[text]</END>
		</SPAN>
		
		<!-- [cmd] -->
		<SPAN TYPE="LITERAL3" DELEGATE="MAIN">
			<BEGIN>[cmd]</BEGIN>
			<END>[/cmd]</END>
		</SPAN>

		<SEQ TYPE="OPERATOR">:</SEQ>
		
		<!-- These enable the auto indent/unindent behavior
		     (comment these out if you don't want it) -->
		<SEQ TYPE="OPERATOR">)</SEQ>
		<SEQ TYPE="OPERATOR">(</SEQ>

		<!-- Built-in keywords -->
		<KEYWORDS>[/text]
			; fn and lambda aren't in the (symbols) list
			[text]
			<KEYWORD1>fn</KEYWORD1>
			<KEYWORD1>lambda</KEYWORD1>
			[/text]
)

; Write all the symbol keywords
(print-sym-xml) 

; Write the footer
(print
			[text]
		</KEYWORDS>

		<!-- Highlight bracketed symbols -->
		<SPAN TYPE="LITERAL4" NO_ESCAPE="TRUE">
			<BEGIN AT_WORD_START="TRUE">[</BEGIN>
			<END>]</END>
		</SPAN>
		<!-- Uncomment for highlighting quoted symbols
		<MARK_FOLLOWING TYPE="LITERAL4" EXCLUDE_MATCH="TRUE">'</MARK_FOLLOWING>
		-->
	</RULES>

</MODE>[/text]
)

(context 'MAIN)
(exit)

;; eof