1;	LPAGE.CMD:	LISP language MENU Page
2;			for MicroEMACS 3.11 and above
3;			(C)opyright 1989 by Gregory Wilcox
4;			modified by Daniel Lawrence
5
6; set the clean procedure up
7store-procedure clean
8	delete-buffer "[Macro 10]"
9	delete-buffer "[Macro 11]"
10	delete-buffer "[Macro 12]"
11	delete-buffer "[Macro 13]"
12	delete-buffer "[Macro 14]"
13	delete-buffer "[Macro 15]"
14	delete-buffer "[Macro 16]"
15!endm
16
17; make sure the function key window is up
18	set %rcfkeys FALSE
19	toggle-fkeys
20	write-message "Loading..."
21
22; Write out the page instructions
23	save-window
24	1 next-window
25	beginning-of-file
26	set $curcol 25
27	overwrite-string " F1 forward sexpr          F2 previous sexpr        "
28	next-line
29	set $curcol 25
30	overwrite-string " F3 forward function       F4 previous function     "
31	next-line
32	set $curcol 25
33	overwrite-string " F5 mark sexpr             F6 indent sexpr          "
34	next-line
35	set $curcol 18
36	overwrite-string "LISP"
37	set $curcol 25
38	overwrite-string " F7 find unmatched parens  F8                       "
39	next-line
40	set $curcol 25
41	overwrite-string " F9                       F10                       "
42	unmark-buffer
43	beginning-of-file
44	!force restore-window
45	update-screen
46
47set %tab 9
48set %newline 13
49set %space 32
50set %lparen 40
51set %rparen 41
52set %indent "  "
53
54; forward-sexpr
55; this function (and its twin, backward-sexpr) only work on lists -
56; it would be difficult to make them work on atoms,
57; since forward-word and backward-word skip over parentheses
5810	store-macro
59	!if &not &equal $curchar %lparen
60		search-forward "("
61		backward-character
62	!endif
63	goto-matching-fence
64!endm
65
66; backward-sexpr
67; unfortunately, this won't work on a top-level sexpr
68; there must be some stupid C rule about braces not allowed in column 1
69; thus, when you goto-matching-fence, it can't be found
70; hence the !force and following !if clause
7111	store-macro
72	!if &not &equal $curchar %rparen
73		search-reverse ")"
74	!endif
75	!force goto-matching-fence
76	!if &seq $status FALSE
77		search-reverse "~n("
78	!endif
79!endm
80
81; forward-function
8212	store-macro
83	!force search-forward "~n("
84	!if &seq $status FALSE
85		end-of-file
86		write-message "Last function"
87	!else
88		backward-character
89	!endif
90!endm
91
92; backward-function
9313	store-macro
94	!force search-reverse "~n("
95	!if &seq $status FALSE
96		beginning-of-file
97		write-message "First function"
98	!else
99	forward-character
100	!endif
101!endm
102
103; mark-sexpr
10414	store-macro
105	!if &not &equal $curchar %lparen
106		search-reverse "("
107	!endif
108	set-mark
109	goto-matching-fence
110	forward-character
111	exchange-point-and-mark
112!endm
113
114; indent-sexpr
11515	store-macro
116	write-message "Indenting S-expression. . ."
117	forward-character
118	execute-macro-26  ; backward-function
119	; are we really here?
120	!if &not &equal $curchar %lparen
121		write-message "Can't find S-expression."
122		!return
123	!endif
124	set %parens 0
125*nest
126	!if &equal $curchar %lparen
127		; if sexpr is on one line, swallow it
128		set %cline $curline
129		set %ccol $curcol
130		goto-matching-fence
131		!if &not &equal %cline $curline
132			set $curline %cline
133			set $curcol %ccol
134			set %parens &add %parens 1
135		!endif
136	!else
137		!if &equal $curchar %rparen
138			set %parens &sub %parens 1
139		!endif
140	!endif
141	!if &equal $curchar %newline
142		forward-character
143		; trim leading whitespace
144		!while &or &equ $curchar %space &equ $curchar %tab
145			delete-next-character
146		!endwhile
147		; now do the indenting
148		set %count %parens
149		!while &not &equ %count 0
150			insert-string %indent
151			set %count &sub %count 1
152		!endwhile
153		backward-character
154	!endif
155	forward-character
156	!if &not &equ %parens 0
157		!goto nest
158	!endif
159	write-message "Finished."
160!endm
161
162; find-unbalanced-parentheses
16316	store-macro
164	; save cursor position
165	set %cline $curline
166	set %ccol $curcol
167	write-message "Searching forward for mismatched parentheses. . ."
168	beginning-of-file
169*loop
170	!force search-forward "("
171	!if &seq $status FALSE
172		!goto misup
173	!endif
174	backward-character
175	!force goto-matching-fence
176	!if &seq $status FALSE
177		write-message "Too few close parentheses in this function."
178		!return
179	!endif
180	!goto loop
181*misup
182	write-message "Searching backward for mismatched parentheses. . ."
183	end-of-file
184*loopr
185	!force search-reverse ")"
186	!if &seq $status FALSE
187		!goto ok
188	!endif
189	; forward-character not needed - asymmetry here
190	!force goto-matching-fence
191	!if &seq $status FALSE
192		write-message "Too many close parentheses in this function."
193		!return
194	!endif
195	!goto loopr
196*ok
197	write-message "All parentheses appear balanced."
198	; restore cursor position
199	set $curline %cline
200	set $curcol %ccol
201!endm
202
203bind-to-key execute-macro-22 A-F	; forward-sexpr
204bind-to-key execute-macro-23 A-B	; backward-sexpr
205bind-to-key execute-macro-24 ^@		; mark-sexpr
206bind-to-key execute-macro-25 A-E	; forward-function
207bind-to-key execute-macro-26 A-A	; backward-function
208bind-to-key execute-macro-27 A-I	; indent-sexpr
209bind-to-key execute-macro-28 A-U	; find-unmatched-parentheses
210
211write-message "[LISP page loaded]"
212