Commit | Line | Data |
---|---|---|
9414dd8d | 1 | ;;; semantic/bovine/grammar.el --- Bovine's input grammar mode |
469d2149 | 2 | ;; |
ba318903 | 3 | ;; Copyright (C) 2002-2014 Free Software Foundation, Inc. |
469d2149 CY |
4 | ;; |
5 | ;; Author: David Ponce <david@dponce.com> | |
6 | ;; Maintainer: David Ponce <david@dponce.com> | |
7 | ;; Created: 26 Aug 2002 | |
8 | ;; Keywords: syntax | |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation, either version 3 of the License, or | |
15 | ;; (at your option) any later version. | |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
24 | ||
25 | ;;; Commentary: | |
26 | ;; | |
27 | ;; Major mode for editing Bovine's input grammar (.by) files. | |
28 | ||
29 | ;;; History: | |
30 | ||
31 | ;;; Code: | |
32 | (require 'semantic) | |
33 | (require 'semantic/grammar) | |
34 | (require 'semantic/find) | |
f79fbbc7 CY |
35 | (require 'semantic/lex) |
36 | (require 'semantic/wisent) | |
37 | (require 'semantic/bovine) | |
469d2149 CY |
38 | |
39 | (defun bovine-grammar-EXPAND (bounds nonterm) | |
40 | "Expand call to EXPAND grammar macro. | |
41 | Return the form to parse from within a nonterminal between BOUNDS. | |
42 | NONTERM is the nonterminal symbol to start with." | |
43 | `(semantic-bovinate-from-nonterminal | |
44 | (car ,bounds) (cdr ,bounds) ',nonterm)) | |
45 | ||
46 | (defun bovine-grammar-EXPANDFULL (bounds nonterm) | |
47 | "Expand call to EXPANDFULL grammar macro. | |
48 | Return the form to recursively parse the area between BOUNDS. | |
49 | NONTERM is the nonterminal symbol to start with." | |
50 | `(semantic-parse-region | |
51 | (car ,bounds) (cdr ,bounds) ',nonterm 1)) | |
52 | ||
53 | (defun bovine-grammar-TAG (name class &rest attributes) | |
54 | "Expand call to TAG grammar macro. | |
55 | Return the form to create a generic semantic tag. | |
56 | See the function `semantic-tag' for the meaning of arguments NAME, | |
57 | CLASS and ATTRIBUTES." | |
58 | `(semantic-tag ,name ,class ,@attributes)) | |
59 | ||
60 | (defun bovine-grammar-VARIABLE-TAG (name type default-value &rest attributes) | |
61 | "Expand call to VARIABLE-TAG grammar macro. | |
62 | Return the form to create a semantic tag of class variable. | |
63 | See the function `semantic-tag-new-variable' for the meaning of | |
64 | arguments NAME, TYPE, DEFAULT-VALUE and ATTRIBUTES." | |
65 | `(semantic-tag-new-variable ,name ,type ,default-value ,@attributes)) | |
66 | ||
67 | (defun bovine-grammar-FUNCTION-TAG (name type arg-list &rest attributes) | |
68 | "Expand call to FUNCTION-TAG grammar macro. | |
69 | Return the form to create a semantic tag of class function. | |
70 | See the function `semantic-tag-new-function' for the meaning of | |
71 | arguments NAME, TYPE, ARG-LIST and ATTRIBUTES." | |
72 | `(semantic-tag-new-function ,name ,type ,arg-list ,@attributes)) | |
73 | ||
74 | (defun bovine-grammar-TYPE-TAG (name type members parents &rest attributes) | |
75 | "Expand call to TYPE-TAG grammar macro. | |
76 | Return the form to create a semantic tag of class type. | |
77 | See the function `semantic-tag-new-type' for the meaning of arguments | |
78 | NAME, TYPE, MEMBERS, PARENTS and ATTRIBUTES." | |
79 | `(semantic-tag-new-type ,name ,type ,members ,parents ,@attributes)) | |
80 | ||
81 | (defun bovine-grammar-INCLUDE-TAG (name system-flag &rest attributes) | |
82 | "Expand call to INCLUDE-TAG grammar macro. | |
83 | Return the form to create a semantic tag of class include. | |
84 | See the function `semantic-tag-new-include' for the meaning of | |
85 | arguments NAME, SYSTEM-FLAG and ATTRIBUTES." | |
86 | `(semantic-tag-new-include ,name ,system-flag ,@attributes)) | |
87 | ||
88 | (defun bovine-grammar-PACKAGE-TAG (name detail &rest attributes) | |
89 | "Expand call to PACKAGE-TAG grammar macro. | |
90 | Return the form to create a semantic tag of class package. | |
91 | See the function `semantic-tag-new-package' for the meaning of | |
92 | arguments NAME, DETAIL and ATTRIBUTES." | |
93 | `(semantic-tag-new-package ,name ,detail ,@attributes)) | |
94 | ||
95 | (defun bovine-grammar-CODE-TAG (name detail &rest attributes) | |
96 | "Expand call to CODE-TAG grammar macro. | |
97 | Return the form to create a semantic tag of class code. | |
98 | See the function `semantic-tag-new-code' for the meaning of arguments | |
99 | NAME, DETAIL and ATTRIBUTES." | |
100 | `(semantic-tag-new-code ,name ,detail ,@attributes)) | |
101 | ||
102 | (defun bovine-grammar-ALIAS-TAG (name aliasclass definition &rest attributes) | |
103 | "Expand call to ALIAS-TAG grammar macro. | |
104 | Return the form to create a semantic tag of class alias. | |
105 | See the function `semantic-tag-new-alias' for the meaning of arguments | |
106 | NAME, ALIASCLASS, DEFINITION and ATTRIBUTES." | |
107 | `(semantic-tag-new-alias ,name ,aliasclass ,definition ,@attributes)) | |
108 | ||
109 | ;; Cache of macro definitions currently in use. | |
110 | (defvar bovine--grammar-macros nil) | |
111 | ||
112 | (defun bovine-grammar-expand-form (form quotemode &optional inplace) | |
113 | "Expand FORM into a new one suitable to the bovine parser. | |
114 | FORM is a list in which we are substituting. | |
115 | Argument QUOTEMODE is non-nil if we are in backquote mode. | |
116 | When non-nil, optional argument INPLACE indicates that FORM is being | |
117 | expanded from elsewhere." | |
469d2149 CY |
118 | (when (eq (car form) 'quote) |
119 | (setq form (cdr form)) | |
120 | (cond | |
121 | ((and (= (length form) 1) (listp (car form))) | |
122 | (insert "\n(append") | |
123 | (bovine-grammar-expand-form (car form) quotemode nil) | |
124 | (insert ")") | |
125 | (setq form nil inplace nil) | |
126 | ) | |
127 | ((and (= (length form) 1) (symbolp (car form))) | |
128 | (insert "\n'" (symbol-name (car form))) | |
129 | (setq form nil inplace nil) | |
130 | ) | |
131 | (t | |
132 | (insert "\n(list") | |
133 | (setq inplace t) | |
134 | ))) | |
135 | (let ((macro (assq (car form) bovine--grammar-macros)) | |
136 | inlist first n q x) | |
137 | (if macro | |
138 | (bovine-grammar-expand-form | |
139 | (apply (cdr macro) (cdr form)) | |
140 | quotemode t) | |
141 | (if inplace (insert "\n(")) | |
142 | (while form | |
143 | (setq first (car form) | |
144 | form (cdr form)) | |
72b8747b | 145 | ;; Hack for dealing with new reading of unquotes outside of |
9414dd8d | 146 | ;; backquote (introduced in 2010-12-06T16:37:26Z!monnier@iro.umontreal.ca). |
62a81506 | 147 | (when (and (>= emacs-major-version 24) |
72b8747b DE |
148 | (listp first) |
149 | (or (equal (car first) '\,) | |
150 | (equal (car first) '\,@))) | |
151 | (if (listp (cadr first)) | |
152 | (setq form (append (cdr first) form) | |
153 | first (car first)) | |
154 | (setq first (intern (concat (symbol-name (car first)) | |
155 | (symbol-name (cadr first))))))) | |
469d2149 CY |
156 | (cond |
157 | ((eq first nil) | |
158 | (when (and (not inlist) (not inplace)) | |
159 | (insert "\n(list") | |
160 | (setq inlist t)) | |
161 | (insert " nil") | |
162 | ) | |
163 | ((listp first) | |
164 | ;;(let ((fn (and (symbolp (caar form)) (fboundp (caar form))))) | |
165 | (when (and (not inlist) (not inplace)) | |
166 | (insert "\n(list") | |
167 | (setq inlist t)) | |
168 | ;;(if (and inplace (not fn) (not (eq (caar form) 'EXPAND))) | |
169 | ;; (insert " (append")) | |
170 | (bovine-grammar-expand-form | |
171 | first quotemode t) ;;(and fn (not (eq fn 'quote)))) | |
172 | ;;(if (and inplace (not fn) (not (eq (caar form) 'EXPAND))) | |
173 | ;; (insert ")")) | |
174 | ;;) | |
175 | ) | |
176 | ((symbolp first) | |
177 | (setq n (symbol-name first) ;the name | |
178 | q quotemode ;implied quote flag | |
179 | x nil) ;expand flag | |
180 | (if (eq (aref n 0) ?,) | |
181 | (if quotemode | |
182 | ;; backquote mode needs the @ | |
183 | (if (eq (aref n 1) ?@) | |
184 | (setq n (substring n 2) | |
185 | q nil | |
186 | x t) | |
187 | ;; non backquote mode behaves normally. | |
188 | (setq n (substring n 1) | |
189 | q nil)) | |
190 | (setq n (substring n 1) | |
191 | x t))) | |
192 | (if (string= n "") | |
193 | (progn | |
194 | ;; We expand only the next item in place (a list?) | |
195 | ;; A regular inline-list... | |
196 | (bovine-grammar-expand-form (car form) quotemode t) | |
197 | (setq form (cdr form))) | |
198 | (if (and (eq (aref n 0) ?$) | |
199 | ;; Don't expand $ tokens in implied quote mode. | |
200 | ;; This acts like quoting in other symbols. | |
201 | (not q)) | |
202 | (progn | |
203 | (cond | |
204 | ((and (not x) (not inlist) (not inplace)) | |
205 | (insert "\n(list")) | |
206 | ((and x inlist (not inplace)) | |
207 | (insert ")") | |
208 | (setq inlist nil))) | |
209 | (insert "\n(nth " (int-to-string | |
210 | (1- (string-to-number | |
211 | (substring n 1)))) | |
212 | " vals)") | |
213 | (and (not x) (not inplace) | |
214 | (setq inlist t))) | |
215 | ||
216 | (when (and (not inlist) (not inplace)) | |
217 | (insert "\n(list") | |
218 | (setq inlist t)) | |
219 | (or (char-equal (char-before) ?\() | |
220 | (insert " ")) | |
221 | (insert (if (or inplace (eq first t)) | |
222 | "" "'") | |
223 | n))) ;; " " | |
224 | ) | |
225 | (t | |
226 | (when (and (not inlist) (not inplace)) | |
227 | (insert "\n(list") | |
228 | (setq inlist t)) | |
229 | (insert (format "\n%S" first)) | |
230 | ) | |
231 | )) | |
232 | (if inlist (insert ")")) | |
233 | (if inplace (insert ")"))) | |
f79fbbc7 | 234 | )) |
469d2149 CY |
235 | |
236 | (defun bovine-grammar-expand-action (textform quotemode) | |
237 | "Expand semantic action string TEXTFORM into Lisp code. | |
238 | QUOTEMODE is the mode in which quoted symbols are slurred." | |
239 | (if (string= "" textform) | |
240 | nil | |
241 | (let ((sexp (read textform))) | |
469d2149 CY |
242 | ;; We converted the lambda string into a list. Now write it |
243 | ;; out as the bovine lambda expression, and do macro-like | |
244 | ;; conversion upon it. | |
245 | (insert "\n") | |
246 | (cond | |
247 | ((eq (car sexp) 'EXPAND) | |
248 | (insert ",(lambda (vals start end)") | |
249 | ;; The EXPAND macro definition is mandatory | |
250 | (bovine-grammar-expand-form | |
251 | (apply (cdr (assq 'EXPAND bovine--grammar-macros)) (cdr sexp)) | |
252 | quotemode t) | |
253 | ) | |
254 | ((and (listp (car sexp)) (eq (caar sexp) 'EVAL)) | |
255 | ;; The user wants to evaluate the following args. | |
256 | ;; Use a simpler expander | |
257 | ) | |
258 | (t | |
259 | (insert ",(semantic-lambda") | |
260 | (bovine-grammar-expand-form sexp quotemode) | |
261 | )) | |
262 | (insert ")\n"))) | |
263 | ) | |
264 | ||
265 | (defun bovine-grammar-parsetable-builder () | |
266 | "Return the parser table expression as a string value. | |
267 | The format of a bovine parser table is: | |
268 | ||
269 | ( ( NONTERMINAL-SYMBOL1 MATCH-LIST1 ) | |
270 | ( NONTERMINAL-SYMBOL2 MATCH-LIST2 ) | |
271 | ... | |
272 | ( NONTERMINAL-SYMBOLn MATCH-LISTn ) | |
273 | ||
274 | Where each NONTERMINAL-SYMBOL is an artificial symbol which can appear | |
275 | in any child state. As a starting place, one of the NONTERMINAL-SYMBOLS | |
276 | must be `bovine-toplevel'. | |
277 | ||
278 | A MATCH-LIST is a list of possible matches of the form: | |
279 | ||
280 | ( STATE-LIST1 | |
281 | STATE-LIST2 | |
282 | ... | |
283 | STATE-LISTN ) | |
284 | ||
285 | where STATE-LIST is of the form: | |
286 | ( TYPE1 [ \"VALUE1\" ] TYPE2 [ \"VALUE2\" ] ... LAMBDA ) | |
287 | ||
288 | where TYPE is one of the returned types of the token stream. | |
289 | VALUE is a value, or range of values to match against. For | |
290 | example, a SYMBOL might need to match \"foo\". Some TYPES will not | |
291 | have matching criteria. | |
292 | ||
99d99081 | 293 | LAMBDA is a lambda expression which is evalled with the text of the |
469d2149 CY |
294 | type when it is found. It is passed the list of all buffer text |
295 | elements found since the last lambda expression. It should return a | |
296 | semantic element (see below.) | |
297 | ||
298 | For consistency between languages, try to use common return values | |
299 | from your parser. Please reference the chapter \"Writing Parsers\" in | |
300 | the \"Language Support Developer's Guide -\" in the semantic texinfo | |
301 | manual." | |
302 | (let* ((start (semantic-grammar-start)) | |
303 | (scopestart (semantic-grammar-scopestart)) | |
304 | (quotemode (semantic-grammar-quotemode)) | |
305 | (tags (semantic-find-tags-by-class | |
306 | 'token (current-buffer))) | |
307 | (nterms (semantic-find-tags-by-class | |
308 | 'nonterminal (current-buffer))) | |
309 | ;; Setup the cache of macro definitions. | |
310 | (bovine--grammar-macros (semantic-grammar-macros)) | |
311 | nterm rules items item actn prec tag type regex) | |
312 | ||
313 | ;; Check some trivial things | |
314 | (cond | |
315 | ((null nterms) | |
316 | (error "Bad input grammar")) | |
317 | (start | |
318 | (if (cdr start) | |
319 | (message "Extra start symbols %S ignored" (cdr start))) | |
320 | (setq start (symbol-name (car start))) | |
321 | (unless (semantic-find-first-tag-by-name start nterms) | |
322 | (error "start symbol `%s' has no rule" start))) | |
323 | (t | |
324 | ;; Default to the first grammar rule. | |
325 | (setq start (semantic-tag-name (car nterms))))) | |
326 | (when scopestart | |
327 | (setq scopestart (symbol-name scopestart)) | |
328 | (unless (semantic-find-first-tag-by-name scopestart nterms) | |
329 | (error "scopestart symbol `%s' has no rule" scopestart))) | |
330 | ||
331 | ;; Generate the grammar Lisp form. | |
332 | (with-temp-buffer | |
333 | (erase-buffer) | |
334 | (insert "`(") | |
335 | ;; Insert the start/scopestart rules | |
336 | (insert "\n(bovine-toplevel \n(" | |
337 | start | |
338 | ")\n) ;; end bovine-toplevel\n") | |
339 | (when scopestart | |
340 | (insert "\n(bovine-inner-scope \n(" | |
341 | scopestart | |
342 | ")\n) ;; end bovine-inner-scope\n")) | |
343 | ;; Process each nonterminal | |
344 | (while nterms | |
345 | (setq nterm (car nterms) | |
346 | ;; We can't use the override form because the current buffer | |
347 | ;; is not the originator of the tag. | |
348 | rules (semantic-tag-components-semantic-grammar-mode nterm) | |
349 | nterm (semantic-tag-name nterm) | |
350 | nterms (cdr nterms)) | |
351 | (when (member nterm '("bovine-toplevel" "bovine-inner-scope")) | |
352 | (error "`%s' is a reserved internal name" nterm)) | |
353 | (insert "\n(" nterm) | |
469d2149 CY |
354 | ;; Process each rule |
355 | (while rules | |
356 | (setq items (semantic-tag-get-attribute (car rules) :value) | |
357 | prec (semantic-tag-get-attribute (car rules) :prec) | |
358 | actn (semantic-tag-get-attribute (car rules) :expr) | |
359 | rules (cdr rules)) | |
360 | ;; Process each item | |
361 | (insert "\n(") | |
362 | (if (null items) | |
363 | ;; EMPTY rule | |
364 | (insert ";;EMPTY" (if actn "" "\n")) | |
365 | ;; Expand items | |
366 | (while items | |
367 | (setq item (car items) | |
368 | items (cdr items)) | |
369 | (if (consp item) ;; mid-rule action | |
370 | (message "Mid-rule action %S ignored" item) | |
371 | (or (char-equal (char-before) ?\() | |
372 | (insert "\n")) | |
373 | (cond | |
374 | ((member item '("bovine-toplevel" "bovine-inner-scope")) | |
375 | (error "`%s' is a reserved internal name" item)) | |
376 | ;; Replace ITEM by its %token definition. | |
377 | ;; If a '%token TYPE ITEM [REGEX]' definition exists | |
378 | ;; in the grammar, ITEM is replaced by TYPE [REGEX]. | |
379 | ((setq tag (semantic-find-first-tag-by-name | |
380 | item tags) | |
381 | type (semantic-tag-get-attribute tag :type)) | |
382 | (insert type) | |
383 | (if (setq regex (semantic-tag-get-attribute tag :value)) | |
384 | (insert (format "\n%S" regex)))) | |
385 | ;; Don't change ITEM | |
386 | (t | |
387 | (insert (semantic-grammar-item-text item))) | |
388 | )))) | |
469d2149 CY |
389 | (if prec |
390 | (message "%%prec %S ignored" prec)) | |
391 | (if actn | |
392 | (bovine-grammar-expand-action actn quotemode)) | |
393 | (insert ")")) | |
394 | (insert "\n) ;; end " nterm "\n")) | |
395 | (insert ")\n") | |
396 | (buffer-string)))) | |
397 | ||
398 | (defun bovine-grammar-setupcode-builder () | |
399 | "Return the text of the setup code." | |
400 | (format | |
401 | "(setq semantic--parse-table %s\n\ | |
402 | semantic-debug-parser-source %S\n\ | |
403 | semantic-debug-parser-class 'semantic-bovine-debug-parser | |
404 | semantic-flex-keywords-obarray %s\n\ | |
405 | %s)" | |
406 | (semantic-grammar-parsetable) | |
407 | (buffer-name) | |
408 | (semantic-grammar-keywordtable) | |
409 | (let ((mode (semantic-grammar-languagemode))) | |
410 | ;; Is there more than one major mode? | |
411 | (if (and (listp mode) (> (length mode) 1)) | |
412 | (format "semantic-equivalent-major-modes '%S\n" mode) | |
413 | "")))) | |
414 | ||
415 | (defvar bovine-grammar-menu | |
9414dd8d | 416 | '("BY Grammar") |
469d2149 CY |
417 | "BY mode specific grammar menu. |
418 | Menu items are appended to the common grammar menu.") | |
419 | ||
9414dd8d | 420 | ;;;###autoload |
469d2149 CY |
421 | (define-derived-mode bovine-grammar-mode semantic-grammar-mode "BY" |
422 | "Major mode for editing Bovine grammars." | |
423 | (semantic-grammar-setup-menu bovine-grammar-menu) | |
424 | (semantic-install-function-overrides | |
425 | '((grammar-parsetable-builder . bovine-grammar-parsetable-builder) | |
9414dd8d | 426 | (grammar-setupcode-builder . bovine-grammar-setupcode-builder)))) |
469d2149 | 427 | |
509c74bd | 428 | (add-to-list 'auto-mode-alist '("\\.by\\'" . bovine-grammar-mode)) |
469d2149 CY |
429 | |
430 | (defvar-mode-local bovine-grammar-mode semantic-grammar-macros | |
431 | '( | |
432 | (ASSOC . semantic-grammar-ASSOC) | |
433 | (EXPAND . bovine-grammar-EXPAND) | |
434 | (EXPANDFULL . bovine-grammar-EXPANDFULL) | |
435 | (TAG . bovine-grammar-TAG) | |
436 | (VARIABLE-TAG . bovine-grammar-VARIABLE-TAG) | |
437 | (FUNCTION-TAG . bovine-grammar-FUNCTION-TAG) | |
438 | (TYPE-TAG . bovine-grammar-TYPE-TAG) | |
439 | (INCLUDE-TAG . bovine-grammar-INCLUDE-TAG) | |
440 | (PACKAGE-TAG . bovine-grammar-PACKAGE-TAG) | |
441 | (CODE-TAG . bovine-grammar-CODE-TAG) | |
442 | (ALIAS-TAG . bovine-grammar-ALIAS-TAG) | |
443 | ) | |
444 | "Semantic grammar macros used in bovine grammars.") | |
445 | ||
f9b697dd GM |
446 | (defun bovine--make-parser-1 (infile &optional outdir) |
447 | (if outdir (setq outdir (file-name-directory (expand-file-name outdir)))) | |
448 | ;; It would be nicer to use a temp-buffer rather than find-file-noselect. | |
449 | ;; The only thing stopping us is bovine-grammar-setupcode-builder's | |
450 | ;; use of (buffer-name). Perhaps that could be changed to | |
451 | ;; (file-name-nondirectory (buffer-file-name)) ? | |
452 | ;; (with-temp-buffer | |
453 | ;; (insert-file-contents infile) | |
454 | ;; (bovine-grammar-mode) | |
455 | ;; (setq buffer-file-name (expand-file-name infile)) | |
456 | ;; (if outdir (setq default-directory outdir)) | |
457 | (let ((packagename | |
458 | ;; This is with-demoted-errors. | |
459 | (condition-case err | |
460 | (with-current-buffer (find-file-noselect infile) | |
461 | (if outdir (setq default-directory outdir)) | |
462 | (semantic-grammar-create-package nil t)) | |
463 | (error (message "%s" (error-message-string err)) nil))) | |
464 | lang filename copyright-end) | |
465 | (when (and packagename | |
466 | (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename)) | |
467 | (setq lang (match-string 1 packagename)) | |
468 | (setq filename (expand-file-name (concat lang "-by.el") outdir)) | |
469 | (with-temp-file filename | |
470 | (insert-file-contents filename) | |
471 | ;; Fix copyright header: | |
472 | (goto-char (point-min)) | |
473 | (re-search-forward "^;; Author:") | |
474 | (setq copyright-end (match-beginning 0)) | |
475 | (re-search-forward "^;;; Code:\n") | |
476 | (delete-region copyright-end (match-end 0)) | |
477 | (goto-char copyright-end) | |
478 | (insert ";; This file is part of GNU Emacs. | |
78adbf9c CY |
479 | |
480 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
481 | ;; it under the terms of the GNU General Public License as published by | |
482 | ;; the Free Software Foundation, either version 3 of the License, or | |
483 | ;; (at your option) any later version. | |
484 | ||
485 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
486 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
487 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
488 | ;; GNU General Public License for more details. | |
489 | ||
490 | ;; You should have received a copy of the GNU General Public License | |
491 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
492 | ||
493 | ;;; Commentary: | |
494 | ;; | |
495 | ;; This file was generated from admin/grammars/" | |
f9b697dd | 496 | lang ".by. |
78adbf9c CY |
497 | |
498 | ;;; Code: | |
62a81506 | 499 | ") |
f9b697dd GM |
500 | (goto-char (point-min)) |
501 | (delete-region (point-min) (line-end-position)) | |
502 | (insert ";;; " packagename | |
503 | " --- Generated parser support file") | |
504 | (delete-trailing-whitespace) | |
505 | (re-search-forward ";;; \\(.*\\) ends here") | |
506 | (replace-match packagename nil nil nil 1))))) | |
507 | ||
508 | (defun bovine-make-parsers () | |
509 | "Generate Emacs's built-in Bovine-based parser files." | |
510 | (interactive) | |
511 | (semantic-mode 1) | |
512 | ;; Loop through each .by file in current directory, and run | |
513 | ;; `semantic-grammar-batch-build-one-package' to build the grammar. | |
514 | (dolist (f (directory-files default-directory nil "\\.by\\'")) | |
515 | (bovine--make-parser-1 f))) | |
516 | ||
517 | ||
518 | (defun bovine-batch-make-parser (&optional infile outdir) | |
519 | "Generate a Bovine parser from input INFILE, writing to OUTDIR. | |
520 | This is mainly intended for use in batch mode: | |
521 | ||
522 | emacs -batch -l semantic/bovine/grammar -f bovine-make-parser-batch \\ | |
523 | [-dir output-dir | -o output-file] file.by | |
524 | ||
525 | If -o is supplied, only the directory part is used." | |
526 | (semantic-mode 1) | |
527 | (when (and noninteractive (not infile)) | |
528 | (let (arg) | |
529 | (while command-line-args-left | |
530 | (setq arg (pop command-line-args-left)) | |
531 | (cond ((string-equal arg "-dir") | |
532 | (setq outdir (pop command-line-args-left))) | |
533 | ((string-equal arg "-o") | |
534 | (setq outdir (file-name-directory (pop command-line-args-left)))) | |
535 | (t (setq infile arg)))))) | |
536 | (or infile (error "No input file specified")) | |
537 | (or (file-readable-p infile) | |
538 | (error "Input file `%s' not readable" infile)) | |
539 | (bovine--make-parser-1 infile outdir)) | |
78adbf9c | 540 | |
9414dd8d CY |
541 | (provide 'semantic/bovine/grammar) |
542 | ||
6b91f903 GM |
543 | ;; Local variables: |
544 | ;; generated-autoload-load-name: "semantic/bovine/grammar" | |
545 | ;; End: | |
546 | ||
9414dd8d | 547 | ;;; semantic/bovine/grammar.el ends here |