1;;
2;; Copyright (c) 2002 by The XFree86 Project, Inc.
3;;
4;; Permission is hereby granted, free of charge, to any person obtaining a
5;; copy of this software and associated documentation files (the "Software"),
6;; to deal in the Software without restriction, including without limitation
7;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
8;; and/or sell copies of the Software, and to permit persons to whom the
9;; Software is furnished to do so, subject to the following conditions:
10;;
11;; The above copyright notice and this permission notice shall be included in
12;; all copies or substantial portions of the Software.
13;;
14;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
17;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
18;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
19;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
20;; SOFTWARE.
21;;
22;; Except as contained in this notice, the name of the XFree86 Project shall
23;; not be used in advertising or otherwise to promote the sale, use or other
24;; dealings in this Software without prior written authorization from the
25;; XFree86 Project.
26;;
27;; Author: Paulo César Pereira de Andrade
28;;
29;;
30;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/lisp.lsp,v 1.9 2003/01/30 02:46:26 paulo Exp $
31;;
32
33(require "syntax")
34(require "indent")
35(in-package "XEDIT")
36
37(defsynprop *prop-special*
38  "special"
39  :font		"*courier-bold-r*-12-*"
40  :foreground	"NavyBlue"
41)
42
43(defsynprop *prop-quote*
44  "quote"
45  :font		"*courier-bold-r*-12-*"
46  :foreground	"Red4"
47)
48
49(defsynprop *prop-package*
50  "package"
51  :font		"*lucidatypewriter-medium-r*-12-*"
52  :foreground	"Gold4"
53)
54
55(defsynprop *prop-unreadable*
56  "unreadable"
57  :font		"*courier-medium-r*-12-*"
58  :foreground	"Gray25"
59  :underline	t
60)
61
62(defsynoptions *lisp-DEFAULT-style*
63  ;; Positive number. Basic indentation.
64  (:indentation			.	2)
65
66  ;; Boolean. Move cursor to the indent column after pressing <Enter>?
67  (:newline-indent		.	t)
68
69  ;; Boolean. Use spaces instead of tabs to fill indentation?
70  (:emulate-tabs		.	nil)
71
72  ;; Boolean. Remove extra spaces from previous line.
73  ;;		This should default to T when newline-indent is not NIL.
74  (:trim-blank-lines		.	t)
75
76  ;; Boolean. If this hash-table entry is set, no indentation is done.
77  ;;		Useful to temporarily disable indentation.
78  (:disable-indent		.	nil)
79)
80
81(defvar *lisp-mode-options* *lisp-DEFAULT-style*)
82
83(defindent *lisp-mode-indent* :main
84  ;; this must be the first token
85  (indtoken "^\\s*"		:indent
86    :code (or *offset* (setq *offset* (+ *ind-offset* *ind-length*))))
87  ;; ignore single line comments
88  (indtoken ";.*$"		nil)
89  ;; multiline comments
90  (indtoken "|#"		:comment	:nospec t	:begin :comment)
91  ;; characters
92  (indtoken "#\\\\(\\W|\\w+(-\\w+)?)"		:character)
93  ;; numbers
94  (indtoken
95    (string-concat
96      "(\\<|[+-])\\d+("
97      ;; integers
98      "(\\>|\\.(\\s|$))|"
99      ;; ratios
100      "/\\d+\\>|"
101      ;;floats
102      "\\.?\\d*([SsFfDdLlEe][+-]?\\d+)?\\>"
103      ")")
104    :number)
105  ;; symbols, with optional package
106  (indtoken
107    (string-concat
108      ;; optional package name and ending ':'
109      "([A-Za-z_0-9%-]+:)?"
110      ;; internal symbol if after package name, or keyword
111      ":?"
112      ;; symbol name
113      "[][{}A-Za-z_0-9!$%&/<=>^~*+-]+")
114    :symbol)
115  ;; strings in the same line
116  (indtoken "\"([^\\\"]|\\\\.)*\""		:string)
117  ;; multiline strings
118  (indtoken "\""		:cstring	:nospec t	:begin :string)
119  ;; "quoted" symbols in the same line
120  (indtoken "\\|([^\\|]|\\\\.)*\\|"		:symbol)
121  ;; multiline
122  (indtoken "|"			:csymbol	:nospec t	:begin :symbol)
123  (indtoken "#"			:hash		:nospec t)
124
125  (indinit	(parens 0))
126  (indtoken "("			:oparen		:nospec t :code (incf parens))
127  (indtoken ")"			:cparen		:nospec t :code (decf parens))
128
129  (indtable :comment
130    ;; multiline comments can nest
131    (indtoken "|#"		nil		:nospec t	:begin :comment)
132    (indtoken "#|"		nil		:nospec t	:switch -1))
133
134  (indtable :string
135    ;; Ignore escaped characters
136    (indtoken "\\." 		nil)
137    ;; Return to the toplevel when the start of the string is found
138    (indtoken "\""		:ostring	:nospec t	:switch -1))
139
140  (indtable :symbol
141    ;; Ignore escaped characters
142    (indtoken "\\." 		nil)
143    ;; Return to the toplevel when the start of the symbol is found
144    (indtoken "|"		:osymbol	:nospec t	:switch -1))
145
146  ;; ignore comments
147  (indreduce nil
148    t
149    ((:comment)))
150
151  ;; reduce multiline strings
152  (indreduce :string
153    t
154    ((:ostring (not :ostring) :cstring)))
155
156  ;; reduce multiline symbols
157  (indreduce :symbol
158    t
159    ((:osymbol (not :osymbol) :csymbol)))
160
161  ;; reduce basic types, don't care if inside list or not
162  (indreduce :element
163    t
164    ((:number)
165      (:string)
166      (:character)
167      (:element :element)
168      (:indent :element)))
169
170  (indreduce :symbol
171    t
172    ((:symbol :symbol)
173      (:symbol :element)
174      (:indent :symbol)))
175
176  ;; the "real" indentation value, to make easier parsing code like:
177  ;;  (foo (bar (baz (blah
178  ;;        ^         ^
179  ;;        |         |
180  ;;        indent    |
181  ;;                  effective indentation to be used
182  (indinit	(indent 0))
183
184  ;; indentation values of opening parenthesis.
185  (indinit	stack)
186
187  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
188  ;; if before current line and open parenthesis >= 0, use indentation
189  ;; of current line to calculate relative indentation.
190  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
191  (indreduce :oparen	;; simple list?
192    (and (>= parens 0) (< *ind-offset* *ind-start*))
193    ((:indent :oparen))
194    (setq
195      *indent*	(offset-indentation (+ *ind-offset* *ind-length*) :resolve t)
196      indent	*indent*)
197    (indent-macro-reject-left))
198
199  ;; reduce list if there isn't indentation change
200  (indreduce :element
201    t
202    ((:oparen (not :oparen) :cparen)))
203
204  (indresolve :oparen
205    (setq
206      *indent*
207      (offset-indentation
208	(+ *ind-offset* *ind-length* -1 *base-indent*) :align t))
209    (push *indent* stack)
210    (incf indent *base-indent*)
211    (if (< *indent* indent) (setq *indent* indent)))
212
213  (indresolve :cparen
214    (decf indent *base-indent*)
215    (setq *indent* (pop stack))
216    (if (null stack)
217      (setq *indent* indent)
218      (setq *indent* (car stack))))
219)
220
221
222;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
223;; Find a "good" offset to start parsing backwards, so that it should
224;; always generate the same results.
225;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
226(defun lisp-offset-indent (&aux char (point (scan (point) :eol :left)))
227  ;; skip spaces
228  (while (member (setq char (char-after point)) indent-spaces)
229    (incf point))
230  (if (member char '(#\))) (1+ point) point))
231
232(defun lisp-should-indent (options &aux char point start)
233  (when (hash-table-p options)
234    ;; check if previous line has extra spaces
235    (and (gethash :trim-blank-lines options)
236      (indent-clear-empty-line))
237
238    ;; indentation disabled?
239    (and (gethash :disable-indent options)
240      (return-from lisp-should-indent))
241
242    (setq
243      point	(point)
244      char	(char-before (point))
245      start	(scan point :eol :left))
246
247    ;; at the start of a line
248    (and (= point start)
249      (return-from lisp-should-indent (gethash :newline-indent options)))
250
251    ;; if first character
252    (and (= point (1+ start)) (return-from lisp-should-indent t))
253
254    ;; if closing parenthesis and first nonblank char
255    (when (and (characterp char) (char= char #\)))
256      (decf point)
257      (while
258	(and (> point start) (member (char-before point) indent-spaces))
259	(decf point))
260      (return-from lisp-should-indent (<= point start)))
261  )
262  ;; should not indent
263  nil)
264
265(defun lisp-indent (syntax syntable)
266  (let*
267    ((options (syntax-options syntax))
268      *base-indent*)
269
270    (or (lisp-should-indent options) (return-from lisp-indent))
271
272    (setq *base-indent* (gethash :indentation options 2))
273
274    (indent-macro
275      *lisp-mode-indent*
276      (lisp-offset-indent)
277      (gethash :emulate-tabs options))))
278
279(compile 'lisp-indent)
280
281(defsyntax *lisp-mode* :main nil #'lisp-indent *lisp-mode-options*
282  ;; highlight car and parenthesis
283  (syntoken "\\(+\\s*[][{}A-Za-z_0-9!$%&/<=>?^~*:+-]*\\)*"
284    :property *prop-keyword*)
285  (syntoken "\\)+" :property *prop-keyword*)
286
287  ;; nil and t
288  (syntoken "\\<(nil|t)\\>" :icase t :property *prop-special*)
289
290  (syntoken "|" :nospec t :begin :unreadable :contained t)
291
292  ;; keywords
293  (syntoken ":[][{}A-Za-z_0-9!$%&/<=>^~+-]+" :property *prop-constant*)
294
295  ;; special symbol.
296  (syntoken "\\*[][{}A-Za-z_0-9!$%&7=?^~+-]+\\*"
297    :property *prop-special*)
298
299  ;; special identifiers
300  (syntoken "&(aux|key|optional|rest)\\>" :icase t :property *prop-constant*)
301
302  ;; numbers
303  (syntoken
304    ;; since lisp is very liberal in what can be a symbol, this pattern
305    ;; will not always work as expected, since \< and \> will not properly
306    ;; work for all characters that may be in a symbol name
307    (string-concat
308      "(\\<|[+-])\\d+("
309      ;; integers
310      "(\\>|\\.(\\s|$))|"
311      ;; ratios
312      "/\\d+\\>|"
313      ;;floats
314      "\\.?\\d*([SsFfDdLlEe][+-]?\\d+)?\\>"
315      ")")
316    :property *prop-number*)
317
318  ;; characters
319  (syntoken "#\\\\(\\W|\\w+(-\\w+)?)" :property *prop-constant*)
320
321  ;; quotes
322  (syntoken "[`'.]|,@?" :property *prop-quote*)
323
324  ;; package names
325  (syntoken "[A-Za-z_0-9%-]+::?" :property *prop-package*)
326
327  ;; read time evaluation
328  (syntoken "#\\d+#" :property *prop-preprocessor*)
329  (syntoken "#([+'cCsS-]|\\d+[aA=])?" :begin :preprocessor :contained t)
330
331  (syntoken "\\c" :property *prop-control*)
332
333  ;; symbols, do nothing, just resolve conflicting matches
334  (syntoken "[][{}A-Za-z_0-9!$%&/<=>^~*+-]+")
335
336  (syntable :simple-comment *prop-comment* nil
337    (syntoken "$" :switch -1)
338    (syntoken "XXX|FIXME|TODO" :property *prop-annotation*))
339
340  (syntable :comment *prop-comment* nil
341    ;; comments can nest
342    (syntoken "#|" :nospec t :begin :comment)
343    ;;  return to previous state
344    (syntoken "|#" :nospec t :switch -1)
345    (syntoken "XXX|FIXME|TODO" :property *prop-annotation*))
346
347  (syntable :unreadable *prop-unreadable* nil
348    ;; ignore escaped characters
349    (syntoken "\\\\.")
350    (syntoken "|" :nospec t :switch -1))
351
352  (syntable :string *prop-string* nil
353    ;; ignore escaped characters
354    (syntoken "\\\\.")
355    (syntoken "\"" :nospec t :switch -1))
356
357  (syntable :preprocessor *prop-preprocessor* nil
358    ;; a symbol
359    (syntoken "[][{}A-Za-z_0-9!$%&/<=>^~:*+-]+" :switch -1)
360
361    ;; conditional expression
362    (syntoken "(" :nospec t :begin :preprocessor-expression :contained t)
363
364    (syntable :preprocessor-expression *prop-preprocessor* nil
365      ;; recursive
366      (syntoken "(" :nospec t :begin :preprocessor-recursive :contained t)
367      (syntoken ")" :nospec t :switch -2)
368
369      (syntable :preprocessor-recursive *prop-preprocessor* nil
370	(syntoken "(" :nospec t
371	  :begin :preprocessor-recursive
372	  :contained t)
373	(syntoken ")" :nospec t :switch -1)
374	(synaugment :comments-and-strings))
375      (synaugment :comments-and-strings))
376    (synaugment :comments-and-strings))
377
378  (syntable :comments-and-strings nil nil
379    (syntoken "\"" :nospec t :begin :string :contained t)
380    (syntoken "#|" :nospec t :begin :comment :contained t)
381    (syntoken ";" :begin :simple-comment :contained t))
382
383  (synaugment :comments-and-strings)
384)
385