385 lines
11 KiB
Common Lisp
385 lines
11 KiB
Common Lisp
;;
|
|
;; Copyright (c) 2002 by The XFree86 Project, Inc.
|
|
;;
|
|
;; Permission is hereby granted, free of charge, to any person obtaining a
|
|
;; copy of this software and associated documentation files (the "Software"),
|
|
;; to deal in the Software without restriction, including without limitation
|
|
;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
|
|
;; and/or sell copies of the Software, and to permit persons to whom the
|
|
;; Software is furnished to do so, subject to the following conditions:
|
|
;;
|
|
;; The above copyright notice and this permission notice shall be included in
|
|
;; all copies or substantial portions of the Software.
|
|
;;
|
|
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
|
;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
|
;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
|
|
;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
|
;; SOFTWARE.
|
|
;;
|
|
;; Except as contained in this notice, the name of the XFree86 Project shall
|
|
;; not be used in advertising or otherwise to promote the sale, use or other
|
|
;; dealings in this Software without prior written authorization from the
|
|
;; XFree86 Project.
|
|
;;
|
|
;; Author: Paulo César Pereira de Andrade
|
|
;;
|
|
;;
|
|
;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/lisp.lsp,v 1.9 2003/01/30 02:46:26 paulo Exp $
|
|
;;
|
|
|
|
(require "syntax")
|
|
(require "indent")
|
|
(in-package "XEDIT")
|
|
|
|
(defsynprop *prop-special*
|
|
"special"
|
|
:font "*courier-bold-r*-12-*"
|
|
:foreground "NavyBlue"
|
|
)
|
|
|
|
(defsynprop *prop-quote*
|
|
"quote"
|
|
:font "*courier-bold-r*-12-*"
|
|
:foreground "Red4"
|
|
)
|
|
|
|
(defsynprop *prop-package*
|
|
"package"
|
|
:font "*lucidatypewriter-medium-r*-12-*"
|
|
:foreground "Gold4"
|
|
)
|
|
|
|
(defsynprop *prop-unreadable*
|
|
"unreadable"
|
|
:font "*courier-medium-r*-12-*"
|
|
:foreground "Gray25"
|
|
:underline t
|
|
)
|
|
|
|
(defsynoptions *lisp-DEFAULT-style*
|
|
;; Positive number. Basic indentation.
|
|
(:indentation . 2)
|
|
|
|
;; Boolean. Move cursor to the indent column after pressing <Enter>?
|
|
(:newline-indent . t)
|
|
|
|
;; Boolean. Use spaces instead of tabs to fill indentation?
|
|
(:emulate-tabs . nil)
|
|
|
|
;; Boolean. Remove extra spaces from previous line.
|
|
;; This should default to T when newline-indent is not NIL.
|
|
(:trim-blank-lines . t)
|
|
|
|
;; Boolean. If this hash-table entry is set, no indentation is done.
|
|
;; Useful to temporarily disable indentation.
|
|
(:disable-indent . nil)
|
|
)
|
|
|
|
(defvar *lisp-mode-options* *lisp-DEFAULT-style*)
|
|
|
|
(defindent *lisp-mode-indent* :main
|
|
;; this must be the first token
|
|
(indtoken "^\\s*" :indent
|
|
:code (or *offset* (setq *offset* (+ *ind-offset* *ind-length*))))
|
|
;; ignore single line comments
|
|
(indtoken ";.*$" nil)
|
|
;; multiline comments
|
|
(indtoken "|#" :comment :nospec t :begin :comment)
|
|
;; characters
|
|
(indtoken "#\\\\(\\W|\\w+(-\\w+)?)" :character)
|
|
;; numbers
|
|
(indtoken
|
|
(string-concat
|
|
"(\\<|[+-])\\d+("
|
|
;; integers
|
|
"(\\>|\\.(\\s|$))|"
|
|
;; ratios
|
|
"/\\d+\\>|"
|
|
;;floats
|
|
"\\.?\\d*([SsFfDdLlEe][+-]?\\d+)?\\>"
|
|
")")
|
|
:number)
|
|
;; symbols, with optional package
|
|
(indtoken
|
|
(string-concat
|
|
;; optional package name and ending ':'
|
|
"([A-Za-z_0-9%-]+:)?"
|
|
;; internal symbol if after package name, or keyword
|
|
":?"
|
|
;; symbol name
|
|
"[][{}A-Za-z_0-9!$%&/<=>^~*+-]+")
|
|
:symbol)
|
|
;; strings in the same line
|
|
(indtoken "\"([^\\\"]|\\\\.)*\"" :string)
|
|
;; multiline strings
|
|
(indtoken "\"" :cstring :nospec t :begin :string)
|
|
;; "quoted" symbols in the same line
|
|
(indtoken "\\|([^\\|]|\\\\.)*\\|" :symbol)
|
|
;; multiline
|
|
(indtoken "|" :csymbol :nospec t :begin :symbol)
|
|
(indtoken "#" :hash :nospec t)
|
|
|
|
(indinit (parens 0))
|
|
(indtoken "(" :oparen :nospec t :code (incf parens))
|
|
(indtoken ")" :cparen :nospec t :code (decf parens))
|
|
|
|
(indtable :comment
|
|
;; multiline comments can nest
|
|
(indtoken "|#" nil :nospec t :begin :comment)
|
|
(indtoken "#|" nil :nospec t :switch -1))
|
|
|
|
(indtable :string
|
|
;; Ignore escaped characters
|
|
(indtoken "\\." nil)
|
|
;; Return to the toplevel when the start of the string is found
|
|
(indtoken "\"" :ostring :nospec t :switch -1))
|
|
|
|
(indtable :symbol
|
|
;; Ignore escaped characters
|
|
(indtoken "\\." nil)
|
|
;; Return to the toplevel when the start of the symbol is found
|
|
(indtoken "|" :osymbol :nospec t :switch -1))
|
|
|
|
;; ignore comments
|
|
(indreduce nil
|
|
t
|
|
((:comment)))
|
|
|
|
;; reduce multiline strings
|
|
(indreduce :string
|
|
t
|
|
((:ostring (not :ostring) :cstring)))
|
|
|
|
;; reduce multiline symbols
|
|
(indreduce :symbol
|
|
t
|
|
((:osymbol (not :osymbol) :csymbol)))
|
|
|
|
;; reduce basic types, don't care if inside list or not
|
|
(indreduce :element
|
|
t
|
|
((:number)
|
|
(:string)
|
|
(:character)
|
|
(:element :element)
|
|
(:indent :element)))
|
|
|
|
(indreduce :symbol
|
|
t
|
|
((:symbol :symbol)
|
|
(:symbol :element)
|
|
(:indent :symbol)))
|
|
|
|
;; the "real" indentation value, to make easier parsing code like:
|
|
;; (foo (bar (baz (blah
|
|
;; ^ ^
|
|
;; | |
|
|
;; indent |
|
|
;; effective indentation to be used
|
|
(indinit (indent 0))
|
|
|
|
;; indentation values of opening parenthesis.
|
|
(indinit stack)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; if before current line and open parenthesis >= 0, use indentation
|
|
;; of current line to calculate relative indentation.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(indreduce :oparen ;; simple list?
|
|
(and (>= parens 0) (< *ind-offset* *ind-start*))
|
|
((:indent :oparen))
|
|
(setq
|
|
*indent* (offset-indentation (+ *ind-offset* *ind-length*) :resolve t)
|
|
indent *indent*)
|
|
(indent-macro-reject-left))
|
|
|
|
;; reduce list if there isn't indentation change
|
|
(indreduce :element
|
|
t
|
|
((:oparen (not :oparen) :cparen)))
|
|
|
|
(indresolve :oparen
|
|
(setq
|
|
*indent*
|
|
(offset-indentation
|
|
(+ *ind-offset* *ind-length* -1 *base-indent*) :align t))
|
|
(push *indent* stack)
|
|
(incf indent *base-indent*)
|
|
(if (< *indent* indent) (setq *indent* indent)))
|
|
|
|
(indresolve :cparen
|
|
(decf indent *base-indent*)
|
|
(setq *indent* (pop stack))
|
|
(if (null stack)
|
|
(setq *indent* indent)
|
|
(setq *indent* (car stack))))
|
|
)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Find a "good" offset to start parsing backwards, so that it should
|
|
;; always generate the same results.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(defun lisp-offset-indent (&aux char (point (scan (point) :eol :left)))
|
|
;; skip spaces
|
|
(while (member (setq char (char-after point)) indent-spaces)
|
|
(incf point))
|
|
(if (member char '(#\))) (1+ point) point))
|
|
|
|
(defun lisp-should-indent (options &aux char point start)
|
|
(when (hash-table-p options)
|
|
;; check if previous line has extra spaces
|
|
(and (gethash :trim-blank-lines options)
|
|
(indent-clear-empty-line))
|
|
|
|
;; indentation disabled?
|
|
(and (gethash :disable-indent options)
|
|
(return-from lisp-should-indent))
|
|
|
|
(setq
|
|
point (point)
|
|
char (char-before (point))
|
|
start (scan point :eol :left))
|
|
|
|
;; at the start of a line
|
|
(and (= point start)
|
|
(return-from lisp-should-indent (gethash :newline-indent options)))
|
|
|
|
;; if first character
|
|
(and (= point (1+ start)) (return-from lisp-should-indent t))
|
|
|
|
;; if closing parenthesis and first nonblank char
|
|
(when (and (characterp char) (char= char #\)))
|
|
(decf point)
|
|
(while
|
|
(and (> point start) (member (char-before point) indent-spaces))
|
|
(decf point))
|
|
(return-from lisp-should-indent (<= point start)))
|
|
)
|
|
;; should not indent
|
|
nil)
|
|
|
|
(defun lisp-indent (syntax syntable)
|
|
(let*
|
|
((options (syntax-options syntax))
|
|
*base-indent*)
|
|
|
|
(or (lisp-should-indent options) (return-from lisp-indent))
|
|
|
|
(setq *base-indent* (gethash :indentation options 2))
|
|
|
|
(indent-macro
|
|
*lisp-mode-indent*
|
|
(lisp-offset-indent)
|
|
(gethash :emulate-tabs options))))
|
|
|
|
(compile 'lisp-indent)
|
|
|
|
(defsyntax *lisp-mode* :main nil #'lisp-indent *lisp-mode-options*
|
|
;; highlight car and parenthesis
|
|
(syntoken "\\(+\\s*[][{}A-Za-z_0-9!$%&/<=>?^~*:+-]*\\)*"
|
|
:property *prop-keyword*)
|
|
(syntoken "\\)+" :property *prop-keyword*)
|
|
|
|
;; nil and t
|
|
(syntoken "\\<(nil|t)\\>" :icase t :property *prop-special*)
|
|
|
|
(syntoken "|" :nospec t :begin :unreadable :contained t)
|
|
|
|
;; keywords
|
|
(syntoken ":[][{}A-Za-z_0-9!$%&/<=>^~+-]+" :property *prop-constant*)
|
|
|
|
;; special symbol.
|
|
(syntoken "\\*[][{}A-Za-z_0-9!$%&7=?^~+-]+\\*"
|
|
:property *prop-special*)
|
|
|
|
;; special identifiers
|
|
(syntoken "&(aux|key|optional|rest)\\>" :icase t :property *prop-constant*)
|
|
|
|
;; numbers
|
|
(syntoken
|
|
;; since lisp is very liberal in what can be a symbol, this pattern
|
|
;; will not always work as expected, since \< and \> will not properly
|
|
;; work for all characters that may be in a symbol name
|
|
(string-concat
|
|
"(\\<|[+-])\\d+("
|
|
;; integers
|
|
"(\\>|\\.(\\s|$))|"
|
|
;; ratios
|
|
"/\\d+\\>|"
|
|
;;floats
|
|
"\\.?\\d*([SsFfDdLlEe][+-]?\\d+)?\\>"
|
|
")")
|
|
:property *prop-number*)
|
|
|
|
;; characters
|
|
(syntoken "#\\\\(\\W|\\w+(-\\w+)?)" :property *prop-constant*)
|
|
|
|
;; quotes
|
|
(syntoken "[`'.]|,@?" :property *prop-quote*)
|
|
|
|
;; package names
|
|
(syntoken "[A-Za-z_0-9%-]+::?" :property *prop-package*)
|
|
|
|
;; read time evaluation
|
|
(syntoken "#\\d+#" :property *prop-preprocessor*)
|
|
(syntoken "#([+'cCsS-]|\\d+[aA=])?" :begin :preprocessor :contained t)
|
|
|
|
(syntoken "\\c" :property *prop-control*)
|
|
|
|
;; symbols, do nothing, just resolve conflicting matches
|
|
(syntoken "[][{}A-Za-z_0-9!$%&/<=>^~*+-]+")
|
|
|
|
(syntable :simple-comment *prop-comment* nil
|
|
(syntoken "$" :switch -1)
|
|
(syntoken "XXX|FIXME|TODO" :property *prop-annotation*))
|
|
|
|
(syntable :comment *prop-comment* nil
|
|
;; comments can nest
|
|
(syntoken "#|" :nospec t :begin :comment)
|
|
;; return to previous state
|
|
(syntoken "|#" :nospec t :switch -1)
|
|
(syntoken "XXX|FIXME|TODO" :property *prop-annotation*))
|
|
|
|
(syntable :unreadable *prop-unreadable* nil
|
|
;; ignore escaped characters
|
|
(syntoken "\\\\.")
|
|
(syntoken "|" :nospec t :switch -1))
|
|
|
|
(syntable :string *prop-string* nil
|
|
;; ignore escaped characters
|
|
(syntoken "\\\\.")
|
|
(syntoken "\"" :nospec t :switch -1))
|
|
|
|
(syntable :preprocessor *prop-preprocessor* nil
|
|
;; a symbol
|
|
(syntoken "[][{}A-Za-z_0-9!$%&/<=>^~:*+-]+" :switch -1)
|
|
|
|
;; conditional expression
|
|
(syntoken "(" :nospec t :begin :preprocessor-expression :contained t)
|
|
|
|
(syntable :preprocessor-expression *prop-preprocessor* nil
|
|
;; recursive
|
|
(syntoken "(" :nospec t :begin :preprocessor-recursive :contained t)
|
|
(syntoken ")" :nospec t :switch -2)
|
|
|
|
(syntable :preprocessor-recursive *prop-preprocessor* nil
|
|
(syntoken "(" :nospec t
|
|
:begin :preprocessor-recursive
|
|
:contained t)
|
|
(syntoken ")" :nospec t :switch -1)
|
|
(synaugment :comments-and-strings))
|
|
(synaugment :comments-and-strings))
|
|
(synaugment :comments-and-strings))
|
|
|
|
(syntable :comments-and-strings nil nil
|
|
(syntoken "\"" :nospec t :begin :string :contained t)
|
|
(syntoken "#|" :nospec t :begin :comment :contained t)
|
|
(syntoken ";" :begin :simple-comment :contained t))
|
|
|
|
(synaugment :comments-and-strings)
|
|
)
|