1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17 (%include e-macros)
18 (declare (defpl1 date_time_af_ "date_time" (return char (26.) varying)))
19 (declare (special fill-column macedit-whats-escape-today-vbl comment-prefix
20 include-dir comment-column macedit-source-buffer))
21 (declare (*expr begin-defun find-file-subr find-key-in-buf get-key-binding
22 get-key-name key-prompt kill-line-contents
23 kmacro-display-interpret lisp-mode macomp-compile-to-expr
24 macomp-output-to-buffer one-back-is-a parse-key-description))
25
26 (defun macedit-find-all-macros ()
27 (let ((l nil))
28 (mapatoms '(lambda (x)
29 (let ((y (get x 'editor-macro)))
30 (if y (setq l (cons (cons x y) l))))))
31 l))
32
33 (defun macedit-display-all-macros-to-buffer ()
34 (mapc '(lambda (mac)
35 (macedit-display-to-buffer
36 (car mac)(cdr mac)
37 (find-key-in-buf (car mac) macedit-source-buffer))
38 (new-line)
39 (new-line))
40 (macedit-find-all-macros)))
41
42 (defun macedit-display-to-buffer (fun list key)
43 (insert-string (catenate "macro " fun))
44 (if key (insert-string (catenate " on " key)))
45 (new-line)
46 (insert-string " ")
47 (mapc 'macedit-display-one-enmacroed-command-to-buffer
48 (save-excursion-buffer
49 (go-to-buffer macedit-source-buffer)
50 (kmacro-display-interpret list)))
51 (if (line-is-blank)(without-saving (kill-line-contents))
52 else (new-line))
53 (insert-string (catenate "end-macro " fun)))
54
55 (defun macedit-display-one-enmacroed-command-to-buffer (comcons)
56 (let ((key (car comcons))
57 (fun (cdr comcons)))
58 (if (eq fun 'Input/ Characters)
59 (setq key (apply 'catenate
60 (append '("." """")
61 (mapcar
62 '(lambda (x)
63 (cond ((= x (CtoI """"))
64 """""")
65 (t (ItoC x))))
66 (exploden key))
67 '("""")))))
68 (if (> (+ 1 (stringlength key) (cur-hpos)) comment-column)
69 (new-line)
70 (insert-string " ")
71 else (insert-string " "))
72 (insert-string key)))
73
74 (defun macedit-find-beginning-of-macdef ()
75 (go-to-beginning-of-line)
76 (do-forever
77 (if (looking-at "macro")(stop-doing))
78 (if (firstlinep)(display-error "No macro definition found"))
79 (prev-line)))
80
81 (defun macedit-scan-atom ()
82 (macedit-skip-over-whitespace)
83 (cond ((at-end-of-buffer) nil)
84 ((looking-at ".""")
85 (forward-char)
86 (cons 'input-chars (macedit-scan-atom)))
87 ((at '/" )(macedit-scan-quoted-string))
88 ((at '+) (forward-char)
89 (macedit-scan-number))
90 ((at '-) (forward-char)
91 (- (macedit-scan-number)))
92 ((macedit-digitp (curchar))
93 (macedit-scan-number))
94 (t (with-mark begin
95 (skip-to-whitespace)
96 (intern (make_atom (point-mark-to-string begin)))))))
97
98 (defun macedit-digitp (x)
99 (or (numberp x)(setq x (CtoI x)))
100 (and (> x (1- (CtoI "0")))(< x (1- (CtoI "9")))(- x (CtoI "0"))))
101
102 (defun macedit-scan-number ()
103 (cond ((and (not (at-end-of-buffer))
104 (macedit-digitp (curchar)))
105 (do ((acc 0)
106 (dp (macedit-digitp (curchar))
107 (and (not (at-end-of-buffer))
108 (macedit-digitp (curchar)))))
109 ((null dp) acc)
110 (setq acc (+ (* 10. acc) dp))
111 (forward-char)))
112 (t 1)))
113
114 (defun macedit-scan-quoted-string ()
115 (do ((s ""))(nil)
116 (forward-char)
117 (with-mark bos
118 (if (forward-search """")
119 (if-at '/"
120 (backward-char)
121 (setq s (catenate s (point-mark-to-string bos) """" ))
122 (forward-char)
123 else
124 (backward-char)
125 (setq s (catenate s (point-mark-to-string bos)))
126 (forward-char)
127 (release-mark bos)
128 (return s))
129 else
130 (go-to-mark bos)
131 (release-mark bos)
132 (display-error "Unbalanced string")))))
133
134 (defun macedit-skip-over-whitespace ()
135 (do-forever
136 (skip-over-whitespace)
137 (if (not (looking-at "/*"))(stop-doing))
138 (do-times 2 (forward-char))
139 (if (not (forward-search "*/"))
140 (display-error "Unbalanced comment."))))
141
142 (defun macedit-produce-macro-definition ()
143 (prog (macname keyname mlist)
144 (macedit-find-beginning-of-macdef)
145 (or (eq (macedit-scan-atom) 'macro)
146 (return '(nil . "Mangled macro definition")))
147 (setq macname (macedit-scan-atom))
148 (if (memq macname '(nil end-macro on))
149 (return '(nil . "Bad or empty macro definition")))
150 (macedit-skip-over-whitespace)
151 (if (looking-at "on")
152 (macedit-scan-atom)
153 (setq keyname (macedit-scan-atom)))
154 (do ((x nil (nconc (macedit-scan-commands) x)))
155 ((memq (car x) '(macend error))
156 (setq mlist x)))
157 (if (eq (car mlist) 'error)(return (cadr mlist)))
158 (if (not (eq macname (macedit-scan-atom)))
159 (return '(nil . "Macro end does not match beginning")))
160 (return (list macname keyname (nreverse mlist)))))
161
162
163 (defun macedit-scan-commands ()
164 (if (or (not (boundp 'macedit-whats-escape-today-vbl))
165 (null macedit-whats-escape-today-vbl))
166 (setq macedit-whats-escape-today-vbl
167 (cadr (parse-key-description
168 (find-key-in-buf 'escape macedit-source-buffer)))))
169
170 (let ((atom (macedit-scan-atom)))
171 (cond ((eq atom nil)(list 'error "Macro ran off end."))
172 ((eq atom 'end-macro)(list 'macend))
173 ((numberp atom)(nreverse (exploden (decimal-rep atom))))
174 ((symbolp atom)
175 (if (and (> (stringlength atom) 5)
176 (samepnamep (substr atom 1 5) "meta-"))
177 (+ 200 (cadr (parse-key-description (substr atom 6))))
178 else
179 (setq atom (parse-key-description atom))
180 (cond ((= (car atom) 1)
181 (list (cadr atom)
182 (cons 'toplevel-char macedit-whats-escape-today-vbl)))
183 ((caddr atom)
184 (list (cadr atom)(cons 'toplevel-char (caddr atom))))
185 (t (list (cons 'toplevel-char (cadr atom)))))))
186 ((stringp atom)
187 (mapcar
188 '(lambda (x)(cons 'toplevel-char x))
189 (nreverse (exploden atom))))
190 ((and (not (atom atom))(eq (car atom) 'input-chars))
191 (nreverse (exploden (cdr atom))))
192 (t (break macedit-scan-commands t)))))
193
194 (defprop emacro macro-edit-mode suffix-mode)
195 (defun macro-edit-mode ()
196 (setq current-buffer-mode 'Macro/ Edit)
197 (establish-local-var 'macedit-source-buffer current-buffer)
198 (mapc '(lambda (x)(set-key (car x)(cadr x)))
199 '((ESC-^A macedit-find-beginning-of-macdef)
200 (ESC-^B macedit-backward-term)
201 (ESC-^C macedit-compile-to-lisp)
202 (ESC-^E macedit-find-end-of-macdef)
203 (ESC-^F macedit-forward-term)
204 (ESC-^H macedit-mark-whole-macro)
205 (ESC-^K macedit-kill-term)
206 (ESC-^N macedit-forward-macdef)
207 (ESC-^P macedit-backward-macdef)
208 (ESC-^S macedit-state-keyboard-macro)
209 (ESC-^Z macedit-take-up-definition)))
210 (setq comment-prefix "/*" comment-column 51.))
211
212
213
214 (defun macedit-state-keyboard-macro ()
215 (let ((k (key-prompt "Macro Key: ")))
216 (let ((f (save-excursion-buffer
217 (go-to-buffer macedit-source-buffer)
218 (get-key-binding k))))
219 (let ((l (get f 'editor-macro)))
220 (if (null l)
221 (display-error " " (get-key-name k)
222 " is not a macro."))
223 (go-to-end-of-buffer)
224 (macedit-display-to-buffer f l (get-key-name k))
225 (new-line)))))
226
227
228 (defun macedit-take-up-definition ()
229 (macedit-find-beginning-of-macdef)
230 (let ((mac (macedit-produce-macro-definition)))
231 (if (car mac)
232 (putprop (car mac)(caddr mac) 'editor-macro)
233 (if (cadr mac)(set-perm-key (cadr mac)(car mac)))
234 else
235 (display-error-noabort (cdr mac)))))
236
237 (defun load-these-macros ()
238 (go-to-beginning-of-buffer)
239 (do-forever
240 (macedit-skip-over-whitespace)
241 (if (at-end-of-buffer)(stop-doing))
242 (if (looking-at "macro")
243 (macedit-take-up-definition)
244 else
245 (display-error "Bad format in macro file"))))
246
247
248 (defun load-macrofile (filepath)
249 (save-excursion-buffer
250 (load-macrofile- filepath)))
251
252 (defun load-macrofile- (filepath)
253 (let ((thatbuf current-buffer))
254 (find-file-subr filepath)
255 (macro-edit-mode)
256 (setq macedit-source-buffer thatbuf)
257 (load-these-macros)
258 (go-to-beginning-of-buffer)))
259
260 (defun edit-macrofile ()
261 (load-macrofile- (trim-minibuf-response "Edit Macro File: " NL)))
262
263 (defun edit-macros ()
264 (let ((thatbuf current-buffer))
265 (go-to-or-create-buffer 'emacs-macros)
266 (if (empty-buffer-p current-buffer)
267 (insert-string "/* Emacs macros ")
268 (with-mark m
269 (insert-string (date_time_af_))
270 (go-to-mark m)
271 (insert-string
272 (prog2 0 (macedit-scan-quoted-string)
273 (go-to-mark m)
274 (without-saving (kill-to-end-of-line)))))
275 (insert-string " */")
276 (do-times 2 (new-line))
277 (macro-edit-mode)
278 else
279 (go-to-end-of-buffer))
280 (setq macedit-source-buffer thatbuf)
281 (save-excursion (macedit-display-all-macros-to-buffer))))
282 ^L
283
284
285
286 (defprop macedit-forward-term t argwants)
287 (defun macedit-forward-term ()
288 (macedit-skip-over-whitespace)
289 (if (not (at-end-of-buffer))
290 (macedit-scan-atom)))
291
292 (defprop macedit-forward-macdef t argwants)
293 (defun macedit-forward-macdef ()
294 (if (and (bolp)(looking-at "macro"))
295 (macedit-scan-atom))
296 (do-forever
297 (macedit-skip-over-whitespace)
298 (if (at-end-of-buffer)(stop-doing))
299 (if (and (bolp)(looking-at "macro"))
300 (stop-doing))
301 (macedit-scan-atom)))
302
303 (defun macedit-find-end-of-macdef ()
304 (macedit-find-beginning-of-macdef)
305 (do-forever
306 (if (eq (macedit-scan-atom) 'end-macro)
307 (macedit-scan-atom)
308 (go-to-end-of-line)
309 (stop-doing))
310 (if (at-end-of-buffer)(stop-doing))))
311
312 (defun macedit-mark-whole-macro ()
313 (macedit-find-beginning-of-macdef)
314 (set-the-mark)
315 (macedit-find-end-of-macdef))
316
317 (defprop macedit-kill-term forward kills)
318 (defprop macedit-kill-term t argwants)
319 (defun macedit-kill-term ()
320 (with-mark m
321 (macedit-forward-term)
322 (wipe-point-mark m)))
323
324 (defun macedit-skip-back-whitespace ()
325 (do-forever
326 (skip-back-whitespace)
327 (if (at-beginning-of-buffer)(stop-doing))
328 (if-back-at '//
329 (if (one-back-is-a '*)
330 (if (not (reverse-search "/*"))
331 (display-error "Unbalanced comment."))
332 else (stop-doing))
333 else (stop-doing))))
334
335 (defprop macedit-backward-term t argwannts)
336 (defun macedit-backward-term ()
337 (macedit-skip-back-whitespace)
338 (if-back-at '/" (macedit-skip-back-quoted-string)
339 else (skip-back-to-whitespace)))
340
341 (defun macedit-skip-back-quoted-string ()
342 (do-forever
343 (backward-char)
344 (if (not (reverse-search """"))
345 (display-error "Unbalanced string."))
346 (if-back-at '/" nil else (stop-doing)))
347 (if-back-at '/. (backward-char)))
348
349
350 (defun macedit-backward-macdef ()
351 (if (firstlinep)(go-to-beginning-of-line)
352 else
353 (if (and (bolp)(looking-at "macro"))
354 (backward-char))
355 (macedit-find-beginning-of-macdef)))
356 ^L
357
358
359
360
361
362
363 (defun macedit-compile-to-lisp ()
364 (macedit-find-beginning-of-macdef)
365 (let ((mac (macedit-produce-macro-definition)))
366 (if (null (car mac))
367 (display-error "Syntax error: " (cdr mac)))
368 (let ((interp
369 (save-excursion-buffer
370 (go-to-buffer macedit-source-buffer)
371 (kmacro-display-interpret (caddr mac)))))
372 (go-to-or-create-buffer
373 (intern (make_atom
374 (catenate macedit-source-buffer ".e-macros.lisp"))))
375 (if (empty-buffer-p current-buffer)(lisp-mode)
376 (macomp-output-to-buffer '(%include e-macros))
377 (insert-string ";;; e-macros.incl.lisp is found in ")
378 (insert-string include-dir)
379 (do-times 2 (new-line))
380 else
381 (go-to-end-of-buffer))
382 (if (cadr mac)
383 (macomp-output-to-buffer
384 (list 'set-perm-key (get_pname (cadr mac))
385 (list 'quote (car mac)))))
386 (macomp-output-to-buffer
387 (macomp-compile-to-expr (car mac) interp))
388 (new-line)
389 (begin-defun))))
390
391 (define-autoload-lib emacs-macro-compile
392 macomp-output-to-buffer macomp-compile-to-expr)