Mercurial > emacs
annotate lisp/cedet/srecode/compile.el @ 112445:93fcbcb698b0
Improve configuration of makeinfo.
* Makefile.in (MAKEINFO): Now controlled by `configure'.
(MAKEINFO_OPTS): New variable. Use it where appropriate.
(ENVADD): Updated.
author | Werner Lemberg <wl@gnu.org> |
---|---|
date | Sun, 23 Jan 2011 11:38:14 +0100 |
parents | ef719132ddfa |
children |
rev | line source |
---|---|
104498 | 1 ;;; srecode/compile --- Compilation of srecode template files. |
2 | |
112218
376148b31b5e
Add 2011 to FSF/AIST copyright years.
Glenn Morris <rgm@gnu.org>
parents:
110531
diff
changeset
|
3 ;; Copyright (C) 2005, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
104498 | 4 |
5 ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
6 ;; Keywords: codegeneration | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation, either version 3 of the License, or | |
13 ;; (at your option) any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
22 | |
23 ;;; Commentary: | |
24 ;; | |
25 ;; Compile a Semantic Recoder template file. | |
26 ;; | |
27 ;; Template files are parsed using a Semantic/Wisent parser into | |
105328 | 28 ;; a tag table. The code therein is then further parsed down using |
104498 | 29 ;; a regular expression parser. |
30 ;; | |
31 ;; The output are a series of EIEIO objects which represent the | |
32 ;; templates in a way that could be inserted later. | |
33 | |
105652
51bc239bdc37
* cedet/srecode/srt.el:
Chong Yidong <cyd@stupidchicken.com>
parents:
105441
diff
changeset
|
34 (eval-when-compile (require 'cl)) |
104498 | 35 (require 'semantic) |
36 (require 'eieio) | |
37 (require 'eieio-base) | |
38 (require 'srecode/table) | |
110531
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
39 (require 'srecode/dictionary) |
104498 | 40 |
105279
6969c5b2e0b2
Mark declarations not understood by check-declare.
Glenn Morris <rgm@gnu.org>
parents:
104506
diff
changeset
|
41 (declare-function srecode-template-inserter-newline-child-p "srecode/insert" |
6969c5b2e0b2
Mark declarations not understood by check-declare.
Glenn Morris <rgm@gnu.org>
parents:
104506
diff
changeset
|
42 t t) |
104498 | 43 |
44 ;;; Code: | |
45 | |
46 ;;; Template Class | |
47 ;; | |
110531
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
48 ;; Templates describe a pattern of text that can be inserted into a |
104498 | 49 ;; buffer. |
50 ;; | |
51 (defclass srecode-template (eieio-named) | |
52 ((context :initarg :context | |
53 :initform nil | |
54 :documentation | |
55 "Context this template belongs to.") | |
56 (args :initarg :args | |
57 :documentation | |
58 "List of arguments that this template requires.") | |
59 (code :initarg :code | |
60 :documentation | |
61 "Compiled text from the template.") | |
62 (dictionary :initarg :dictionary | |
63 :type (or null srecode-dictionary) | |
64 :documentation | |
65 "List of section dictinaries. | |
66 The compiled template can contain lists of section dictionaries, | |
67 or values that are expected to be passed down into different | |
68 section macros. The template section dictionaries are merged in with | |
69 any incomming dictionaries values.") | |
70 (binding :initarg :binding | |
71 :documentation | |
72 "Preferred keybinding for this template in `srecode-minor-mode-map'.") | |
73 (active :allocation :class | |
74 :initform nil | |
75 :documentation | |
76 "During template insertion, this is the stack of active templates. | |
77 The top-most template is the 'active' template. Use the accessor methods | |
78 for push, pop, and peek for the active template.") | |
79 (table :initarg :table | |
80 :documentation | |
81 "The table this template lives in.") | |
82 ) | |
83 "Class defines storage for semantic recoder templates.") | |
84 | |
85 (defun srecode-flush-active-templates () | |
86 "Flush the active template storage. | |
105328 | 87 Useful if something goes wrong in SRecode, and the active template |
104498 | 88 stack is broken." |
89 (interactive) | |
90 (if (oref srecode-template active) | |
91 (when (y-or-n-p (format "%d active templates. Flush? " | |
92 (length (oref srecode-template active)))) | |
93 (oset-default srecode-template active nil)) | |
94 (message "No active templates to flush.")) | |
95 ) | |
96 | |
97 ;;; Inserters | |
98 ;; | |
99 ;; Each inserter object manages a different thing that | |
100 ;; might be inserted into a template output stream. | |
101 ;; | |
102 ;; The 'srecode-insert-method' on each inserter does the actual | |
103 ;; work, and the smaller, simple inserter object is saved in | |
104 ;; the compiled templates. | |
105 ;; | |
106 ;; See srecode-insert.el for the specialized classes. | |
107 ;; | |
108 (defclass srecode-template-inserter (eieio-named) | |
109 ((secondname :initarg :secondname | |
110 :type (or null string) | |
111 :documentation | |
112 "If there is a colon in the inserter's name, it represents | |
113 additional static argument data.")) | |
114 "This represents an item to be inserted via a template macro. | |
115 Plain text strings are not handled via this baseclass." | |
116 :abstract t) | |
117 | |
118 (defmethod srecode-parse-input ((ins srecode-template-inserter) | |
119 tag input STATE) | |
120 "For the template inserter INS, parse INPUT. | |
121 Shorten input only by the amount needed. | |
122 Return the remains of INPUT. | |
123 STATE is the current compilation state." | |
124 input) | |
125 | |
126 (defmethod srecode-match-end ((ins srecode-template-inserter) name) | |
127 "For the template inserter INS, do I end a section called NAME?" | |
128 nil) | |
129 | |
130 (defmethod srecode-inserter-apply-state ((ins srecode-template-inserter) STATE) | |
131 "For the template inserter INS, apply information from STATE." | |
132 nil) | |
133 | |
134 (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter) | |
135 escape-start escape-end) | |
136 "Insert an example using inserter INS. | |
137 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
138 (princ " ") | |
139 (princ escape-start) | |
140 (when (and (slot-exists-p ins 'key) (oref ins key)) | |
141 (princ (format "%c" (oref ins key)))) | |
142 (princ "VARNAME") | |
143 (princ escape-end) | |
144 (terpri) | |
145 ) | |
146 | |
147 | |
148 ;;; Compile State | |
149 (defclass srecode-compile-state () | |
150 ((context :initform "declaration" | |
151 :documentation "The active context.") | |
152 (prompts :initform nil | |
153 :documentation "The active prompts.") | |
154 (escape_start :initform "{{" | |
155 :documentation "The starting escape sequence.") | |
156 (escape_end :initform "}}" | |
157 :documentation "The ending escape sequence.") | |
158 ) | |
159 "Current state of the compile.") | |
160 | |
161 (defmethod srecode-compile-add-prompt ((state srecode-compile-state) | |
162 prompttag) | |
163 "Add PROMPTTAG to the current list of prompts." | |
164 (with-slots (prompts) state | |
165 (let ((match (assoc (semantic-tag-name prompttag) prompts)) | |
166 (newprompts prompts)) | |
167 (when match | |
168 (let ((tmp prompts)) | |
169 (setq newprompts nil) | |
170 (while tmp | |
171 (when (not (string= (car (car tmp)) | |
172 (car prompttag))) | |
173 (setq newprompts (cons (car tmp) | |
174 newprompts))) | |
175 (setq tmp (cdr tmp))))) | |
176 (setq prompts (cons prompttag newprompts))) | |
177 )) | |
178 | |
179 ;;; TEMPLATE COMPILER | |
180 ;; | |
181 (defun srecode-compile-file (fname) | |
182 "Compile the templates from the file FNAME." | |
183 (let ((peb (get-file-buffer fname))) | |
184 (save-excursion | |
185 ;; Make whatever it is local. | |
186 (if (not peb) | |
187 (set-buffer (semantic-find-file-noselect fname)) | |
188 (set-buffer peb)) | |
189 ;; Do the compile. | |
105441
457c7a0ec078
* cedet/semantic.el (semantic-new-buffer-setup-functions): New
Chong Yidong <cyd@stupidchicken.com>
parents:
105377
diff
changeset
|
190 (unless (semantic-active-p) |
457c7a0ec078
* cedet/semantic.el (semantic-new-buffer-setup-functions): New
Chong Yidong <cyd@stupidchicken.com>
parents:
105377
diff
changeset
|
191 (semantic-new-buffer-fcn)) |
104498 | 192 (srecode-compile-templates) |
193 ;; Trash the buffer if we had to read it in. | |
194 (if (not peb) | |
195 (kill-buffer (current-buffer))) | |
196 ))) | |
197 | |
198 ;;;###autoload | |
199 (defun srecode-compile-templates () | |
200 "Compile a semantic recode template file into a mode-local variable." | |
201 (interactive) | |
104506
801834237f9c
* menu-bar.el: Remove ediff-misc from Tools menu.
Chong Yidong <cyd@stupidchicken.com>
parents:
104501
diff
changeset
|
202 (require 'srecode/insert) |
104498 | 203 (message "Compiling template %s..." |
204 (file-name-nondirectory (buffer-file-name))) | |
205 (let ((tags (semantic-fetch-tags)) | |
206 (tag nil) | |
207 (class nil) | |
208 (table nil) | |
209 (STATE (srecode-compile-state (file-name-nondirectory | |
210 (buffer-file-name)))) | |
211 (mode nil) | |
212 (application nil) | |
213 (priority nil) | |
110531
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
214 (project nil) |
104498 | 215 (vars nil) |
216 ) | |
217 | |
218 ;; | |
219 ;; COMPILE | |
220 ;; | |
221 (while tags | |
222 (setq tag (car tags) | |
223 class (semantic-tag-class tag)) | |
224 ;; What type of item is it? | |
225 (cond | |
226 ;; CONTEXT tags specify the context all future tags | |
227 ;; belong to. | |
228 ((eq class 'context) | |
229 (oset STATE context (semantic-tag-name tag)) | |
230 ) | |
231 | |
232 ;; PROMPT tags specify prompts for dictionary ? inserters | |
233 ;; which appear in the following templates | |
234 ((eq class 'prompt) | |
235 (srecode-compile-add-prompt STATE tag) | |
236 ) | |
237 | |
238 ;; VARIABLE tags can specify operational control | |
239 ((eq class 'variable) | |
240 (let* ((name (semantic-tag-name tag)) | |
241 (value (semantic-tag-variable-default tag)) | |
242 (firstvalue (car value))) | |
243 ;; If it is a single string, and one value, then | |
244 ;; look to see if it is one of our special variables. | |
245 (if (and (= (length value) 1) (stringp firstvalue)) | |
246 (cond ((string= name "mode") | |
247 (setq mode (intern firstvalue))) | |
248 ((string= name "escape_start") | |
249 (oset STATE escape_start firstvalue) | |
250 ) | |
251 ((string= name "escape_end") | |
252 (oset STATE escape_end firstvalue) | |
253 ) | |
254 ((string= name "application") | |
255 (setq application (read firstvalue))) | |
256 ((string= name "priority") | |
257 (setq priority (read firstvalue))) | |
110531
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
258 ((string= name "project") |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
259 (setq project firstvalue)) |
104498 | 260 (t |
261 ;; Assign this into some table of variables. | |
262 (setq vars (cons (cons name firstvalue) vars)) | |
263 )) | |
264 ;; If it isn't a single string, then the value of the | |
265 ;; variable belongs to a compound dictionary value. | |
266 ;; | |
267 ;; Create a compound dictionary value from "value". | |
268 (require 'srecode/dictionary) | |
269 (let ((cv (srecode-dictionary-compound-variable | |
270 name :value value))) | |
271 (setq vars (cons (cons name cv) vars))) | |
272 )) | |
273 ) | |
274 | |
275 ;; FUNCTION tags are really templates. | |
276 ((eq class 'function) | |
277 (setq table (cons (srecode-compile-one-template-tag tag STATE) | |
278 table)) | |
279 ) | |
280 | |
281 ;; Ooops | |
282 (t (error "Unknown TAG class %s" class)) | |
283 ) | |
284 ;; Continue | |
285 (setq tags (cdr tags))) | |
286 | |
287 ;; MSG - Before install since nreverse whacks our list. | |
288 (message "%d templates compiled for %s" | |
289 (length table) mode) | |
290 | |
291 ;; | |
292 ;; APPLY TO MODE | |
293 ;; | |
294 (if (not mode) | |
295 (error "You must specify a MODE for your templates")) | |
296 | |
297 ;; | |
298 ;; Calculate priority | |
299 ;; | |
300 (if (not priority) | |
110531
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
301 (let ((d (expand-file-name (file-name-directory (buffer-file-name)))) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
302 (sd (expand-file-name (file-name-directory (locate-library "srecode")))) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
303 (defaultdelta (if (eq mode 'default) 0 10))) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
304 ;; @TODO : WHEN INTEGRATING INTO EMACS |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
305 ;; The location of Emacs default templates needs to be specified |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
306 ;; here to also have a lower priority. |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
307 (if (string-match (concat "^" sd) d) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
308 (setq priority (+ 30 defaultdelta)) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
309 ;; If the user created template is for a project, then |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
310 ;; don't add as much as if it is unique to just some user. |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
311 (if (stringp project) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
312 (setq priority (+ 50 defaultdelta)) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
313 (setq priority (+ 80 defaultdelta)))) |
104498 | 314 (message "Templates %s has estimated priority of %d" |
315 (file-name-nondirectory (buffer-file-name)) | |
316 priority)) | |
317 (message "Compiling templates %s priority %d... done!" | |
318 (file-name-nondirectory (buffer-file-name)) | |
319 priority)) | |
320 | |
321 ;; Save it up! | |
110531
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
322 (srecode-compile-template-table table mode priority application project vars) |
104498 | 323 ) |
324 ) | |
325 | |
110531
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
326 (defun srecode-compile-one-template-tag (tag state) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
327 "Compile a template tag TAG into a srecode template object. |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
328 STATE is the current compile state as an object of class |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
329 `srecode-compile-state'." |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
330 (let* ((context (oref state context)) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
331 (code (cdr (srecode-compile-split-code |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
332 tag (semantic-tag-get-attribute tag :code) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
333 state))) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
334 (args (semantic-tag-function-arguments tag)) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
335 (binding (semantic-tag-get-attribute tag :binding)) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
336 (dict-tags (semantic-tag-get-attribute tag :dictionaries)) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
337 (root-dict (when dict-tags |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
338 (srecode-create-dictionaries-from-tags |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
339 dict-tags state))) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
340 (addargs)) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
341 ;; Examine arguments. |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
342 (dolist (arg args) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
343 (let ((symbol (intern arg))) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
344 (push symbol addargs) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
345 |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
346 ;; If we have a wrap, then put wrap inserters on both ends of |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
347 ;; the code. |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
348 (when (eq symbol :blank) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
349 (setq code (append |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
350 (list (srecode-compile-inserter |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
351 "BLANK" |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
352 "\r" |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
353 state |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
354 :secondname nil |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
355 :where 'begin)) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
356 code |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
357 (list (srecode-compile-inserter |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
358 "BLANK" |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
359 "\r" |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
360 state |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
361 :secondname nil |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
362 :where 'end))))))) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
363 |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
364 ;; Construct and return the template object. |
104498 | 365 (srecode-template (semantic-tag-name tag) |
110531
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
366 :context context |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
367 :args (nreverse addargs) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
368 :dictionary root-dict |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
369 :binding binding |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
370 :code code)) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
371 ) |
104498 | 372 |
373 (defun srecode-compile-do-hard-newline-p (comp) | |
374 "Examine COMP to decide if the upcoming newline should be hard. | |
375 It is hard if the previous inserter is a newline object." | |
376 (while (and comp (stringp (car comp))) | |
377 (setq comp (cdr comp))) | |
378 (or (not comp) | |
379 (require 'srecode/insert) | |
380 (srecode-template-inserter-newline-child-p (car comp)))) | |
381 | |
382 (defun srecode-compile-split-code (tag str STATE | |
383 &optional end-name) | |
384 "Split the code for TAG into something templatable. | |
385 STR is the string of code from TAG to split. | |
386 STATE is the current compile state. | |
387 ESCAPE_START and ESCAPE_END are regexps that indicate the beginning | |
388 escape character, and end escape character pattern for expandable | |
389 macro names. | |
390 Optional argument END-NAME specifies the name of a token upon which | |
391 parsing should stop. | |
392 If END-NAME is specified, and the input string" | |
393 (let* ((what str) | |
394 (end-token nil) | |
395 (comp nil) | |
396 (regex (concat "\n\\|" (regexp-quote (oref STATE escape_start)))) | |
397 (regexend (regexp-quote (oref STATE escape_end))) | |
398 ) | |
399 (while (and what (not end-token)) | |
400 (cond | |
401 ((string-match regex what) | |
402 (let* ((prefix (substring what 0 (match-beginning 0))) | |
403 (match (substring what | |
404 (match-beginning 0) | |
405 (match-end 0))) | |
406 (namestart (match-end 0)) | |
407 (junk (string-match regexend what namestart)) | |
104501
b5dbdf25d1c5
* cedet/srecode/compile.el (srecode-compile-split-code)
Chong Yidong <cyd@stupidchicken.com>
parents:
104498
diff
changeset
|
408 end tail name key) |
104498 | 409 ;; Add string to compiled output |
410 (when (> (length prefix) 0) | |
411 (setq comp (cons prefix comp))) | |
412 (if (string= match "\n") | |
413 ;; Do newline thingy. | |
414 (let ((new-inserter | |
415 (srecode-compile-inserter | |
416 "INDENT" | |
417 "\n" | |
418 STATE | |
419 :secondname nil | |
420 ;; This newline is "hard" meaning ALWAYS do it | |
421 ;; if the previous entry is also a newline. | |
422 ;; Without it, user entered blank lines will be | |
423 ;; ignored. | |
424 :hard (srecode-compile-do-hard-newline-p comp) | |
425 ))) | |
426 ;; Trim WHAT back. | |
427 (setq what (substring what namestart)) | |
428 (when (> (length what) 0) | |
429 ;; make the new inserter, but only if we aren't last. | |
430 (setq comp (cons new-inserter comp)) | |
431 )) | |
432 ;; Regular inserter thingy. | |
433 (setq end (if junk | |
434 (match-beginning 0) | |
435 (error "Could not find end escape for %s" | |
436 (semantic-tag-name tag))) | |
437 tail (match-end 0)) | |
438 (cond ((not end) | |
439 (error "No matching escape end for %s" | |
440 (semantic-tag-name tag))) | |
441 ((<= end namestart) | |
442 (error "Stray end escape for %s" | |
443 (semantic-tag-name tag))) | |
444 ) | |
445 ;; Add string to compiled output | |
446 (setq name (substring what namestart end) | |
447 key nil) | |
448 ;; Trim WHAT back. | |
449 (setq what (substring what tail)) | |
450 ;; Get the inserter | |
451 (let ((new-inserter | |
452 (srecode-compile-parse-inserter name STATE)) | |
453 ) | |
454 ;; If this is an end inserter, then assign into | |
455 ;; the end-token. | |
456 (if (srecode-match-end new-inserter end-name) | |
457 (setq end-token new-inserter)) | |
458 ;; Add the inserter to our compilation stream. | |
459 (setq comp (cons new-inserter comp)) | |
460 ;; Allow the inserter an opportunity to modify | |
461 ;; the input stream. | |
462 (setq what (srecode-parse-input new-inserter tag what | |
463 STATE)) | |
464 ) | |
465 ))) | |
466 (t | |
467 (if end-name | |
468 (error "Unmatched section end %s" end-name)) | |
469 (setq comp (cons what comp) | |
470 what nil)))) | |
471 (cons what (nreverse comp)))) | |
472 | |
473 (defun srecode-compile-parse-inserter (txt STATE) | |
474 "Parse the inserter TXT with the current STATE. | |
475 Return an inserter object." | |
476 (let ((key (aref txt 0)) | |
104501
b5dbdf25d1c5
* cedet/srecode/compile.el (srecode-compile-split-code)
Chong Yidong <cyd@stupidchicken.com>
parents:
104498
diff
changeset
|
477 name |
104498 | 478 ) |
479 (if (and (or (< key ?A) (> key ?Z)) | |
480 (or (< key ?a) (> key ?z)) ) | |
481 (setq name (substring txt 1)) | |
482 (setq name txt | |
483 key nil)) | |
484 (let* ((junk (string-match ":" name)) | |
485 (namepart (if junk | |
486 (substring name 0 (match-beginning 0)) | |
487 name)) | |
488 (secondname (if junk | |
489 (substring name (match-end 0)) | |
490 nil)) | |
491 (new-inserter (srecode-compile-inserter | |
492 namepart key STATE | |
493 :secondname secondname | |
494 ))) | |
495 ;; Return the new inserter | |
496 new-inserter))) | |
497 | |
498 (defun srecode-compile-inserter (name key STATE &rest props) | |
499 "Create an srecode inserter object for some macro NAME. | |
500 KEY indicates a single character key representing a type | |
501 of inserter to create. | |
502 STATE is the current compile state. | |
503 PROPS are additional properties that might need to be passed | |
504 to the inserter constructor." | |
505 ;;(message "Compile: %s %S" name props) | |
506 (if (not key) | |
507 (apply 'srecode-template-inserter-variable name props) | |
508 (let ((classes (class-children srecode-template-inserter)) | |
509 (new nil)) | |
510 ;; Loop over the various subclasses and | |
511 ;; create the correct inserter. | |
512 (while (and (not new) classes) | |
513 (setq classes (append classes (class-children (car classes)))) | |
514 ;; Do we have a match? | |
515 (when (and (not (class-abstract-p (car classes))) | |
516 (equal (oref (car classes) key) key)) | |
517 ;; Create the new class, and apply state. | |
518 (setq new (apply (car classes) name props)) | |
519 (srecode-inserter-apply-state new STATE) | |
520 ) | |
521 (setq classes (cdr classes))) | |
522 (if (not new) (error "SRECODE: Unknown macro code %S" key)) | |
523 new))) | |
524 | |
110531
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
525 (defun srecode-compile-template-table (templates mode priority application project vars) |
104498 | 526 "Compile a list of TEMPLATES into an semantic recode table. |
527 The table being compiled is for MODE, or the string \"default\". | |
528 PRIORITY is a numerical value that indicates this tables location | |
529 in an ordered search. | |
530 APPLICATION is the name of the application these templates belong to. | |
110531
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
531 PROJECT is a directory name which these templates scope to. |
104498 | 532 A list of defined variables VARS provides a variable table." |
533 (let ((namehash (make-hash-table :test 'equal | |
534 :size (length templates))) | |
535 (contexthash (make-hash-table :test 'equal :size 10)) | |
536 (lp templates) | |
537 ) | |
538 | |
539 (while lp | |
540 | |
541 (let* ((objname (oref (car lp) :object-name)) | |
542 (context (oref (car lp) :context)) | |
543 (globalname (concat context ":" objname)) | |
544 ) | |
545 | |
546 ;; Place this template object into the global name hash. | |
547 (puthash globalname (car lp) namehash) | |
548 | |
549 ;; Place this template into the specific context name hash. | |
550 (let ((hs (gethash context contexthash))) | |
551 ;; Make a new context if none was available. | |
552 (when (not hs) | |
553 (setq hs (make-hash-table :test 'equal :size 20)) | |
554 (puthash context hs contexthash)) | |
555 ;; Put into that contenxt's hash. | |
556 (puthash objname (car lp) hs) | |
557 ) | |
558 | |
559 (setq lp (cdr lp)))) | |
560 | |
110531
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
561 (when (stringp project) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
562 (setq project (expand-file-name project))) |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
563 |
104498 | 564 (let* ((table (srecode-mode-table-new mode (buffer-file-name) |
565 :templates (nreverse templates) | |
566 :namehash namehash | |
567 :contexthash contexthash | |
568 :variables vars | |
569 :major-mode mode | |
570 :priority priority | |
110531
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
571 :application application |
67ff8ad45bd5
Synch SRecode to CEDET 1.0.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
572 :project project)) |
104498 | 573 (tmpl (oref table templates))) |
574 ;; Loop over all the templates, and xref. | |
575 (while tmpl | |
576 (oset (car tmpl) :table table) | |
577 (setq tmpl (cdr tmpl)))) | |
578 )) | |
579 | |
580 | |
581 | |
582 ;;; DEBUG | |
583 ;; | |
584 ;; Dump out information about the current srecoder compiled templates. | |
585 ;; | |
586 | |
587 (defmethod srecode-dump ((tmp srecode-template)) | |
588 "Dump the contents of the SRecode template tmp." | |
589 (princ "== Template \"") | |
590 (princ (object-name-string tmp)) | |
591 (princ "\" in context ") | |
592 (princ (oref tmp context)) | |
593 (princ "\n") | |
594 (when (oref tmp args) | |
595 (princ " Arguments: ") | |
596 (prin1 (oref tmp args)) | |
597 (princ "\n")) | |
598 (when (oref tmp dictionary) | |
599 (princ " Section Dictionaries:\n") | |
600 (srecode-dump (oref tmp dictionary) 4) | |
601 ;(princ "\n") | |
602 ) | |
603 (when (and (slot-boundp tmp 'binding) (oref tmp binding)) | |
604 (princ " Binding: ") | |
605 (prin1 (oref tmp binding)) | |
606 (princ "\n")) | |
607 (princ " Compiled Codes:\n") | |
608 (srecode-dump-code-list (oref tmp code) " ") | |
609 (princ "\n\n") | |
610 ) | |
611 | |
612 (defun srecode-dump-code-list (code indent) | |
613 "Dump the CODE from a template code list to standard output. | |
614 Argument INDENT specifies the indentation level for the list." | |
615 (let ((i 1)) | |
616 (while code | |
617 (princ indent) | |
618 (prin1 i) | |
619 (princ ") ") | |
620 (cond ((stringp (car code)) | |
621 (prin1 (car code))) | |
622 ((srecode-template-inserter-child-p (car code)) | |
623 (srecode-dump (car code) indent)) | |
624 (t | |
625 (princ "Unknown Code: ") | |
626 (prin1 (car code)))) | |
627 (setq code (cdr code) | |
628 i (1+ i)) | |
629 (when code | |
630 (princ "\n")))) | |
631 ) | |
632 | |
633 (defmethod srecode-dump ((ins srecode-template-inserter) indent) | |
634 "Dump the state of the SRecode template inserter INS." | |
635 (princ "INS: \"") | |
636 (princ (object-name-string ins)) | |
637 (when (oref ins :secondname) | |
638 (princ "\" : \"") | |
639 (princ (oref ins :secondname))) | |
640 (princ "\" type \"") | |
641 (let* ((oc (symbol-name (object-class ins))) | |
642 (junk (string-match "srecode-template-inserter-" oc)) | |
643 (on (if junk | |
644 (substring oc (match-end 0)) | |
645 oc))) | |
646 (princ on)) | |
647 (princ "\"") | |
648 ) | |
649 | |
650 (provide 'srecode/compile) | |
651 | |
652 ;; Local variables: | |
653 ;; generated-autoload-file: "loaddefs.el" | |
654 ;; generated-autoload-load-name: "srecode/compile" | |
655 ;; End: | |
656 | |
657 ;;; srecode/compile.el ends here |